on develop help sign in
Hydrate text nodes properly, remove DOM type

- Fixes hydration for adjacent text nodes being squashed into one - Fixes hydration for empty text nodes (at postBuild) - Remove DOM type and use HydrationRunnerT directly This simplifies accumulation and running Also push the 'hold's into a runWithReplace that is replaced at switchover time, hopefully this can remove the hydration overhead

commit5dec4701a06c0ccd8c20a16e5f15b6a30835aee7 authorTom Smalley <tfsmalley@gmail.com> dateMon 26 Nov 2018, 19:38 (8 years ago) parent404fa3b
3 files changed+137−132
reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+136−130 reflex-dom-core/src/Reflex/Dom/Builder/Static.hs−1 reflex-dom-core/src/Reflex/Dom/Prerender.hs+1−1
reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+136−130
@@ -37,8 +37,8 @@ module Reflex.Dom.Builder.Hydration
3737 , HydrationMode (..)
3838 , HydrationRunnerT (..)
3939 , runHydrationRunnerT
40− , DOM(..), runDOMForest
41− , hydrateDOM
40+ , addHydrationStepWithSetup
41+ , addHydrationStep
4242 , hydrateNode
4343 , getPreviousNode, setPreviousNode
4444 , runHydrationDomBuilderT
@@ -47,7 +47,6 @@ module Reflex.Dom.Builder.Hydration
4747 , append
4848 , textNodeInternal
4949 , SupportsHydrationDomBuilder
50− , EventFilterTriggerRef (..)
5150 , wrap
5251 , makeElement
5352 , drawChildUpdate
@@ -127,6 +126,7 @@ import GHCJS.DOM.Node (appendChild_, getChildNodes, getOwnerDocumentUnchecked, g
127126import qualified GHCJS.DOM.Node as DOM (insertBefore_)
128127import qualified GHCJS.DOM.Node as Node
129128import qualified GHCJS.DOM.NodeList as NodeList
129+import qualified GHCJS.DOM.Text as DOM
130130import GHCJS.DOM.Types
131131 (liftJSM, askJSM, runJSM, JSM, MonadJSM,
132132 FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,
@@ -185,7 +185,7 @@ instance DomSpace HydrationDomSpace where
185185 in DMap.alter f' en $ _ghcjsEventSpec_filters es
186186 }
187187
188−data HydrationDomBuilderEnv = HydrationDomBuilderEnv
188+data HydrationDomBuilderEnv t = HydrationDomBuilderEnv
189189 { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
190190 -- ^ Reference to the document
191191 , _hydrationDomBuilderEnv_parent :: {-# UNPACK #-} !(IORef Node)
@@ -197,34 +197,9 @@ data HydrationDomBuilderEnv = HydrationDomBuilderEnv
197197 -- ^ Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
198198 , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
199199 -- ^ In hydration mode? Should be switched to `HydrationMode_Immediate` after hydration is finished
200+ , _hydrationDomBuilderEnv_switchover :: {-# UNPACK #-} !(Event t ())
200201 }
201202
202−data DOM t m
203− = DOM_Element (HydrationRunnerT t m Node) [DOM t m]
204− -- ^ Nodes with children, the action returns the node for the children to use as a parent
205− | DOM_Node (HydrationRunnerT t m ())
206− -- ^ Nodes without children
207− | DOM_Replace (HydrationRunnerT t m ()) (HydrationRunnerT t m ()) (Behavior t [DOM t m])
208− -- ^ First and second fields setup the start and end markers respectively, the
209− -- third contains the actual content which changes over time
210−
211−runDOMForest
212− :: (Ref m ~ IORef, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, DOM.MonadJSM m, DOM.MonadJSM (Performable m), MonadRef m, MonadSample t m)
213− => [DOM t m]
214− -> HydrationRunnerT t m ()
215−runDOMForest = foldl' (\acc d -> runDOMTree d >> acc) (pure ())
216−
217−runDOMTree
218− :: (Ref m ~ IORef, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, DOM.MonadJSM m, DOM.MonadJSM (Performable m), MonadRef m, MonadSample t m)
219− => DOM t m -> HydrationRunnerT t m ()
220−runDOMTree = \case
221− DOM_Node m -> m
222− DOM_Element m children -> m >>= localRunner (runDOMForest children) Nothing
223− DOM_Replace start end b -> do
224− start
225− runDOMForest =<< lift (sample b)
226− end
227−
228203-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events
229204-- State contains reference to the previous node sibling, if any.
230205newtype HydrationRunnerT t m a = HydrationRunnerT { unHydrationRunnerT :: StateT (Maybe Node) (ReaderT Node (DomRenderHookT t m)) a }
@@ -234,13 +209,13 @@ newtype HydrationRunnerT t m a = HydrationRunnerT { unHydrationRunnerT :: StateT
234209#endif
235210 )
236211
237−localRunner :: Monad m => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a
238−localRunner (HydrationRunnerT m) prev parent = HydrationRunnerT . lift $ local (\_ -> parent) (evalStateT m prev)
212+localRunner :: (MonadJSM m, Monad m) => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a
213+localRunner (HydrationRunnerT m) s parent = HydrationRunnerT . lift $ local (\_ -> parent) (evalStateT m s)
239214
240215runHydrationRunnerT
241216 :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
242217 => HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
243−runHydrationRunnerT (HydrationRunnerT m) prev parent = runDomRenderHookT (runReaderT (evalStateT m prev) parent)
218+runHydrationRunnerT (HydrationRunnerT m) s parent = runDomRenderHookT (runReaderT (evalStateT m s) parent)
244219
245220instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where
246221 {-# INLINABLE newEventWithTrigger #-}
@@ -251,17 +226,32 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRu
251226instance MonadTrans (HydrationRunnerT t) where
252227 lift = HydrationRunnerT . lift . lift . lift
253228
254−hydrateDOM :: MonadIO m => DOM t m -> HydrationDomBuilderT t m ()
255−hydrateDOM dom = getHydrationMode >>= \case
256− HydrationMode_Hydrating -> HydrationDomBuilderT $ modify (dom :)
229+instance MonadSample t m => MonadSample t (HydrationRunnerT t m) where
230+ sample = lift . sample
231+
232+-- | Add a hydration step which depends on some computation that should only be
233+-- done *before* the switchover to immediate mode - this is most likely some
234+-- form of 'hold' which we want to remove after hydration is done
235+addHydrationStepWithSetup :: (Adjustable t m, MonadIO m) => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT t m ()
236+addHydrationStepWithSetup setup f = getHydrationMode >>= \case
257237 HydrationMode_Immediate -> pure ()
238+ HydrationMode_Hydrating -> do
239+ pb <- HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_switchover -- Use postBuild as a proxy for switchover to immediate mode TODO is this correct?
240+ (s, _) <- lift $ runWithReplace setup $ return () <$ pb
241+ HydrationDomBuilderT $ modify' (>> f s)
242+
243+-- | Add a hydration step
244+addHydrationStep :: MonadIO m => HydrationRunnerT t m () -> HydrationDomBuilderT t m ()
245+addHydrationStep m = getHydrationMode >>= \case
246+ HydrationMode_Immediate -> pure ()
247+ HydrationMode_Hydrating -> HydrationDomBuilderT $ modify' (>> m)
258248
259249-- | A monad for DomBuilder which just gets the results of children and pushes
260250-- work into an action that is delayed until after postBuild (to match the
261251-- static builder). The action runs in 'HydrationRunnerT', which performs the
262252-- DOM takeover and sets up the events, after which point this monad will
263253-- continue in the vein of 'ImmediateDomBuilderT'.
264−newtype HydrationDomBuilderT t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT HydrationDomBuilderEnv (StateT [DOM t m] (DomRenderHookT t m)) a }
254+newtype HydrationDomBuilderT t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT (HydrationDomBuilderEnv t) (StateT (HydrationRunnerT t m ()) (DomRenderHookT t m)) a }
265255 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
266256#if MIN_VERSION_base(4,9,1)
267257 , MonadAsyncException
@@ -332,17 +322,17 @@ runHydrationDomBuilderT
332322 , Ref m ~ IORef
333323 )
334324 => HydrationDomBuilderT t m a
335− -> HydrationDomBuilderEnv
325+ -> HydrationDomBuilderEnv t
336326 -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
337− -> m (a, [DOM t m])
338−runHydrationDomBuilderT (HydrationDomBuilderT a) env events = runDomRenderHookT (runStateT (runReaderT a env) []) events
327+ -> m (a, HydrationRunnerT t m ())
328+runHydrationDomBuilderT (HydrationDomBuilderT a) env events = runDomRenderHookT (runStateT (runReaderT a env) (pure ())) events
339329
340330instance Monad m => HasDocument (HydrationDomBuilderT t m) where
341331 {-# INLINABLE askDocument #-}
342332 askDocument = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document
343333
344334{-# INLINABLE localEnv #-}
345−localEnv :: Monad m => (HydrationDomBuilderEnv -> HydrationDomBuilderEnv) -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m a
335+localEnv :: Monad m => (HydrationDomBuilderEnv t -> HydrationDomBuilderEnv t) -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m a
346336localEnv f = HydrationDomBuilderT . local f . unHydrationDomBuilderT
347337
348338{-# INLINABLE append #-}
@@ -425,7 +415,6 @@ hydrateNode check constructor = do
425415 liftIO $ putStr $ "Node failed check, skipping... "
426416 go (Just node)
427417 n <- go lastHydrationNode
428− liftIO $ putStrLn ""
429418 setPreviousNode $ Just $ toNode n
430419 return n
431420
@@ -518,7 +507,7 @@ makeElement elementTag cfg child = do
518507 parent <- liftIO $ newIORef $ error "Parent not yet initialized"
519508 env <- HydrationDomBuilderT ask
520509 let env' = env { _hydrationDomBuilderEnv_parent = parent}
521− (result, childDom) <- HydrationDomBuilderT $ lift $ lift $ runStateT (runReaderT (unHydrationDomBuilderT child) env') []
510+ (result, childDom) <- HydrationDomBuilderT $ lift $ lift $ runStateT (runReaderT (unHydrationDomBuilderT child) env') (pure ())
522511 wrapResult <- liftIO newEmptyMVar
523512 let activateElement = do
524513 e <- hydrateNode hasSSRAttribute DOM.Element
@@ -528,7 +517,7 @@ makeElement elementTag cfg child = do
528517 refs <- wrap events e $ extractRawElementConfig cfg
529518 liftIO $ putMVar wrapResult (e, refs)
530519 pure $ toNode e
531− hydrateDOM $ DOM_Element activateElement childDom
520+ addHydrationStep $ activateElement >>= localRunner childDom Nothing
532521
533522 -- We need the EventSelector to switch to the real event handler after activation
534523 es <- newFanEventWithTrigger $ \(WrapArg en) t -> do
@@ -553,7 +542,7 @@ makeElement elementTag cfg child = do
553542 return ((Element es (), result), error "makeElement: DOM.Element")
554543
555544{-# INLINABLE textNodeInternal #-}
556−textNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Text
545+textNodeInternal :: (Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m, Reflex t) => Text -> Maybe (Event t Text) -> HydrationDomBuilderT t m DOM.Text
557546textNodeInternal !t mSetContents = getHydrationMode >>= \case
558547 HydrationMode_Immediate -> do
559548 n <- makeNodeInternal (askDocument >>= \doc -> createTextNode doc t)
@@ -561,15 +550,45 @@ textNodeInternal !t mSetContents = getHydrationMode >>= \case
561550 pure n
562551 HydrationMode_Hydrating -> do
563552 doc <- askDocument
564− let activateText = do
565− liftIO $ putStrLn $ "Action: Text: " <> show (DOM.toJSString t)
566− n <- hydrateNode (const $ pure True) DOM.Text
567− mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
568− hydrateDOM $ DOM_Node activateText
553+ addHydrationStepWithSetup (maybe (pure $ pure t) (hold t) mSetContents) $ \currentText -> do
554+ n <- hydrateTextNode =<< sample currentText
555+ mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
569556 pure $ error "textNodeInternal: DOM.Text"
570557
558+-- | The static builder mashes adjacent text nodes into one node: we check the
559+-- text content of each node we come to, comparing it to the content we
560+-- expect. We also have a special case for empty text nodes - we always create
561+-- the and add them after the previous node reference.
562+{-# INLINABLE hydrateTextNode #-}
563+hydrateTextNode :: MonadJSM m => Text -> HydrationRunnerT t m DOM.Text
564+hydrateTextNode t@"" = do
565+ doc <- Node.getOwnerDocumentUnchecked =<< askParent
566+ textNode <- createTextNode doc t
567+ insertAfterPreviousNode textNode
568+ pure textNode
569+hydrateTextNode t = do
570+ n <- join $ go <$> askParent <*> getPreviousNode
571+ setPreviousNode $ Just $ toNode n
572+ return n
573+ where
574+ go parent mLastNode = do
575+ node <- maybe (Node.getFirstChildUnchecked parent) Node.getNextSiblingUnchecked mLastNode
576+ DOM.castTo DOM.Text node >>= \case
577+ Nothing -> go parent $ Just node
578+ Just originalNode -> do
579+ originalText <- Node.getTextContentUnchecked originalNode
580+ case T.stripPrefix t originalText of
581+ Just "" -> return originalNode
582+ Just _ -> do
583+ -- If we have the right prefix, we split the text node into a node containing the
584+ -- required text and a subsequent sibling node containing the rest of the text.
585+ DOM.splitText_ originalNode $ fromIntegral $ T.length t
586+ return originalNode
587+ Nothing -> go parent $ Just $ toNode originalNode
588+
589+
571590{-# INLINABLE commentNodeInternal #-}
572−commentNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Comment
591+commentNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t, Adjustable t m) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Comment
573592commentNodeInternal !t mSetContents = getHydrationMode >>= \case
574593 HydrationMode_Immediate -> do
575594 n <- makeNodeInternal (askDocument >>= \doc -> createComment doc t)
@@ -577,17 +596,16 @@ commentNodeInternal !t mSetContents = getHydrationMode >>= \case
577596 pure n
578597 HydrationMode_Hydrating -> do
579598 doc <- askDocument
580− let activateComment = do
581− liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)
582− n <- hydrateNode (const $ pure True) DOM.Comment
583− mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
584− hydrateDOM $ DOM_Node activateComment
599+ addHydrationStep $ do
600+ liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)
601+ n <- hydrateNode (const $ pure True) DOM.Comment
602+ mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
585603 pure $ error "commentNodeInternal: DOM.Comment"
586604
587605-- | We leave markers in the static builder as comments, and rip these comments
588606-- out at hydration time, replacing them with empty text nodes.
589607skipToAndReplaceComment
590− :: (MonadJSM m, Reflex t, MonadFix m)
608+ :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m)
591609 => Text
592610 -> IORef Text
593611 -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)
@@ -632,10 +650,10 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
632650 writeIORef keyRef key
633651 pure (switchComment, textNodeRef, keyRef)
634652
635−skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m) => HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)
653+skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m) => HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)
636654skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")
637655
638−skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m) => IORef Text -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text)
656+skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m) => IORef Text -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text)
639657skipToReplaceEnd key = fmap (\(m,e,_) -> (m,e)) $ skipToAndReplaceComment "replace-end" key
640658
641659instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT t m) where
@@ -823,7 +841,7 @@ instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjus
823841 traverseDMapWithKeyWithAdjust f m = DomRenderHookT . traverseDMapWithKeyWithAdjust (\k -> unDomRenderHookT . f k) m
824842 traverseDMapWithKeyWithAdjustWithMove f m = DomRenderHookT . traverseDMapWithKeyWithAdjustWithMove (\k -> unDomRenderHookT . f k) m
825843
826−instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, Ref m ~ IORef, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadRef m) => Adjustable t (HydrationDomBuilderT t m) where
844+instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, Ref m ~ IORef, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadRef m) => Adjustable t (HydrationDomBuilderT t m) where
827845 {-# INLINABLE runWithReplace #-}
828846 runWithReplace a0 a' = do
829847 initialEnv <- HydrationDomBuilderT ask
@@ -858,7 +876,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
858876 a <- a0
859877 insertBefore p' =<< liftIO (readIORef after)
860878 pure a
861− (result, dom) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT a0') initialEnv
879+ (result, dom) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT a0') initialEnv
862880 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
863881 , _hydrationDomBuilderEnv_commitAction = myCommitAction
864882 , _hydrationDomBuilderEnv_parent = p
@@ -884,7 +902,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
884902 insertBefore p' after'
885903 liftIO $ writeIORef currentCohort cohortId
886904 myCommitAction
887− (result, dom) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT child) $ initialEnv
905+ (result, dom) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) $ initialEnv
888906 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
889907 , _hydrationDomBuilderEnv_commitAction = case h of
890908 HydrationMode_Hydrating -> myCommitAction
@@ -900,7 +918,10 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
900918 HydrationMode_Immediate -> Right commitActionToRunNow
901919 return (actions, result)
902920 let (hydrate', commitAction) = fanEither $ fmap fst child'
903− hydrateDOM . DOM_Replace hydrateStart hydrateEnd =<< hold hydrate0 hydrate'
921+ addHydrationStepWithSetup (hold hydrate0 hydrate') $ \contents -> do
922+ hydrateStart
923+ join $ sample contents
924+ hydrateEnd
904925 requestDomAction_ $ fmapMaybe id commitAction
905926 return (result0, snd <$> child')
906927
@@ -910,8 +931,8 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
910931 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'
911932 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
912933 traverseDMapWithKeyWithAdjustWithMove = do
913− let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do
914− let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState k))) a)
934+ let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do
935+ let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState k))) a)
915936 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case
916937 PatchDMapWithMove.From_Insert (Compose (_, _, _, sRef, _)) -> do
917938 readIORef sRef >>= \case
@@ -928,11 +949,11 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
928949 p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p
929950 _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old
930951 return $ applyAlways p' old
931− hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholderRef (p_ :: PatchDMapWithMove k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) -> do
952+ hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholderRef (p_ :: PatchDMapWithMove k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) -> do
932953 let p = unPatchDMapWithMove p_
933954 phsBefore <- liftIO $ readIORef placeholders
934955 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
935− let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
956+ let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
936957 collectIfMoved k e = do
937958 let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before
938959 nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore
@@ -944,7 +965,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
944965 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder
945966 collected <- DMap.traverseWithKey collectIfMoved p
946967 let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (\(Compose (_, _, ph, _, _)) -> ph) p_) phsBefore --TODO: Don't recompute this
947− let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> JSM (Constant () a)
968+ let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> JSM (Constant () a)
948969 placeFragment k e = do
949970 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter
950971 case PatchDMapWithMove._nodeInfo_from e of
@@ -967,8 +988,8 @@ traverseDMapWithKeyWithAdjust'
967988 -> Event t (PatchDMap k v)
968989 -> HydrationDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))
969990traverseDMapWithKeyWithAdjust' = do
970− let updateChildUnreadiness (p :: PatchDMap k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do
971− let new :: forall a. k a -> ComposeMaybe (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState k))) a)
991+ let updateChildUnreadiness (p :: PatchDMap k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do
992+ let new :: forall a. k a -> ComposeMaybe (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState k))) a)
972993 new k (ComposeMaybe m) = ComposeMaybe <$> case m of
973994 Nothing -> return Nothing
974995 Just (Compose (_, _, _, sRef, _)) -> do
@@ -1000,8 +1021,8 @@ traverseIntMapWithKeyWithAdjust'
10001021 -> Event t (PatchIntMap v)
10011022 -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))
10021023traverseIntMapWithKeyWithAdjust' = do
1003− let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do
1004− let new :: IntMap.Key -> Maybe (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))
1024+ let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do
1025+ let new :: IntMap.Key -> Maybe (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))
10051026 new k m = case m of
10061027 Nothing -> return Nothing
10071028 Just (_, _, _, sRef, _) -> do
@@ -1032,19 +1053,19 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
10321053 , MonadJSM m
10331054 , MonadFix m
10341055 , PrimMonad m
1035− , Monoid (p (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1056+ , Monoid (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
10361057 , Functor p
1037− , PatchTarget (p (DOM t m)) ~ IntMap (DOM t m)
1058+ , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
10381059 , MonadHold t m
1039− , Patch (p (DOM t m))
1060+ , Patch (p (HydrationRunnerT t m ()))
10401061 )
1041− => ( (IntMap.Key -> v -> DomRenderHookT t m (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1062+ => ( (IntMap.Key -> v -> DomRenderHookT t m (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
10421063 -> IntMap v
10431064 -> Event t (p v)
1044− -> DomRenderHookT t m (IntMap (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'), Event t (p (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')))
1065+ -> DomRenderHookT t m (IntMap (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'), Event t (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')))
10451066 ) -- ^ The base monad's traversal
1046− -> (p (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IntMap (IORef ChildReadyStateInt) -> IO (IntMap (IORef ChildReadyStateInt))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1047− -> (IORef (IntMap DOM.Text) -> IORef DOM.Text -> p (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> JSM ()) -- ^ Apply a patch to the DOM
1067+ -> (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IntMap (IORef ChildReadyStateInt) -> IO (IntMap (IORef ChildReadyStateInt))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1068+ -> (IORef (IntMap DOM.Text) -> IORef DOM.Text -> p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> JSM ()) -- ^ Apply a patch to the DOM
10481069 -> (IntMap.Key -> v -> HydrationDomBuilderT t m v')
10491070 -> IntMap v
10501071 -> Event t (p v)
@@ -1053,7 +1074,7 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
10531074 (hydrateStart, _, key) <- skipToReplaceStart
10541075 initialEnv <- HydrationDomBuilderT ask
10551076 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1056− pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
1077+ pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
10571078 haveEverBeenReady <- liftIO $ newIORef False
10581079 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"
10591080 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"
@@ -1100,22 +1121,19 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
11001121 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
11011122 let result0 = IntMap.map (\(_, _, _, _, v) -> v) children0
11021123 placeholders0 = fmap (\(_, _, ph, _, _) -> ph) children0
1103− delayed0 :: IntMap (DOM t m)
1124+ delayed0 :: IntMap (HydrationRunnerT t m ())
11041125 delayed0 = IntMap.map (\(delayed, _, _, _, _) -> delayed) children0
1105− delayed' :: Event t (p (DOM t m))
1126+ delayed' :: Event t (p (HydrationRunnerT t m ()))
11061127 delayed' = ffor children' $ fmap $ \(delayed, _, _, _, _) -> delayed
11071128 result' = ffor children' $ fmap $ \(_, _, _, _, r) -> r
1108− delayed <- accumMaybeB (flip apply) delayed0 delayed'
11091129 doc <- askDocument
11101130 let setFinalPlaceholder = do
11111131 ph <- createTextNode doc ("" :: Text)
1112− parent <- askParent
1113− pn <- runMaybeT $ MaybeT . Node.getNextSibling =<< MaybeT getPreviousNode
1114− Node.insertBefore_ parent ph pn
1132+ insertAfterPreviousNode ph
11151133 liftIO $ writeIORef lastPlaceholderRef ph
1116− setPreviousNode $ Just $ toNode ph
1117− hydrateDOM $ DOM_Replace (pure ()) setFinalPlaceholder
1118− (reverse . IntMap.elems <$> delayed)
1134+ addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do
1135+ join $ sample (sequence . IntMap.elems <$> delayed)
1136+ setFinalPlaceholder
11191137 liftIO $ writeIORef placeholders $! placeholders0
11201138 getHydrationMode >>= \case
11211139 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0
@@ -1130,6 +1148,13 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
11301148 applyDomUpdate newP
11311149 return (result0, result')
11321150
1151+insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
1152+insertAfterPreviousNode node = do
1153+ parent <- askParent
1154+ nextNode <- maybe (Node.getFirstChild parent) Node.getNextSibling =<< getPreviousNode
1155+ Node.insertBefore_ parent node nextNode
1156+ setPreviousNode $ Just $ toNode node
1157+
11331158{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
11341159hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
11351160 ( Adjustable t m
@@ -1141,9 +1166,9 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
11411166 , MonadFix m
11421167 , Patch (p k v)
11431168 , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
1144− , Patch (p k (Const (DOM t m)))
1145− , PatchTarget (p k (Const (DOM t m))) ~ DMap k (Const (DOM t m))
1146− , Monoid (p k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))
1169+ , Patch (p k (Const (HydrationRunnerT t m ())))
1170+ , PatchTarget (p k (Const (HydrationRunnerT t m ()))) ~ DMap k (Const (HydrationRunnerT t m ()))
1171+ , Monoid (p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))
11471172 , Patch (p k (Constant Int))
11481173 )
11491174 => (forall vv vv'.
@@ -1153,8 +1178,8 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
11531178 -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
11541179 ) -- ^ The base monad's traversal
11551180 -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type
1156− -> (p k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k))))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1157− -> (IORef (Map.Map (Some.Some k) DOM.Text) -> IORef DOM.Text -> p k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> JSM ()) -- ^ Apply a patch to the DOM
1181+ -> (p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k))))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1182+ -> (IORef (Map.Map (Some.Some k) DOM.Text) -> IORef DOM.Text -> p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> JSM ()) -- ^ Apply a patch to the DOM
11581183 -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))
11591184 -> DMap k v
11601185 -> Event t (p k v)
@@ -1163,7 +1188,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
11631188-- (hydrateStart, _, key) <- skipToReplaceStart -- TODO
11641189 initialEnv <- HydrationDomBuilderT ask
11651190 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1166− pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) <- liftIO $ newIORef mempty
1191+ pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) <- liftIO $ newIORef mempty
11671192 haveEverBeenReady <- liftIO $ newIORef False
11681193 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"
11691194 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"
@@ -1210,22 +1235,19 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
12101235 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
12111236 let result0 = DMap.map (\(Compose (_, _, _, _, v)) -> v) children0
12121237 placeholders0 = weakenDMapWith (\(Compose (_, _, ph, _, _)) -> ph) children0
1213− delayed0 :: DMap k (Const (DOM t m))
1238+ delayed0 :: DMap k (Const (HydrationRunnerT t m ()))
12141239 delayed0 = DMap.map (\(Compose (delayed, _, _, _, _)) -> Const delayed) children0
1215− delayed' :: Event t (p k (Const (DOM t m)))
1240+ delayed' :: Event t (p k (Const (HydrationRunnerT t m ())))
12161241 delayed' = ffor children' $ mapPatch $ \(Compose (d, _, _, _, _)) -> Const d
12171242 result' = ffor children' $ mapPatch $ \(Compose (_, _, _, _, r)) -> r
1218− delayed <- accumMaybeB (flip apply) delayed0 delayed'
12191243 doc <- askDocument
12201244 let setFinalPlaceholder = do
12211245 ph <- createTextNode doc ("" :: Text)
1222− parent <- askParent
1223− pn <- runMaybeT $ MaybeT . Node.getNextSibling =<< MaybeT getPreviousNode
1224− Node.insertBefore_ parent ph pn
1246+ insertAfterPreviousNode ph
12251247 liftIO $ writeIORef lastPlaceholderRef ph
1226− setPreviousNode $ Just $ toNode ph
1227− hydrateDOM $ DOM_Replace (pure ()) setFinalPlaceholder
1228− (fmap (\(_ :=> Const d) -> d) . reverse . DMap.toList <$> delayed)
1248+ addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do
1249+ join $ sample (sequence . fmap (\(_ :=> Const d) -> d) . DMap.toList <$> delayed)
1250+ setFinalPlaceholder
12291251 liftIO $ writeIORef placeholders $! placeholders0
12301252 getHydrationMode >>= \case
12311253 HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (_, df, _, _, _)) -> Constant () <$ append (toNode df)) children0
@@ -1241,10 +1263,10 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
12411263
12421264{-# INLINABLE drawChildUpdate #-}
12431265drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)
1244− => HydrationDomBuilderEnv
1266+ => HydrationDomBuilderEnv t
12451267 -> (IORef (ChildReadyState k) -> JSM ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready
12461268 -> HydrationDomBuilderT t m (v' a)
1247− -> DomRenderHookT t m (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)
1269+ -> DomRenderHookT t m (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)
12481270drawChildUpdate initialEnv markReady child = do
12491271 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
12501272 let doc = _hydrationDomBuilderEnv_document initialEnv
@@ -1254,19 +1276,14 @@ drawChildUpdate initialEnv markReady child = do
12541276 (p, delayed) <- case hydrationMode of
12551277 HydrationMode_Hydrating -> pure
12561278 ( Left $ _hydrationDomBuilderEnv_parent initialEnv
1257− , do
1258− parent <- askParent
1259− getPreviousNode >>= \case
1260− Nothing -> Node.getFirstChild parent >>= Node.insertBefore_ parent placeholder
1261− Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ parent placeholder
1262− setPreviousNode $ Just $ toNode placeholder
1279+ , insertAfterPreviousNode placeholder
12631280 )
12641281 HydrationMode_Immediate -> do
12651282 df <- createDocumentFragment doc
12661283 Node.appendChild_ df placeholder
12671284 pure (Right df, pure ())
12681285 p' <- either pure (liftIO . newIORef . toNode) p
1269− (result, finalState) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT child) initialEnv
1286+ (result, finalState) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
12701287 { _hydrationDomBuilderEnv_parent = p'
12711288 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
12721289 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
@@ -1274,17 +1291,17 @@ drawChildUpdate initialEnv markReady child = do
12741291 u <- liftIO $ readIORef unreadyChildren
12751292 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
12761293 return $ Compose
1277− ( DOM_Replace delayed (pure ()) (pure finalState)
1294+ ( delayed >> finalState
12781295 , either (const $ error "drawChildUpdate: Tried to use document fragment in hydration mode") id p
12791296 , placeholder, childReadyState, result
12801297 )
12811298
12821299{-# INLINABLE drawChildUpdateInt #-}
12831300drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)
1284− => HydrationDomBuilderEnv
1301+ => HydrationDomBuilderEnv t
12851302 -> (IORef ChildReadyStateInt -> JSM ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready
12861303 -> HydrationDomBuilderT t m v'
1287− -> DomRenderHookT t m (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')
1304+ -> DomRenderHookT t m (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')
12881305drawChildUpdateInt initialEnv markReady child = do
12891306 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing
12901307 let doc = _hydrationDomBuilderEnv_document initialEnv
@@ -1294,19 +1311,14 @@ drawChildUpdateInt initialEnv markReady child = do
12941311 (p, delayed) <- case hydrationMode of
12951312 HydrationMode_Hydrating -> pure
12961313 ( Left $ _hydrationDomBuilderEnv_parent initialEnv
1297− , do
1298− parent <- askParent
1299− getPreviousNode >>= \case
1300− Nothing -> Node.getFirstChild parent >>= Node.insertBefore_ parent placeholder
1301− Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ parent placeholder
1302− setPreviousNode $ Just $ toNode placeholder
1314+ , insertAfterPreviousNode placeholder
13031315 )
13041316 HydrationMode_Immediate -> do
13051317 df <- createDocumentFragment doc
13061318 Node.appendChild_ df placeholder
13071319 pure (Right df, pure ())
13081320 p' <- either pure (liftIO . newIORef . toNode) p
1309− (result, finalState) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT child) initialEnv
1321+ (result, finalState) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
13101322 { _hydrationDomBuilderEnv_parent = p'
13111323 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
13121324 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
@@ -1314,17 +1326,11 @@ drawChildUpdateInt initialEnv markReady child = do
13141326 u <- liftIO $ readIORef unreadyChildren
13151327 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready
13161328 return
1317− ( DOM_Replace delayed (pure ()) (pure finalState)
1329+ ( delayed >> finalState
13181330 , either (const $ error "drawChildUpdateInt: Tried to use document fragment in hydration mode") id p
13191331 , placeholder, childReadyState, result
13201332 )
13211333
1322−insertAfter :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
1323−insertAfter new existing = do
1324− liftIO $ putStrLn "insertAfter"
1325− p <- getParentNodeUnchecked existing
1326− Node.getNextSibling existing >>= DOM.insertBefore_ p new
1327−
13281334instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where
13291335 type Performable (HydrationDomBuilderT t m) = Performable m
13301336 {-# INLINABLE performEvent_ #-}
reflex-dom-core/src/Reflex/Dom/Builder/Static.hs−1
@@ -269,7 +269,6 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
269269 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5
270270 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape
271271 let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8
272− modify ("<!--text-->" :) -- TODO FIXME
273272 modify . (:) =<< case mSetContents of
274273 Nothing -> return (pure (escape initialContents))
275274 Just setContents -> hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on
reflex-dom-core/src/Reflex/Dom/Prerender.hs+1−1
@@ -92,7 +92,7 @@ instance (PrerenderClientConstraint' js m, SupportsImmediateDomBuilder t m, Refl
9292 }
9393 events <- askEvents
9494 a <- lift $ runImmediateDomBuilderT client env events
95− hydrateDOM $ DOM_Node $ do
95+ addHydrationStep $ do
9696 -- Delete up to the end marker
9797 after <- deleteToPrerenderEnd
9898 insertBefore df after