git.iko.soy/reflex-dom
on develop help sign in
Merge pull request #291 from reflex-frp/km-hydration-switchoverAction-jsm

Make hydration switchover action be JSM instead of IO

commit5bebc3e3687c039a9471cc6584d36c6535f65100 authorTom Smalley <tomsmalley@users.noreply.github.com> dateThu 28 Feb 2019, 14:52 (8 years ago) parentc70dce366fe7b1
2 files changed+6−6
compare with develop
unifiedsplit
reflex-dom-core/src/Reflex/Dom/Main.hs+5−5 reflex-dom-core/test/hydration.hs+1−1
reflex-dom-core/src/Reflex/Dom/Main.hs+5−5
@@ -64,12 +64,12 @@ mainHydrationWidgetWithHead' :: HydrationWidget () () -> HydrationWidget () () -
6464mainHydrationWidgetWithHead' = mainHydrationWidgetWithSwitchoverAction' (pure ())
6565
6666{-# INLINE mainHydrationWidgetWithSwitchoverAction #-}
67−mainHydrationWidgetWithSwitchoverAction :: IO () -> (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()
67+mainHydrationWidgetWithSwitchoverAction :: JSM () -> (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()
6868mainHydrationWidgetWithSwitchoverAction = mainHydrationWidgetWithSwitchoverAction'
6969
7070{-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-}
7171-- | Warning: `mainHydrationWidgetWithSwitchoverAction'` is provided only as performance tweak. It is expected to disappear in future releases.
72−mainHydrationWidgetWithSwitchoverAction' :: IO () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()
72+mainHydrationWidgetWithSwitchoverAction' :: JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()
7373mainHydrationWidgetWithSwitchoverAction' switchoverAction head' body = do
7474 runHydrationWidgetWithHeadAndBody switchoverAction $ \appendHead appendBody -> do
7575 appendHead head'
@@ -77,7 +77,7 @@ mainHydrationWidgetWithSwitchoverAction' switchoverAction head' body = do
7777
7878{-# INLINABLE attachHydrationWidget #-}
7979attachHydrationWidget
80− :: IO ()
80+ :: JSM ()
8181 -> JSContextSingleton ()
8282 -> ( Event DomTimeline ()
8383 -> IORef HydrationMode
@@ -105,7 +105,7 @@ attachHydrationWidget switchoverAction jsSing w = do
105105 let hydrate = runHydrationRunnerT runner Nothing rootNode events
106106 void $ runWithJSContextSingleton (runPostBuildT hydrate never) jsSing
107107 liftIO $ writeIORef hydrationMode HydrationMode_Immediate
108− liftIO $ switchoverAction
108+ runWithJSContextSingleton (DOM.liftJSM switchoverAction) jsSing
109109 pure (result, fc)
110110
111111type HydrationWidget x a = HydrationDomBuilderT HydrationDomSpace DomTimeline (DomCoreWidget x) a
@@ -117,7 +117,7 @@ type DomCoreWidget x = PostBuildT DomTimeline (WithJSContextSingleton x (Perform
117117
118118{-# INLINABLE runHydrationWidgetWithHeadAndBody #-}
119119runHydrationWidgetWithHeadAndBody
120− :: IO ()
120+ :: JSM ()
121121 -> ( (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to head"
122122 -> (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to body"
123123 -> FloatingWidget () ()
reflex-dom-core/test/hydration.hs+1−1
@@ -1374,7 +1374,7 @@ testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out")
13741374 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover
13751375 let entryPoint = do
13761376 liftIO $ takeMVar waitBeforeJS
1377− mainHydrationWidgetWithSwitchoverAction (putMVar waitUntilSwitchover ()) (pure ()) bodyWidget
1377+ mainHydrationWidgetWithSwitchoverAction (liftIO $ putMVar waitUntilSwitchover ()) (pure ()) bodyWidget
13781378 syncPoint
13791379 application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse ->
13801380 sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html