git.iko.soy/reflex-dom
on develop help sign in
Factored out common environment field of `ImmediateDomBuilderT` and `TriggerEventT`
commit4026f78f1cd726c08c20a850b52207b735125db5 authorWill Fancher <elvishjerricco@gmail.com> dateTue 25 Apr 2017, 16:11 (10 years ago) parent1a29cfa
2 files changed+6−7
compare with develop
unifiedsplit
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−3 reflex-dom-core/src/Reflex/Dom/Main.hs+2−4
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−3
@@ -86,6 +86,7 @@ import Reflex.Host.Class
8686import Reflex.PerformEvent.Class
8787import Reflex.PostBuild.Class
8888import Reflex.TriggerEvent.Base hiding (askEvents)
89+import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)
8990import Reflex.TriggerEvent.Class
9091
9192import Control.Concurrent
@@ -146,7 +147,6 @@ import Foreign.JavaScript.Internal.Utils
146147data ImmediateDomBuilderEnv t m
147148 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document
148149 , _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.
150150 }
151151
152152newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilderT :: ReaderT (ImmediateDomBuilderEnv t m) (RequesterT t JSM Identity (TriggerEventT t m)) a }
@@ -186,8 +186,9 @@ runImmediateDomBuilderT
186186 )
187187 => ImmediateDomBuilderT t m a
188188 -> ImmediateDomBuilderEnv t m
189+ -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
189190 -> m a
190−runImmediateDomBuilderT (ImmediateDomBuilderT a) env = flip runTriggerEventT (_immediateDomBuilderEnv_events env) $ do
191+runImmediateDomBuilderT (ImmediateDomBuilderT a) env eventChan = flip runTriggerEventT eventChan $ do
191192 win <- DOM.currentWindowUnchecked
192193 rec (x, req) <- runRequesterT (runReaderT a env) rsp
193194 rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame win f $
@@ -212,7 +213,7 @@ askParent = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_parent
212213
213214{-# INLINABLE askEvents #-}
214215askEvents :: Monad m => ImmediateDomBuilderT t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
215−askEvents = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_events
216+askEvents = ImmediateDomBuilderT . lift . lift $ TriggerEventT.askEvents
216217
217218{-# INLINABLE append #-}
218219append :: (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
9393 let builderEnv = ImmediateDomBuilderEnv
9494 { _immediateDomBuilderEnv_document = toDocument doc
9595 , _immediateDomBuilderEnv_parent = toNode df
96− , _immediateDomBuilderEnv_events = events
9796 }
98− runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) jsSing
97+ runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv events) jsSing
9998 rec b <- go (headWidget a) headFragment
10099 a <- go (bodyWidget b) bodyFragment
101100 return (events, postBuildTriggerRef)
@@ -119,9 +118,8 @@ attachWidget' rootElement jsSing w = do
119118 let builderEnv = ImmediateDomBuilderEnv
120119 { _immediateDomBuilderEnv_document = toDocument doc
121120 , _immediateDomBuilderEnv_parent = toNode df
122− , _immediateDomBuilderEnv_events = events
123121 }
124− a <- runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) jsSing
122+ a <- runWithJSContextSingleton (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv events) jsSing
125123 return ((a, events), postBuildTriggerRef)
126124 replaceElementContents rootElement df
127125 liftIO $ processAsyncEvents events fc