git.iko.soy/reflex-dom
on develop help sign in
Factored out common environment field of `ImmediateDomBuilderT` and `TriggerEventT`
4026f78Will Fancher
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−3
compare with develop
unifiedsplit
@@ -86,6 +86,7 @@ import Reflex.Host.Class
86import Reflex.PerformEvent.Class
86import Reflex.PerformEvent.Class
87import Reflex.PostBuild.Class
87import Reflex.PostBuild.Class
88import Reflex.TriggerEvent.Base hiding (askEvents)
88import Reflex.TriggerEvent.Base hiding (askEvents)
89+import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)
89import Reflex.TriggerEvent.Class
90import Reflex.TriggerEvent.Class
90
91
91import Control.Concurrent
92import Control.Concurrent
@@ -146,7 +147,6 @@ import Foreign.JavaScript.Internal.Utils
146data ImmediateDomBuilderEnv t m
147data ImmediateDomBuilderEnv t m
147 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document
148 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document
148 , _immediateDomBuilderEnv_parent :: Node
149 , _immediateDomBuilderEnv_parent :: Node
149− , _immediateDomBuilderEnv_events :: Chan [DSum (EventTriggerRef t) TriggerInvocation] -- TODO: The same chan needs to be passed to 'TriggerEventT'; this should be factored out.
150 }
150 }
151
151
152newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilderT :: ReaderT (ImmediateDomBuilderEnv t m) (RequesterT t JSM Identity (TriggerEventT t m)) a }
152newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilderT :: ReaderT (ImmediateDomBuilderEnv t m) (RequesterT t JSM Identity (TriggerEventT t m)) a }
@@ -186,8 +186,9 @@ runImmediateDomBuilderT
186 )
186 )
187 => ImmediateDomBuilderT t m a
187 => ImmediateDomBuilderT t m a
188 -> ImmediateDomBuilderEnv t m
188 -> ImmediateDomBuilderEnv t m
189+ -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
189 -> m a
190 -> m a
190−runImmediateDomBuilderT (ImmediateDomBuilderT a) env = flip runTriggerEventT (_immediateDomBuilderEnv_events env) $ do
191+runImmediateDomBuilderT (ImmediateDomBuilderT a) env eventChan = flip runTriggerEventT eventChan $ do
191 win <- DOM.currentWindowUnchecked
192 win <- DOM.currentWindowUnchecked
192 rec (x, req) <- runRequesterT (runReaderT a env) rsp
193 rec (x, req) <- runRequesterT (runReaderT a env) rsp
193 rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame win f $
194 rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame win f $
@@ -212,7 +213,7 @@ askParent = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_parent
212
213
213{-# INLINABLE askEvents #-}
214{-# INLINABLE askEvents #-}
214askEvents :: Monad m => ImmediateDomBuilderT t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
215askEvents :: Monad m => ImmediateDomBuilderT t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
215−askEvents = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_events
216+askEvents = ImmediateDomBuilderT . lift . lift $ TriggerEventT.askEvents
216
217
217{-# INLINABLE append #-}
218{-# INLINABLE append #-}
218append :: (IsNode n, MonadJSM m) => n -> ImmediateDomBuilderT t m ()
219append :: (IsNode n, MonadJSM m) => n -> ImmediateDomBuilderT t m ()
reflex-dom-core/src/Reflex/Dom/Main.hs+2−4
@@ -93,9 +93,8 @@ mainWidgetWithHead' widgets = withJSContextSingletonMono $ \jsSing -> do
93 let builderEnv = ImmediateDomBuilderEnv
93 let builderEnv = ImmediateDomBuilderEnv
94 { _immediateDomBuilderEnv_document = toDocument doc
94 { _immediateDomBuilderEnv_document = toDocument doc
95 , _immediateDomBuilderEnv_parent = toNode df
95 , _immediateDomBuilderEnv_parent = toNode df
96− , _immediateDomBuilderEnv_events = events
97 }
96 }
98− runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) jsSing
97+ runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv events) jsSing
99 rec b <- go (headWidget a) headFragment
98 rec b <- go (headWidget a) headFragment
100 a <- go (bodyWidget b) bodyFragment
99 a <- go (bodyWidget b) bodyFragment
101 return (events, postBuildTriggerRef)
100 return (events, postBuildTriggerRef)
@@ -119,9 +118,8 @@ attachWidget' rootElement jsSing w = do
119 let builderEnv = ImmediateDomBuilderEnv
118 let builderEnv = ImmediateDomBuilderEnv
120 { _immediateDomBuilderEnv_document = toDocument doc
119 { _immediateDomBuilderEnv_document = toDocument doc
121 , _immediateDomBuilderEnv_parent = toNode df
120 , _immediateDomBuilderEnv_parent = toNode df
122− , _immediateDomBuilderEnv_events = events
123 }
121 }
124− a <- runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) jsSing
122+ a <- runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv events) jsSing
125 return ((a, events), postBuildTriggerRef)
123 return ((a, events), postBuildTriggerRef)
126 replaceElementContents rootElement df
124 replaceElementContents rootElement df
127 liftIO $ processAsyncEvents events fc
125 liftIO $ processAsyncEvents events fc