9aff752 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Make *ElementConfig depend on the DomSpace directly, not the monad

9aff752Ryan Trinkle9 years ago

reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+49−116

compare with develop

unifiedsplit

@@ -51,7 +51,6 @@ import Data.Semigroup

51import Data.String

52import Data.Text (Text)

53import Data.Type.Coercion

54−import GHC.Exts (Constraint)

55import GHCJS.DOM.Types (JSM)

54import GHCJS.DOM.Types (JSM)

57class Default (EventSpec d EventResult) => DomSpace d where

56class Default (EventSpec d EventResult) => DomSpace d where

@@ -64,12 +63,6 @@ class Default (EventSpec d EventResult) => DomSpace d where

64 type RawSelectElement d :: *

63 type RawSelectElement d :: *

65 addEventSpecFlags :: proxy d -> EventName en -> (Maybe (er en) -> EventFlags) -> EventSpec d er -> EventSpec d er

64 addEventSpecFlags :: proxy d -> EventName en -> (Maybe (er en) -> EventFlags) -> EventSpec d er -> EventSpec d er

67−{-# INLINABLE liftElementConfig #-}

68−liftElementConfig :: (DomBuilderSpace (f m) ~ DomBuilderSpace m) => ElementConfig er t (f m) -> ElementConfig er t m

69−liftElementConfig cfg = cfg

70− { _elementConfig_eventSpec = _elementConfig_eventSpec cfg

71− }

72−

73-- | @'DomBuilder' t m@ indicates that @m@ is a 'Monad' capable of building

66-- | @'DomBuilder' t m@ indicates that @m@ is a 'Monad' capable of building

74-- dynamic DOM in the 'Reflex' timeline @t@

67-- dynamic DOM in the 'Reflex' timeline @t@

75class (Monad m, Reflex t, DomSpace (DomBuilderSpace m), MonadAdjust t m) => DomBuilder t m | m -> t where

68class (Monad m, Reflex t, DomSpace (DomBuilderSpace m), MonadAdjust t m) => DomBuilder t m | m -> t where

@@ -83,51 +76,44 @@ class (Monad m, Reflex t, DomSpace (DomBuilderSpace m), MonadAdjust t m) => DomB

83 => TextNodeConfig t -> m (TextNode (DomBuilderSpace m) t)

76 => TextNodeConfig t -> m (TextNode (DomBuilderSpace m) t)

84 textNode = lift . textNode

77 textNode = lift . textNode

85 {-# INLINABLE textNode #-}

78 {-# INLINABLE textNode #-}

86− element :: Text -> ElementConfig er t m -> m a -> m (Element er (DomBuilderSpace m) t, a)

79+ element :: Text -> ElementConfig er t (DomBuilderSpace m) -> m a -> m (Element er (DomBuilderSpace m) t, a)

87 default element :: ( MonadTransControl f

80 default element :: ( MonadTransControl f

88 , StT f a ~ a

81 , StT f a ~ a

89 , m ~ f m'

82 , m ~ f m'

90 , DomBuilderSpace m' ~ DomBuilderSpace m

83 , DomBuilderSpace m' ~ DomBuilderSpace m

91 , DomBuilder t m'

84 , DomBuilder t m'

92 )

85 )

93− => Text -> ElementConfig er t m -> m a -> m (Element er (DomBuilderSpace m) t, a)

86+ => Text -> ElementConfig er t (DomBuilderSpace m) -> m a -> m (Element er (DomBuilderSpace m) t, a)

94− element t cfg child = liftWith $ \run -> element t (liftElementConfig cfg) $ run child

87+ element t cfg child = liftWith $ \run -> element t cfg $ run child

95 {-# INLINABLE element #-}

88 {-# INLINABLE element #-}

96− inputElement :: InputElementConfig er t m -> m (InputElement er (DomBuilderSpace m) t)

89+ inputElement :: InputElementConfig er t (DomBuilderSpace m) -> m (InputElement er (DomBuilderSpace m) t)

97 default inputElement :: ( MonadTransControl f

90 default inputElement :: ( MonadTransControl f

98 , m ~ f m'

91 , m ~ f m'

99 , DomBuilderSpace m' ~ DomBuilderSpace m

92 , DomBuilderSpace m' ~ DomBuilderSpace m

100 , DomBuilder t m'

93 , DomBuilder t m'

101 )

94 )

102− => InputElementConfig er t m -> m (InputElement er (DomBuilderSpace m) t)

95+ => InputElementConfig er t (DomBuilderSpace m) -> m (InputElement er (DomBuilderSpace m) t)

103− inputElement cfg = lift $ inputElement $ cfg

96+ inputElement = lift . inputElement

104− { _inputElementConfig_elementConfig = liftElementConfig $ _inputElementConfig_elementConfig cfg

105− }

106 {-# INLINABLE inputElement #-}

97 {-# INLINABLE inputElement #-}

107− textAreaElement :: TextAreaElementConfig er t m -> m (TextAreaElement er (DomBuilderSpace m) t)

98+ textAreaElement :: TextAreaElementConfig er t (DomBuilderSpace m) -> m (TextAreaElement er (DomBuilderSpace m) t)

108 default textAreaElement :: ( MonadTransControl f

99 default textAreaElement :: ( MonadTransControl f

109 , m ~ f m'

100 , m ~ f m'

110 , DomBuilderSpace m' ~ DomBuilderSpace m

101 , DomBuilderSpace m' ~ DomBuilderSpace m

111 , DomBuilder t m'

102 , DomBuilder t m'

112 )

103 )

113− => TextAreaElementConfig er t m -> m (TextAreaElement er (DomBuilderSpace m) t)

104+ => TextAreaElementConfig er t (DomBuilderSpace m) -> m (TextAreaElement er (DomBuilderSpace m) t)

114− textAreaElement cfg = lift $ textAreaElement $ cfg

105+ textAreaElement = lift . textAreaElement

115− { _textAreaElementConfig_elementConfig = liftElementConfig $ _textAreaElementConfig_elementConfig cfg

116− }

117 {-# INLINABLE textAreaElement #-}

106 {-# INLINABLE textAreaElement #-}

118− selectElement :: SelectElementConfig er t m -> m a -> m (SelectElement er (DomBuilderSpace m) t, a)

107+ selectElement :: SelectElementConfig er t (DomBuilderSpace m) -> m a -> m (SelectElement er (DomBuilderSpace m) t, a)

119 default selectElement :: ( MonadTransControl f

108 default selectElement :: ( MonadTransControl f

120 , StT f a ~ a

109 , StT f a ~ a

121 , m ~ f m'

110 , m ~ f m'

122 , DomBuilderSpace m' ~ DomBuilderSpace m

111 , DomBuilderSpace m' ~ DomBuilderSpace m

123 , DomBuilder t m'

112 , DomBuilder t m'

124 )

113 )

125− => SelectElementConfig er t m -> m a -> m (SelectElement er (DomBuilderSpace m) t, a)

114+ => SelectElementConfig er t (DomBuilderSpace m) -> m a -> m (SelectElement er (DomBuilderSpace m) t, a)

126 selectElement cfg child = do

115 selectElement cfg child = do

127− let cfg' = cfg

128− { _selectElementConfig_elementConfig = liftElementConfig $ _selectElementConfig_elementConfig cfg

129− }

130− liftWith $ \run -> selectElement cfg' $ run child

116+ liftWith $ \run -> selectElement cfg $ run child

131 {-# INLINABLE selectElement #-}

117 {-# INLINABLE selectElement #-}

132 placeRawElement :: RawElement (DomBuilderSpace m) -> m ()

118 placeRawElement :: RawElement (DomBuilderSpace m) -> m ()

133 default placeRawElement :: ( MonadTrans f

119 default placeRawElement :: ( MonadTrans f

@@ -138,13 +124,13 @@ class (Monad m, Reflex t, DomSpace (DomBuilderSpace m), MonadAdjust t m) => DomB

138 => RawElement (DomBuilderSpace m) -> m ()

124 => RawElement (DomBuilderSpace m) -> m ()

139 placeRawElement = lift . placeRawElement

125 placeRawElement = lift . placeRawElement

140 {-# INLINABLE placeRawElement #-}

126 {-# INLINABLE placeRawElement #-}

141− wrapRawElement :: RawElement (DomBuilderSpace m) -> RawElementConfig er t m -> m (Element er (DomBuilderSpace m) t)

127+ wrapRawElement :: RawElement (DomBuilderSpace m) -> RawElementConfig er t (DomBuilderSpace m) -> m (Element er (DomBuilderSpace m) t)

142 default wrapRawElement :: ( MonadTrans f

128 default wrapRawElement :: ( MonadTrans f

143 , m ~ f m'

129 , m ~ f m'

144 , DomBuilderSpace m' ~ DomBuilderSpace m

130 , DomBuilderSpace m' ~ DomBuilderSpace m

145 , DomBuilder t m'

131 , DomBuilder t m'

146 )

132 )

147− => RawElement (DomBuilderSpace m) -> RawElementConfig er t m -> m (Element er (DomBuilderSpace m) t)

133+ => RawElement (DomBuilderSpace m) -> RawElementConfig er t (DomBuilderSpace m) -> m (Element er (DomBuilderSpace m) t)

148 wrapRawElement e cfg = lift $ wrapRawElement e $ cfg

134 wrapRawElement e cfg = lift $ wrapRawElement e $ cfg

149 { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg

135 { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg

150 }

136 }

@@ -239,25 +225,25 @@ preventDefault = mempty { _eventFlags_preventDefault = True }

239stopPropagation :: EventFlags

225stopPropagation :: EventFlags

240stopPropagation = mempty { _eventFlags_propagation = Propagation_Stop }

226stopPropagation = mempty { _eventFlags_propagation = Propagation_Stop }

241

227

242−data ElementConfig er t m

228+data ElementConfig er t s

243 = ElementConfig { _elementConfig_namespace :: Maybe Namespace

229 = ElementConfig { _elementConfig_namespace :: Maybe Namespace

244 , _elementConfig_initialAttributes :: Map AttributeName Text

230 , _elementConfig_initialAttributes :: Map AttributeName Text

245 , _elementConfig_modifyAttributes :: Maybe (Event t (Map AttributeName (Maybe Text)))

231 , _elementConfig_modifyAttributes :: Maybe (Event t (Map AttributeName (Maybe Text)))

246− , _elementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

232+ , _elementConfig_eventSpec :: EventSpec s er

247 }

233 }

248

234

249#ifndef USE_TEMPLATE_HASKELL

235#ifndef USE_TEMPLATE_HASKELL

250−elementConfig_namespace :: Lens' (ElementConfig er t m) (Maybe Namespace)

236+elementConfig_namespace :: Lens' (ElementConfig er t s) (Maybe Namespace)

251elementConfig_namespace f (ElementConfig a b c d) = (\a' -> ElementConfig a' b c d) <$> f a

237elementConfig_namespace f (ElementConfig a b c d) = (\a' -> ElementConfig a' b c d) <$> f a

252{-# INLINE elementConfig_namespace #-}

238{-# INLINE elementConfig_namespace #-}

253−elementConfig_initialAttributes :: Lens' (ElementConfig er t m) (Map AttributeName Text)

239+elementConfig_initialAttributes :: Lens' (ElementConfig er t s) (Map AttributeName Text)

254elementConfig_initialAttributes f (ElementConfig a b c d) = (\b' -> ElementConfig a b' c d) <$> f b

240elementConfig_initialAttributes f (ElementConfig a b c d) = (\b' -> ElementConfig a b' c d) <$> f b

255{-# INLINE elementConfig_initialAttributes #-}

241{-# INLINE elementConfig_initialAttributes #-}

256elementConfig_eventSpec :: Lens

242elementConfig_eventSpec :: Lens

257− (ElementConfig er1 t m1)

243+ (ElementConfig er1 t s1)

258− (ElementConfig er2 t m2)

244+ (ElementConfig er2 t s2)

259− (EventSpec (DomBuilderSpace m1) er1)

245+ (EventSpec s1 er1)

260− (EventSpec (DomBuilderSpace m2) er2)

246+ (EventSpec s2 er2)

261elementConfig_eventSpec f (ElementConfig a b c d) = (\d' -> ElementConfig a b c d') <$> f d

247elementConfig_eventSpec f (ElementConfig a b c d) = (\d' -> ElementConfig a b c d') <$> f d

262{-# INLINE elementConfig_eventSpec #-}

248{-# INLINE elementConfig_eventSpec #-}

263#endif

249#endif

@@ -267,12 +253,12 @@ data Element er d t

267 , _element_raw :: RawElement d

253 , _element_raw :: RawElement d

268 }

254 }

269

255

270−data InputElementConfig er t m

256+data InputElementConfig er t s

271 = InputElementConfig { _inputElementConfig_initialValue :: Text

257 = InputElementConfig { _inputElementConfig_initialValue :: Text

272 , _inputElementConfig_setValue :: Maybe (Event t Text)

258 , _inputElementConfig_setValue :: Maybe (Event t Text)

273 , _inputElementConfig_initialChecked :: Bool

259 , _inputElementConfig_initialChecked :: Bool

274 , _inputElementConfig_setChecked :: Maybe (Event t Bool)

260 , _inputElementConfig_setChecked :: Maybe (Event t Bool)

275− , _inputElementConfig_elementConfig :: ElementConfig er t m

261+ , _inputElementConfig_elementConfig :: ElementConfig er t s

276 }

262 }

277

263

278#ifndef USE_TEMPLATE_HASKELL

264#ifndef USE_TEMPLATE_HASKELL

@@ -291,7 +277,7 @@ inputElementConfig_elementConfig f (InputElementConfig a b c d e) = (\e' -> Inpu

291{-# INLINE inputElementConfig_elementConfig #-}

277{-# INLINE inputElementConfig_elementConfig #-}

292#endif

278#endif

293

279

294−instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (InputElementConfig er t m) where

280+instance (Reflex t, er ~ EventResult, DomSpace s) => Default (InputElementConfig er t s) where

295 {-# INLINABLE def #-}

281 {-# INLINABLE def #-}

296 def = InputElementConfig

282 def = InputElementConfig

297 { _inputElementConfig_initialValue = ""

283 { _inputElementConfig_initialValue = ""

@@ -331,7 +317,7 @@ textAreaElementConfig_elementConfig f (TextAreaElementConfig a b c) = (\c' -> Te

331{-# INLINE textAreaElementConfig_elementConfig #-}

317{-# INLINE textAreaElementConfig_elementConfig #-}

332#endif

318#endif

333

319

334−instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (TextAreaElementConfig er t m) where

320+instance (Reflex t, er ~ EventResult, DomSpace s) => Default (TextAreaElementConfig er t s) where

335 {-# INLINABLE def #-}

321 {-# INLINABLE def #-}

336 def = TextAreaElementConfig

322 def = TextAreaElementConfig

337 { _textAreaElementConfig_initialValue = ""

323 { _textAreaElementConfig_initialValue = ""

@@ -353,9 +339,9 @@ extractRawElementConfig cfg = RawElementConfig

353 , _rawElementConfig_eventSpec = _elementConfig_eventSpec cfg

339 , _rawElementConfig_eventSpec = _elementConfig_eventSpec cfg

354 }

340 }

355

341

356−data RawElementConfig er t m = RawElementConfig

342+data RawElementConfig er t s = RawElementConfig

357 { _rawElementConfig_modifyAttributes :: Maybe (Event t (Map AttributeName (Maybe Text)))

343 { _rawElementConfig_modifyAttributes :: Maybe (Event t (Map AttributeName (Maybe Text)))

358− , _rawElementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

344+ , _rawElementConfig_eventSpec :: EventSpec s er

359 }

345 }

360

346

361#ifndef USE_TEMPLATE_HASKELL

347#ifndef USE_TEMPLATE_HASKELL

@@ -368,7 +354,7 @@ rawElementConfig_eventSpec f (RawElementConfig a b) = (\b' -> RawElementConfig a

368{-# INLINE rawElementConfig_eventSpec #-}

354{-# INLINE rawElementConfig_eventSpec #-}

369#endif

355#endif

370

356

371−instance (Reflex t, DomSpace (DomBuilderSpace m)) => Default (RawElementConfig EventResult t m) where

357+instance (Reflex t, DomSpace s) => Default (RawElementConfig EventResult t s) where

372 def = RawElementConfig

358 def = RawElementConfig

373 { _rawElementConfig_modifyAttributes = Nothing

359 { _rawElementConfig_modifyAttributes = Nothing

374 , _rawElementConfig_eventSpec = def

360 , _rawElementConfig_eventSpec = def

@@ -393,7 +379,7 @@ selectElementConfig_elementConfig f (SelectElementConfig a b c) = (\c' -> Select

393{-# INLINE selectElementConfig_elementConfig #-}

379{-# INLINE selectElementConfig_elementConfig #-}

394#endif

380#endif

395

381

396−instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (SelectElementConfig er t m) where

382+instance (Reflex t, er ~ EventResult, DomSpace s) => Default (SelectElementConfig er t s) where

397 def = SelectElementConfig

383 def = SelectElementConfig

398 { _selectElementConfig_initialValue = ""

384 { _selectElementConfig_initialValue = ""

399 , _selectElementConfig_setValue = Nothing

385 , _selectElementConfig_setValue = Nothing

@@ -518,7 +504,7 @@ instance HasNamespace (ElementConfig er t m) where

518 {-# INLINABLE namespace #-}

504 {-# INLINABLE namespace #-}

519 namespace = elementConfig_namespace

505 namespace = elementConfig_namespace

520

506

521−instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (ElementConfig er t m) where

507+instance (Reflex t, er ~ EventResult, DomSpace s) => Default (ElementConfig er t s) where

522 {-# INLINABLE def #-}

508 {-# INLINABLE def #-}

523 def = ElementConfig

509 def = ElementConfig

524 { _elementConfig_namespace = Nothing

510 { _elementConfig_namespace = Nothing

@@ -529,7 +515,7 @@ instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (ElementConfig

529

515

530instance (DomBuilder t m, PerformEvent t m, MonadFix m, MonadHold t m) => DomBuilder t (PostBuildT t m) where

516instance (DomBuilder t m, PerformEvent t m, MonadFix m, MonadHold t m) => DomBuilder t (PostBuildT t m) where

531 type DomBuilderSpace (PostBuildT t m) = DomBuilderSpace m

517 type DomBuilderSpace (PostBuildT t m) = DomBuilderSpace m

532− wrapRawElement e cfg = liftWith $ \run -> wrapRawElement e $ fmap1 run cfg

518+ wrapRawElement e = lift . wrapRawElement e

533

519

534instance (MountableDomBuilder t m, PerformEvent t m, MonadFix m, MonadHold t m) => MountableDomBuilder t (PostBuildT t m) where

520instance (MountableDomBuilder t m, PerformEvent t m, MonadFix m, MonadHold t m) => MountableDomBuilder t (PostBuildT t m) where

535 type DomFragment (PostBuildT t m) = DomFragment m

521 type DomFragment (PostBuildT t m) = DomFragment m

@@ -541,99 +527,55 @@ instance (DomBuilder t m, Monoid w, MonadHold t m, MonadFix m) => DomBuilder t (

541 textNode = liftTextNode

527 textNode = liftTextNode

542 element elementTag cfg (DynamicWriterT child) = DynamicWriterT $ do

528 element elementTag cfg (DynamicWriterT child) = DynamicWriterT $ do

543 s <- get

529 s <- get

544− let cfg' = liftElementConfig cfg

545− (el, (a, newS)) <- lift $ element elementTag cfg' $ runStateT child s

530+ (el, (a, newS)) <- lift $ element elementTag cfg $ runStateT child s

546 put newS

531 put newS

547 return (el, a)

532 return (el, a)

548− inputElement cfg = lift $ inputElement $ cfg & inputElementConfig_elementConfig %~ liftElementConfig

533+ inputElement = lift . inputElement

549− textAreaElement cfg = lift $ textAreaElement $ cfg & textAreaElementConfig_elementConfig %~ liftElementConfig

534+ textAreaElement = lift . textAreaElement

550 selectElement cfg (DynamicWriterT child) = DynamicWriterT $ do

535 selectElement cfg (DynamicWriterT child) = DynamicWriterT $ do

551 s <- get

536 s <- get

552− let cfg' = cfg & selectElementConfig_elementConfig %~ liftElementConfig

553− (el, (a, newS)) <- lift $ selectElement cfg' $ runStateT child s

537+ (el, (a, newS)) <- lift $ selectElement cfg $ runStateT child s

554 put newS

538 put newS

555 return (el, a)

539 return (el, a)

556 placeRawElement = lift . placeRawElement

540 placeRawElement = lift . placeRawElement

557− wrapRawElement e cfg = lift $ wrapRawElement e $ cfg

541+ wrapRawElement e = lift . wrapRawElement e

558− { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg

559− }

560

542

561instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RequesterT t request response m) where

543instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RequesterT t request response m) where

562 type DomBuilderSpace (RequesterT t request response m) = DomBuilderSpace m

544 type DomBuilderSpace (RequesterT t request response m) = DomBuilderSpace m

563 textNode = liftTextNode

545 textNode = liftTextNode

564 element elementTag cfg (RequesterT child) = RequesterT $ do

546 element elementTag cfg (RequesterT child) = RequesterT $ do

565 r <- ask

547 r <- ask

566− let cfg' = liftElementConfig cfg

567− (el, (a, e)) <- lift $ lift $ element elementTag cfg' $ runReaderT (runEventWriterT child) r

548+ (el, (a, e)) <- lift $ lift $ element elementTag cfg $ runReaderT (runEventWriterT child) r

568 tellEvent e

549 tellEvent e

569 return (el, a)

550 return (el, a)

570− inputElement cfg = lift $ inputElement $ cfg & inputElementConfig_elementConfig %~ liftElementConfig

551+ inputElement = lift . inputElement

571− textAreaElement cfg = lift $ textAreaElement $ cfg & textAreaElementConfig_elementConfig %~ liftElementConfig

552+ textAreaElement = lift . textAreaElement

572 selectElement cfg (RequesterT child) = RequesterT $ do

553 selectElement cfg (RequesterT child) = RequesterT $ do

573 r <- ask

554 r <- ask

574− let cfg' = cfg & selectElementConfig_elementConfig %~ liftElementConfig

575− (el, (a, e)) <- lift $ lift $ selectElement cfg' $ runReaderT (runEventWriterT child) r

555+ (el, (a, e)) <- lift $ lift $ selectElement cfg $ runReaderT (runEventWriterT child) r

576 tellEvent e

556 tellEvent e

577 return (el, a)

557 return (el, a)

578 placeRawElement = lift . placeRawElement

558 placeRawElement = lift . placeRawElement

579− wrapRawElement e cfg = lift $ wrapRawElement e $ cfg

559+ wrapRawElement e = lift . wrapRawElement e

580− { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg

581− }

582

560

583instance (DomBuilder t m, MonadHold t m, MonadFix m, Semigroup w, Monoid w) => DomBuilder t (EventWriterT t w m) where

561instance (DomBuilder t m, MonadHold t m, MonadFix m, Semigroup w, Monoid w) => DomBuilder t (EventWriterT t w m) where

584 type DomBuilderSpace (EventWriterT t w m) = DomBuilderSpace m

562 type DomBuilderSpace (EventWriterT t w m) = DomBuilderSpace m

585 textNode = liftTextNode

563 textNode = liftTextNode

586 element elementTag cfg child = do

564 element elementTag cfg child = do

587− let cfg' = liftElementConfig cfg

588− (el, (a, e)) <- lift $ element elementTag cfg' $ runEventWriterT child

565+ (el, (a, e)) <- lift $ element elementTag cfg $ runEventWriterT child

589 tellEvent e

566 tellEvent e

590 return (el, a)

567 return (el, a)

591− inputElement cfg = lift $ inputElement $ cfg & inputElementConfig_elementConfig %~ liftElementConfig

568+ inputElement = lift . inputElement

592− textAreaElement cfg = lift $ textAreaElement $ cfg & textAreaElementConfig_elementConfig %~ liftElementConfig

569+ textAreaElement = lift . textAreaElement

593 selectElement cfg child = do

570 selectElement cfg child = do

594− let cfg' = cfg & selectElementConfig_elementConfig %~ liftElementConfig

595− (el, (a, e)) <- lift $ selectElement cfg' $ runEventWriterT child

571+ (el, (a, e)) <- lift $ selectElement cfg $ runEventWriterT child

596 tellEvent e

572 tellEvent e

597 return (el, a)

573 return (el, a)

598 placeRawElement = lift . placeRawElement

574 placeRawElement = lift . placeRawElement

599− wrapRawElement e cfg = lift $ wrapRawElement e $ cfg

575+ wrapRawElement e = lift . wrapRawElement e

600− { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg

601− }

602

576

603-- * Convenience functions

577-- * Convenience functions

604

578

605−--TODO: Move/replace

606−class Functor1 (f :: (k -> *) -> *) where

607− type Functor1Constraint f (a :: k -> *) (b :: k -> *) :: Constraint

608− type Functor1Constraint f a b = ()

609− fmap1 :: Functor1Constraint f a b => (forall x. a x -> b x) -> f a -> f b

610−

611−instance Functor1 (ElementConfig er t) where

612− type Functor1Constraint (ElementConfig er t) a b = DomBuilderSpace a ~ DomBuilderSpace b

613− {-# INLINABLE fmap1 #-}

614− fmap1 _ cfg = cfg

615− { _elementConfig_eventSpec = _elementConfig_eventSpec cfg

616− }

617−

618−instance Functor1 (InputElementConfig er t) where

619− type Functor1Constraint (InputElementConfig er t) a b = Functor1Constraint (ElementConfig er t) a b

620− fmap1 f cfg = cfg & inputElementConfig_elementConfig %~ fmap1 f

621−

622−instance Functor1 (TextAreaElementConfig er t) where

623− type Functor1Constraint (TextAreaElementConfig er t) a b = Functor1Constraint (ElementConfig er t) a b

624− fmap1 f cfg = cfg & textAreaElementConfig_elementConfig %~ fmap1 f

625−

626−instance Functor1 (SelectElementConfig er t) where

627− type Functor1Constraint (SelectElementConfig er t) a b = Functor1Constraint (ElementConfig er t) a b

628− fmap1 f cfg = cfg & selectElementConfig_elementConfig %~ fmap1 f

629−

630−instance Functor1 (RawElementConfig er t) where

631− type Functor1Constraint (RawElementConfig er t) a b = DomBuilderSpace a ~ DomBuilderSpace b

632− {-# INLINABLE fmap1 #-}

633− fmap1 _ cfg = cfg

634− { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg

635− }

636−

637class HasDomEvent t target eventName where

579class HasDomEvent t target eventName where

638 type DomEventType target eventName :: *

580 type DomEventType target eventName :: *

639 domEvent :: EventName eventName -> target -> Event t (DomEventType target eventName)

581 domEvent :: EventName eventName -> target -> Event t (DomEventType target eventName)

@@ -685,17 +627,8 @@ liftWithStateless a = liftWith $ \run -> a $ \x -> fromStT (Proxy :: Proxy t) <$

685liftTextNode :: (MonadTrans f, DomBuilder t m) => TextNodeConfig t -> f m (TextNode (DomBuilderSpace m) t)

627liftTextNode :: (MonadTrans f, DomBuilder t m) => TextNodeConfig t -> f m (TextNode (DomBuilderSpace m) t)

686liftTextNode = lift . textNode

628liftTextNode = lift . textNode

687

629

688−liftElement :: LiftDomBuilder t f m => Text -> ElementConfig er t (f m) -> f m a -> f m (Element er (DomBuilderSpace m) t, a)

630+liftElement :: LiftDomBuilder t f m => Text -> ElementConfig er t (DomBuilderSpace m) -> f m a -> f m (Element er (DomBuilderSpace m) t, a)

689−liftElement elementTag cfg child = liftWithStateless $ \run -> element elementTag (fmap1 run cfg) $ run child

631+liftElement elementTag cfg child = liftWithStateless $ \run -> element elementTag cfg $ run child

690−

691−liftInputElement :: LiftDomBuilder t f m => InputElementConfig er t (f m) -> f m (InputElement er (DomBuilderSpace m) t)

692−liftInputElement cfg = liftWithStateless $ \run -> inputElement $ fmap1 run cfg

693−

694−liftTextAreaElement :: LiftDomBuilder t f m => TextAreaElementConfig er t (f m) -> f m (TextAreaElement er (DomBuilderSpace m) t)

695−liftTextAreaElement cfg = liftWithStateless $ \run -> textAreaElement $ fmap1 run cfg

696−

697−liftWrapRawElement :: LiftDomBuilder t f m => RawElement (DomBuilderSpace m) -> RawElementConfig er t (f m) -> f m (Element er (DomBuilderSpace m) t)

698−liftWrapRawElement e es = liftWithStateless $ \run -> wrapRawElement e $ fmap1 run es

699

632

700class (Reflex t, Monad m) => DomRenderHook t m | m -> t where

633class (Reflex t, Monad m) => DomRenderHook t m | m -> t where

701 withRenderHook :: (forall x. JSM x -> JSM x) -> m a -> m a

634 withRenderHook :: (forall x. JSM x -> JSM x) -> m a -> m a

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+2−2

@@ -309,7 +309,7 @@ collectUpToGivenParent currentParent s e = do

309

310newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))

311

312−wrap :: forall m er t. SupportsImmediateDomBuilder t m => RawElement GhcjsDomSpace -> RawElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m (Element er GhcjsDomSpace t)

312+wrap :: forall m er t. SupportsImmediateDomBuilder t m => RawElement GhcjsDomSpace -> RawElementConfig er t GhcjsDomSpace -> ImmediateDomBuilderT t m (Element er GhcjsDomSpace t)

313wrap e cfg = do

314 events <- askEvents

315 forM_ (_rawElementConfig_modifyAttributes cfg) $ \modifyAttrs -> requestDomAction_ $ ffor modifyAttrs $ imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of

@@ -353,7 +353,7 @@ wrap e cfg = do

353 }

354

355{-# INLINABLE makeElement #-}

356−makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.Element)

356+makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t GhcjsDomSpace -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.Element)

357makeElement elementTag cfg child = do

358 doc <- askDocument

359 e <- liftJSM $ uncheckedCastTo DOM.Element <$> case cfg ^. namespace of

reflex-dom-core/src/Reflex/Dom/Builder/InputDisabled.hs+3−3

@@ -74,14 +74,14 @@ instance MonadAdjust t m => MonadAdjust t (InputDisabledT m) where

74instance DomBuilder t m => DomBuilder t (InputDisabledT m) where

75 type DomBuilderSpace (InputDisabledT m) = DomBuilderSpace m

76 inputElement cfg = lift $ inputElement $ cfg

77− { _inputElementConfig_elementConfig = liftElementConfig $ disableElementConfig $ _inputElementConfig_elementConfig cfg

77+ { _inputElementConfig_elementConfig = disableElementConfig $ _inputElementConfig_elementConfig cfg

78 }

79 textAreaElement cfg = lift $ textAreaElement $ cfg

80− { _textAreaElementConfig_elementConfig = liftElementConfig $ disableElementConfig $ _textAreaElementConfig_elementConfig cfg

80+ { _textAreaElementConfig_elementConfig = disableElementConfig $ _textAreaElementConfig_elementConfig cfg

81 }

82 selectElement cfg child = do

83 let cfg' = cfg

84− { _selectElementConfig_elementConfig = liftElementConfig $ disableElementConfig $ _selectElementConfig_elementConfig cfg

84+ { _selectElementConfig_elementConfig = disableElementConfig $ _selectElementConfig_elementConfig cfg

85 }

86 lift $ selectElement cfg' $ runInputDisabledT child

reflex-dom-core/src/Reflex/Dom/Old.hs+5−5

@@ -160,7 +160,7 @@ instance Attributes m (Map Text Text) t where

160 let cfg = def & elementConfig_namespace .~ ns

161 buildElementCommon elementTag child =<< addStaticAttributes attrs cfg

162

163−addStaticAttributes :: Applicative m => Map Text Text -> ElementConfig er t m -> m (ElementConfig er t m)

163+addStaticAttributes :: Applicative m => Map Text Text -> ElementConfig er t (DomBuilderSpace m) -> m (ElementConfig er t (DomBuilderSpace m))

164addStaticAttributes attrs cfg = do

165 let initialAttrs = Map.fromList $ first (AttributeName Nothing) <$> Map.toList attrs

166 pure $ cfg & elementConfig_initialAttributes .~ initialAttrs

@@ -170,12 +170,12 @@ instance PostBuild t m => Attributes m (Dynamic t (Map Text Text)) t where

170 let cfg = def & elementConfig_namespace .~ ns

171 buildElementCommon elementTag child =<< addDynamicAttributes attrs cfg

172

173−addDynamicAttributes :: PostBuild t m => Dynamic t (Map Text Text) -> ElementConfig er t m -> m (ElementConfig er t m)

173+addDynamicAttributes :: PostBuild t m => Dynamic t (Map Text Text) -> ElementConfig er t (DomBuilderSpace m) -> m (ElementConfig er t (DomBuilderSpace m))

174addDynamicAttributes attrs cfg = do

175 modifyAttrs <- dynamicAttributesToModifyAttributes attrs

176 return $ cfg & elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

177

178−buildElementCommon :: MonadWidget t m => Text -> m a -> ElementConfig er t m -> m (Element er (DomBuilderSpace m) t, a)

178+buildElementCommon :: MonadWidget t m => Text -> m a -> ElementConfig er t (DomBuilderSpace m) -> m (Element er (DomBuilderSpace m) t, a)

179buildElementCommon elementTag child cfg = element elementTag cfg child

180

181

@@ -233,7 +233,7 @@ wrapElement :: forall t m. MonadWidget t m => (forall en. DOM.HTMLElement -> Eve

233wrapElement eh e = do

234 let h :: (EventName en, GhcjsDomEvent en) -> JSM (Maybe (EventResult en))

235 h (en, GhcjsDomEvent evt) = runReaderT (eh e en) evt

236− wrapRawElement (DOM.toElement e) $ (def :: RawElementConfig EventResult t m)

236+ wrapRawElement (DOM.toElement e) $ (def :: RawElementConfig EventResult t (DomBuilderSpace m))

237 { _rawElementConfig_eventSpec = def

238 { _ghcjsEventSpec_handler = GhcjsEventHandler h

239 }

@@ -263,7 +263,7 @@ elStopPropagationNS :: forall t m en a. (MonadWidget t m) => Maybe Text -> Text

263elStopPropagationNS ns elementTag en child = do

264 let f = GhcjsEventFilter $ \_ -> do

265 return (stopPropagation, return Nothing)

266− cfg = (def :: ElementConfig EventResult t m)

266+ cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))

267 & namespace .~ ns

268 & elementConfig_eventSpec . ghcjsEventSpec_filters %~ DMap.insert en f

269 snd <$> element elementTag cfg child

reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+6−6

@@ -290,8 +290,8 @@ checkboxView dAttrs dValue = do

290 t <- Event.getTarget evt

291 b <- Input.getChecked $ uncheckedCastTo Input.HTMLInputElement t

292 return $ (,) preventDefault $ return $ Just $ CheckboxViewEventResult b

293− elementConfig :: ElementConfig CheckboxViewEventResult t m

293+ elementConfig :: ElementConfig CheckboxViewEventResult t (DomBuilderSpace m)

294− elementConfig = (def :: ElementConfig EventResult t m)

294+ elementConfig = (def :: ElementConfig EventResult t (DomBuilderSpace m))

295 { _elementConfig_modifyAttributes = Just $ fmap mapKeysToAttributeName modifyAttrs

296 , _elementConfig_initialAttributes = Map.mapKeys (AttributeName Nothing) permanentAttrs

297 , _elementConfig_eventSpec = GhcjsEventSpec

@@ -305,8 +305,8 @@ checkboxView dAttrs dValue = do

305 return $ ffor mr $ \(EventResult r) -> CheckboxViewEventResult $ regularToCheckboxViewEventType en r

306 }

307 }

308− inputElementConfig :: InputElementConfig CheckboxViewEventResult t m

308+ inputElementConfig :: InputElementConfig CheckboxViewEventResult t (DomBuilderSpace m)

309− inputElementConfig = (def :: InputElementConfig EventResult t m)

309+ inputElementConfig = (def :: InputElementConfig EventResult t (DomBuilderSpace m))

310 & inputElementConfig_setChecked .~ leftmost [updated dValue, tag (current dValue) postBuild]

311 & inputElementConfig_elementConfig .~ elementConfig

312 i <- inputElement inputElementConfig

@@ -333,10 +333,10 @@ fileInput config = do

333 modifyAttrs <- dynamicAttributesToModifyAttributes dAttrs

334 let filters = DMap.singleton Change . GhcjsEventFilter $ \_ -> do

335 return . (,) mempty $ return . Just $ EventResult ()

336− elCfg = (def :: ElementConfig EventResult t m)

336+ elCfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))

337 & modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

338 & elementConfig_eventSpec . ghcjsEventSpec_filters .~ filters

339− cfg = (def :: InputElementConfig EventResult t m) & inputElementConfig_elementConfig .~ elCfg

339+ cfg = (def :: InputElementConfig EventResult t (DomBuilderSpace m)) & inputElementConfig_elementConfig .~ elCfg

340 eRaw <- inputElement cfg

341 let e = _inputElement_raw eRaw

342 eChange <- wrapDomEvent e (`on` Events.change) $ do