5dec470 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Hydrate text nodes properly, remove DOM type

5dec470Tom Smalley8 years ago

reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+136−130

compare with develop

unifiedsplit

@@ -37,8 +37,8 @@ module Reflex.Dom.Builder.Hydration

37 , HydrationMode (..)

38 , HydrationRunnerT (..)

39 , runHydrationRunnerT

40− , DOM(..), runDOMForest

40+ , addHydrationStepWithSetup

41− , hydrateDOM

41+ , addHydrationStep

42 , hydrateNode

43 , getPreviousNode, setPreviousNode

44 , runHydrationDomBuilderT

@@ -47,7 +47,6 @@ module Reflex.Dom.Builder.Hydration

47 , append

48 , textNodeInternal

49 , SupportsHydrationDomBuilder

50− , EventFilterTriggerRef (..)

51 , wrap

50 , wrap

52 , makeElement

51 , makeElement

53 , drawChildUpdate

52 , drawChildUpdate

@@ -127,6 +126,7 @@ import GHCJS.DOM.Node (appendChild_, getChildNodes, getOwnerDocumentUnchecked, g

127import qualified GHCJS.DOM.Node as DOM (insertBefore_)

126import qualified GHCJS.DOM.Node as DOM (insertBefore_)

128import qualified GHCJS.DOM.Node as Node

127import qualified GHCJS.DOM.Node as Node

129import qualified GHCJS.DOM.NodeList as NodeList

128import qualified GHCJS.DOM.NodeList as NodeList

129+import qualified GHCJS.DOM.Text as DOM

130import GHCJS.DOM.Types

131 (liftJSM, askJSM, runJSM, JSM, MonadJSM,

132 FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,

@@ -185,7 +185,7 @@ instance DomSpace HydrationDomSpace where

185 in DMap.alter f' en $ _ghcjsEventSpec_filters es

186 }

187

188−data HydrationDomBuilderEnv = HydrationDomBuilderEnv

188+data HydrationDomBuilderEnv t = HydrationDomBuilderEnv

189 { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document

190 -- ^ Reference to the document

191 , _hydrationDomBuilderEnv_parent :: {-# UNPACK #-} !(IORef Node)

@@ -197,34 +197,9 @@ data HydrationDomBuilderEnv = HydrationDomBuilderEnv

197 -- ^ Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it

198 , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)

199 -- ^ In hydration mode? Should be switched to `HydrationMode_Immediate` after hydration is finished

200+ , _hydrationDomBuilderEnv_switchover :: {-# UNPACK #-} !(Event t ())

200 }

201 }

201

202

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−

228-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events

203-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events

229-- State contains reference to the previous node sibling, if any.

204-- State contains reference to the previous node sibling, if any.

230newtype HydrationRunnerT t m a = HydrationRunnerT { unHydrationRunnerT :: StateT (Maybe Node) (ReaderT Node (DomRenderHookT t m)) a }

205newtype 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

234#endif

209#endif

235 )

210 )

236

211

237−localRunner :: Monad m => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a

212+localRunner :: (MonadJSM m, 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)

213+localRunner (HydrationRunnerT m) s parent = HydrationRunnerT . lift $ local (\_ -> parent) (evalStateT m s)

239

214

240runHydrationRunnerT

215runHydrationRunnerT

241 :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))

216 :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))

242 => HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a

217 => 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)

244

219

245instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where

220instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where

246 {-# INLINABLE newEventWithTrigger #-}

221 {-# INLINABLE newEventWithTrigger #-}

@@ -251,17 +226,32 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRu

251instance MonadTrans (HydrationRunnerT t) where

226instance MonadTrans (HydrationRunnerT t) where

252 lift = HydrationRunnerT . lift . lift . lift

227 lift = HydrationRunnerT . lift . lift . lift

253

228

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

254−hydrateDOM :: MonadIO m => DOM t m -> HydrationDomBuilderT t m ()

235+addHydrationStepWithSetup :: (Adjustable t m, MonadIO m) => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT t m ()

255−hydrateDOM dom = getHydrationMode >>= \case

236+addHydrationStepWithSetup setup f = getHydrationMode >>= \case

256− HydrationMode_Hydrating -> HydrationDomBuilderT $ modify (dom :)

257 HydrationMode_Immediate -> pure ()

237 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)

258

248

259-- | A monad for DomBuilder which just gets the results of children and pushes

249-- | A monad for DomBuilder which just gets the results of children and pushes

260-- work into an action that is delayed until after postBuild (to match the

250-- work into an action that is delayed until after postBuild (to match the

261-- static builder). The action runs in 'HydrationRunnerT', which performs the

251-- static builder). The action runs in 'HydrationRunnerT', which performs the

262-- DOM takeover and sets up the events, after which point this monad will

252-- DOM takeover and sets up the events, after which point this monad will

263-- continue in the vein of 'ImmediateDomBuilderT'.

253-- 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 }

265 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException

255 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException

266#if MIN_VERSION_base(4,9,1)

256#if MIN_VERSION_base(4,9,1)

267 , MonadAsyncException

257 , MonadAsyncException

@@ -332,17 +322,17 @@ runHydrationDomBuilderT

332 , Ref m ~ IORef

322 , Ref m ~ IORef

333 )

323 )

334 => HydrationDomBuilderT t m a

324 => HydrationDomBuilderT t m a

335− -> HydrationDomBuilderEnv

325+ -> HydrationDomBuilderEnv t

336 -> Chan [DSum (EventTriggerRef t) TriggerInvocation]

326 -> Chan [DSum (EventTriggerRef t) TriggerInvocation]

337− -> m (a, [DOM t m])

327+ -> m (a, HydrationRunnerT t m ())

338−runHydrationDomBuilderT (HydrationDomBuilderT a) env events = runDomRenderHookT (runStateT (runReaderT a env) []) events

328+runHydrationDomBuilderT (HydrationDomBuilderT a) env events = runDomRenderHookT (runStateT (runReaderT a env) (pure ())) events

339

329

340instance Monad m => HasDocument (HydrationDomBuilderT t m) where

330instance Monad m => HasDocument (HydrationDomBuilderT t m) where

341 {-# INLINABLE askDocument #-}

331 {-# INLINABLE askDocument #-}

342 askDocument = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document

332 askDocument = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document

343

333

344{-# INLINABLE localEnv #-}

334{-# 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

346localEnv f = HydrationDomBuilderT . local f . unHydrationDomBuilderT

336localEnv f = HydrationDomBuilderT . local f . unHydrationDomBuilderT

347

337

348{-# INLINABLE append #-}

338{-# INLINABLE append #-}

@@ -425,7 +415,6 @@ hydrateNode check constructor = do

425 liftIO $ putStr $ "Node failed check, skipping... "

415 liftIO $ putStr $ "Node failed check, skipping... "

426 go (Just node)

416 go (Just node)

427 n <- go lastHydrationNode

417 n <- go lastHydrationNode

428− liftIO $ putStrLn ""

429 setPreviousNode $ Just $ toNode n

418 setPreviousNode $ Just $ toNode n

430 return n

419 return n

431

420

@@ -518,7 +507,7 @@ makeElement elementTag cfg child = do

518 parent <- liftIO $ newIORef $ error "Parent not yet initialized"

507 parent <- liftIO $ newIORef $ error "Parent not yet initialized"

519 env <- HydrationDomBuilderT ask

508 env <- HydrationDomBuilderT ask

520 let env' = env { _hydrationDomBuilderEnv_parent = parent}

509 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 ())

522 wrapResult <- liftIO newEmptyMVar

511 wrapResult <- liftIO newEmptyMVar

523 let activateElement = do

512 let activateElement = do

524 e <- hydrateNode hasSSRAttribute DOM.Element

513 e <- hydrateNode hasSSRAttribute DOM.Element

@@ -528,7 +517,7 @@ makeElement elementTag cfg child = do

528 refs <- wrap events e $ extractRawElementConfig cfg

517 refs <- wrap events e $ extractRawElementConfig cfg

529 liftIO $ putMVar wrapResult (e, refs)

518 liftIO $ putMVar wrapResult (e, refs)

530 pure $ toNode e

519 pure $ toNode e

531− hydrateDOM $ DOM_Element activateElement childDom

520+ addHydrationStep $ activateElement >>= localRunner childDom Nothing

532

521

533 -- We need the EventSelector to switch to the real event handler after activation

522 -- We need the EventSelector to switch to the real event handler after activation

534 es <- newFanEventWithTrigger $ \(WrapArg en) t -> do

523 es <- newFanEventWithTrigger $ \(WrapArg en) t -> do

@@ -553,7 +542,7 @@ makeElement elementTag cfg child = do

553 return ((Element es (), result), error "makeElement: DOM.Element")

542 return ((Element es (), result), error "makeElement: DOM.Element")

554

543

555{-# INLINABLE textNodeInternal #-}

544{-# 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

557textNodeInternal !t mSetContents = getHydrationMode >>= \case

546textNodeInternal !t mSetContents = getHydrationMode >>= \case

558 HydrationMode_Immediate -> do

547 HydrationMode_Immediate -> do

559 n <- makeNodeInternal (askDocument >>= \doc -> createTextNode doc t)

548 n <- makeNodeInternal (askDocument >>= \doc -> createTextNode doc t)

@@ -561,15 +550,45 @@ textNodeInternal !t mSetContents = getHydrationMode >>= \case

561 pure n

550 pure n

562 HydrationMode_Hydrating -> do

551 HydrationMode_Hydrating -> do

563 doc <- askDocument

552 doc <- askDocument

564− let activateText = do

553+ addHydrationStepWithSetup (maybe (pure $ pure t) (hold t) mSetContents) $ \currentText -> do

565− liftIO $ putStrLn $ "Action: Text: " <> show (DOM.toJSString t)

554+ n <- hydrateTextNode =<< sample currentText

566− n <- hydrateNode (const $ pure True) DOM.Text

567− mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents

555+ mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents

568− hydrateDOM $ DOM_Node activateText

569 pure $ error "textNodeInternal: DOM.Text"

556 pure $ error "textNodeInternal: DOM.Text"

570

557

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+

571{-# INLINABLE commentNodeInternal #-}

590{-# 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

573commentNodeInternal !t mSetContents = getHydrationMode >>= \case

592commentNodeInternal !t mSetContents = getHydrationMode >>= \case

574 HydrationMode_Immediate -> do

593 HydrationMode_Immediate -> do

575 n <- makeNodeInternal (askDocument >>= \doc -> createComment doc t)

594 n <- makeNodeInternal (askDocument >>= \doc -> createComment doc t)

@@ -577,17 +596,16 @@ commentNodeInternal !t mSetContents = getHydrationMode >>= \case

577 pure n

596 pure n

578 HydrationMode_Hydrating -> do

597 HydrationMode_Hydrating -> do

579 doc <- askDocument

598 doc <- askDocument

580− let activateComment = do

599+ addHydrationStep $ do

581− liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)

600+ liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)

582− n <- hydrateNode (const $ pure True) DOM.Comment

601+ n <- hydrateNode (const $ pure True) DOM.Comment

583− mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents

602+ mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents

584− hydrateDOM $ DOM_Node activateComment

585 pure $ error "commentNodeInternal: DOM.Comment"

603 pure $ error "commentNodeInternal: DOM.Comment"

586

604

587-- | We leave markers in the static builder as comments, and rip these comments

605-- | We leave markers in the static builder as comments, and rip these comments

588-- out at hydration time, replacing them with empty text nodes.

606-- out at hydration time, replacing them with empty text nodes.

589skipToAndReplaceComment

607skipToAndReplaceComment

590− :: (MonadJSM m, Reflex t, MonadFix m)

608+ :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m)

591 => Text

609 => Text

592 -> IORef Text

610 -> IORef Text

593 -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)

611 -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)

@@ -632,10 +650,10 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case

632 writeIORef keyRef key

650 writeIORef keyRef key

633 pure (switchComment, textNodeRef, keyRef)

651 pure (switchComment, textNodeRef, keyRef)

634

652

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)

636skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")

654skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")

637

655

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)

639skipToReplaceEnd key = fmap (\(m,e,_) -> (m,e)) $ skipToAndReplaceComment "replace-end" key

657skipToReplaceEnd key = fmap (\(m,e,_) -> (m,e)) $ skipToAndReplaceComment "replace-end" key

640

658

641instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT t m) where

659instance 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

823 traverseDMapWithKeyWithAdjust f m = DomRenderHookT . traverseDMapWithKeyWithAdjust (\k -> unDomRenderHookT . f k) m

841 traverseDMapWithKeyWithAdjust f m = DomRenderHookT . traverseDMapWithKeyWithAdjust (\k -> unDomRenderHookT . f k) m

824 traverseDMapWithKeyWithAdjustWithMove f m = DomRenderHookT . traverseDMapWithKeyWithAdjustWithMove (\k -> unDomRenderHookT . f k) m

842 traverseDMapWithKeyWithAdjustWithMove f m = DomRenderHookT . traverseDMapWithKeyWithAdjustWithMove (\k -> unDomRenderHookT . f k) m

825

843

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

827 {-# INLINABLE runWithReplace #-}

845 {-# INLINABLE runWithReplace #-}

828 runWithReplace a0 a' = do

846 runWithReplace a0 a' = do

829 initialEnv <- HydrationDomBuilderT ask

847 initialEnv <- HydrationDomBuilderT ask

@@ -858,7 +876,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

858 a <- a0

876 a <- a0

859 insertBefore p' =<< liftIO (readIORef after)

877 insertBefore p' =<< liftIO (readIORef after)

860 pure a

878 pure a

861− (result, dom) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT a0') initialEnv

879+ (result, dom) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT a0') initialEnv

862 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

880 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

863 , _hydrationDomBuilderEnv_commitAction = myCommitAction

881 , _hydrationDomBuilderEnv_commitAction = myCommitAction

864 , _hydrationDomBuilderEnv_parent = p

882 , _hydrationDomBuilderEnv_parent = p

@@ -884,7 +902,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

884 insertBefore p' after'

902 insertBefore p' after'

885 liftIO $ writeIORef currentCohort cohortId

903 liftIO $ writeIORef currentCohort cohortId

886 myCommitAction

904 myCommitAction

887− (result, dom) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT child) $ initialEnv

905+ (result, dom) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) $ initialEnv

888 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

906 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

889 , _hydrationDomBuilderEnv_commitAction = case h of

907 , _hydrationDomBuilderEnv_commitAction = case h of

890 HydrationMode_Hydrating -> myCommitAction

908 HydrationMode_Hydrating -> myCommitAction

@@ -900,7 +918,10 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

900 HydrationMode_Immediate -> Right commitActionToRunNow

918 HydrationMode_Immediate -> Right commitActionToRunNow

901 return (actions, result)

919 return (actions, result)

902 let (hydrate', commitAction) = fanEither $ fmap fst child'

920 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

904 requestDomAction_ $ fmapMaybe id commitAction

925 requestDomAction_ $ fmapMaybe id commitAction

905 return (result0, snd <$> child')

926 return (result0, snd <$> child')

906

927

@@ -910,8 +931,8 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

910 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'

931 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'

911 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}

932 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}

912 traverseDMapWithKeyWithAdjustWithMove = do

933 traverseDMapWithKeyWithAdjustWithMove = do

913− let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do

934+ let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose ((,,,,) (HydrationRunnerT 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)

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)

915 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case

936 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case

916 PatchDMapWithMove.From_Insert (Compose (_, _, _, sRef, _)) -> do

937 PatchDMapWithMove.From_Insert (Compose (_, _, _, sRef, _)) -> do

917 readIORef sRef >>= \case

938 readIORef sRef >>= \case

@@ -928,11 +949,11 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

928 p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p

949 p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p

929 _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old

950 _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old

930 return $ applyAlways p' old

951 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

932 let p = unPatchDMapWithMove p_

953 let p = unPatchDMapWithMove p_

933 phsBefore <- liftIO $ readIORef placeholders

954 phsBefore <- liftIO $ readIORef placeholders

934 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef

955 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)

936 collectIfMoved k e = do

957 collectIfMoved k e = do

937 let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before

958 let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before

938 nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore

959 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

944 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder

965 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder

945 collected <- DMap.traverseWithKey collectIfMoved p

966 collected <- DMap.traverseWithKey collectIfMoved p

946 let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (\(Compose (_, _, ph, _, _)) -> ph) p_) phsBefore --TODO: Don't recompute this

967 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)

948 placeFragment k e = do

969 placeFragment k e = do

949 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter

970 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter

950 case PatchDMapWithMove._nodeInfo_from e of

971 case PatchDMapWithMove._nodeInfo_from e of

@@ -967,8 +988,8 @@ traverseDMapWithKeyWithAdjust'

967 -> Event t (PatchDMap k v)

988 -> Event t (PatchDMap k v)

968 -> HydrationDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))

989 -> HydrationDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))

969traverseDMapWithKeyWithAdjust' = do

990traverseDMapWithKeyWithAdjust' = do

970− let updateChildUnreadiness (p :: PatchDMap k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do

991+ let updateChildUnreadiness (p :: PatchDMap k (Compose ((,,,,) (HydrationRunnerT 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)

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)

972 new k (ComposeMaybe m) = ComposeMaybe <$> case m of

993 new k (ComposeMaybe m) = ComposeMaybe <$> case m of

973 Nothing -> return Nothing

994 Nothing -> return Nothing

974 Just (Compose (_, _, _, sRef, _)) -> do

995 Just (Compose (_, _, _, sRef, _)) -> do

@@ -1000,8 +1021,8 @@ traverseIntMapWithKeyWithAdjust'

1000 -> Event t (PatchIntMap v)

1021 -> Event t (PatchIntMap v)

1001 -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))

1022 -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))

1002traverseIntMapWithKeyWithAdjust' = do

1023traverseIntMapWithKeyWithAdjust' = do

1003− let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do

1024+ let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (HydrationRunnerT 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))

1025+ let new :: IntMap.Key -> Maybe (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))

1005 new k m = case m of

1026 new k m = case m of

1006 Nothing -> return Nothing

1027 Nothing -> return Nothing

1007 Just (_, _, _, sRef, _) -> do

1028 Just (_, _, _, sRef, _) -> do

@@ -1032,19 +1053,19 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.

1032 , MonadJSM m

1053 , MonadJSM m

1033 , MonadFix m

1054 , MonadFix m

1034 , PrimMonad m

1055 , 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'))

1036 , Functor p

1057 , Functor p

1037− , PatchTarget (p (DOM t m)) ~ IntMap (DOM t m)

1058+ , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())

1038 , MonadHold t m

1059 , MonadHold t m

1039− , Patch (p (DOM t m))

1060+ , Patch (p (HydrationRunnerT t m ()))

1040 )

1061 )

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'))

1042 -> IntMap v

1063 -> IntMap v

1043 -> Event t (p v)

1064 -> 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')))

1045 ) -- ^ The base monad's traversal

1066 ) -- ^ 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

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

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

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

1048 -> (IntMap.Key -> v -> HydrationDomBuilderT t m v')

1069 -> (IntMap.Key -> v -> HydrationDomBuilderT t m v')

1049 -> IntMap v

1070 -> IntMap v

1050 -> Event t (p v)

1071 -> Event t (p v)

@@ -1053,7 +1074,7 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

1053 (hydrateStart, _, key) <- skipToReplaceStart

1074 (hydrateStart, _, key) <- skipToReplaceStart

1054 initialEnv <- HydrationDomBuilderT ask

1075 initialEnv <- HydrationDomBuilderT ask

1055 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1076 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

1057 haveEverBeenReady <- liftIO $ newIORef False

1078 haveEverBeenReady <- liftIO $ newIORef False

1058 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"

1079 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"

1059 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"

1080 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"

@@ -1100,22 +1121,19 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

1100 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time

1121 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time

1101 let result0 = IntMap.map (\(_, _, _, _, v) -> v) children0

1122 let result0 = IntMap.map (\(_, _, _, _, v) -> v) children0

1102 placeholders0 = fmap (\(_, _, ph, _, _) -> ph) children0

1123 placeholders0 = fmap (\(_, _, ph, _, _) -> ph) children0

1103− delayed0 :: IntMap (DOM t m)

1124+ delayed0 :: IntMap (HydrationRunnerT t m ())

1104 delayed0 = IntMap.map (\(delayed, _, _, _, _) -> delayed) children0

1125 delayed0 = IntMap.map (\(delayed, _, _, _, _) -> delayed) children0

1105− delayed' :: Event t (p (DOM t m))

1126+ delayed' :: Event t (p (HydrationRunnerT t m ()))

1106 delayed' = ffor children' $ fmap $ \(delayed, _, _, _, _) -> delayed

1127 delayed' = ffor children' $ fmap $ \(delayed, _, _, _, _) -> delayed

1107 result' = ffor children' $ fmap $ \(_, _, _, _, r) -> r

1128 result' = ffor children' $ fmap $ \(_, _, _, _, r) -> r

1108− delayed <- accumMaybeB (flip apply) delayed0 delayed'

1109 doc <- askDocument

1129 doc <- askDocument

1110 let setFinalPlaceholder = do

1130 let setFinalPlaceholder = do

1111 ph <- createTextNode doc ("" :: Text)

1131 ph <- createTextNode doc ("" :: Text)

1112− parent <- askParent

1132+ insertAfterPreviousNode ph

1113− pn <- runMaybeT $ MaybeT . Node.getNextSibling =<< MaybeT getPreviousNode

1114− Node.insertBefore_ parent ph pn

1115 liftIO $ writeIORef lastPlaceholderRef ph

1133 liftIO $ writeIORef lastPlaceholderRef ph

1116− setPreviousNode $ Just $ toNode ph

1134+ addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do

1117− hydrateDOM $ DOM_Replace (pure ()) setFinalPlaceholder

1118− (reverse . IntMap.elems <$> delayed)

1135+ join $ sample (sequence . IntMap.elems <$> delayed)

1136+ setFinalPlaceholder

1119 liftIO $ writeIORef placeholders $! placeholders0

1137 liftIO $ writeIORef placeholders $! placeholders0

1120 getHydrationMode >>= \case

1138 getHydrationMode >>= \case

1121 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0

1139 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0

@@ -1130,6 +1148,13 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

1130 applyDomUpdate newP

1148 applyDomUpdate newP

1131 return (result0, result')

1149 return (result0, result')

1132

1150

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+

1133{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}

1158{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}

1134hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

1159hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

1135 ( Adjustable t m

1160 ( Adjustable t m

@@ -1141,9 +1166,9 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

1141 , MonadFix m

1166 , MonadFix m

1142 , Patch (p k v)

1167 , Patch (p k v)

1143 , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)

1168 , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)

1144− , Patch (p k (Const (DOM t m)))

1169+ , Patch (p k (Const (HydrationRunnerT t m ())))

1145− , PatchTarget (p k (Const (DOM t m))) ~ DMap k (Const (DOM t m))

1170+ , PatchTarget (p k (Const (HydrationRunnerT t m ()))) ~ DMap k (Const (HydrationRunnerT t m ()))

1146− , Monoid (p k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))

1171+ , Monoid (p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))

1147 , Patch (p k (Constant Int))

1172 , Patch (p k (Constant Int))

1148 )

1173 )

1149 => (forall vv vv'.

1174 => (forall vv vv'.

@@ -1153,8 +1178,8 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

1153 -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))

1178 -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))

1154 ) -- ^ The base monad's traversal

1179 ) -- ^ The base monad's traversal

1155 -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type

1180 -> (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

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

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

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

1158 -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))

1183 -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))

1159 -> DMap k v

1184 -> DMap k v

1160 -> Event t (p k v)

1185 -> Event t (p k v)

@@ -1163,7 +1188,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

1163-- (hydrateStart, _, key) <- skipToReplaceStart -- TODO

1188-- (hydrateStart, _, key) <- skipToReplaceStart -- TODO

1164 initialEnv <- HydrationDomBuilderT ask

1189 initialEnv <- HydrationDomBuilderT ask

1165 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1190 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

1167 haveEverBeenReady <- liftIO $ newIORef False

1192 haveEverBeenReady <- liftIO $ newIORef False

1168 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"

1193 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"

1169 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"

1194 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"

@@ -1210,22 +1235,19 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

1210 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time

1235 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time

1211 let result0 = DMap.map (\(Compose (_, _, _, _, v)) -> v) children0

1236 let result0 = DMap.map (\(Compose (_, _, _, _, v)) -> v) children0

1212 placeholders0 = weakenDMapWith (\(Compose (_, _, ph, _, _)) -> ph) children0

1237 placeholders0 = weakenDMapWith (\(Compose (_, _, ph, _, _)) -> ph) children0

1213− delayed0 :: DMap k (Const (DOM t m))

1238+ delayed0 :: DMap k (Const (HydrationRunnerT t m ()))

1214 delayed0 = DMap.map (\(Compose (delayed, _, _, _, _)) -> Const delayed) children0

1239 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 ())))

1216 delayed' = ffor children' $ mapPatch $ \(Compose (d, _, _, _, _)) -> Const d

1241 delayed' = ffor children' $ mapPatch $ \(Compose (d, _, _, _, _)) -> Const d

1217 result' = ffor children' $ mapPatch $ \(Compose (_, _, _, _, r)) -> r

1242 result' = ffor children' $ mapPatch $ \(Compose (_, _, _, _, r)) -> r

1218− delayed <- accumMaybeB (flip apply) delayed0 delayed'

1219 doc <- askDocument

1243 doc <- askDocument

1220 let setFinalPlaceholder = do

1244 let setFinalPlaceholder = do

1221 ph <- createTextNode doc ("" :: Text)

1245 ph <- createTextNode doc ("" :: Text)

1222− parent <- askParent

1246+ insertAfterPreviousNode ph

1223− pn <- runMaybeT $ MaybeT . Node.getNextSibling =<< MaybeT getPreviousNode

1224− Node.insertBefore_ parent ph pn

1225 liftIO $ writeIORef lastPlaceholderRef ph

1247 liftIO $ writeIORef lastPlaceholderRef ph

1226− setPreviousNode $ Just $ toNode ph

1248+ addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do

1227− hydrateDOM $ DOM_Replace (pure ()) setFinalPlaceholder

1228− (fmap (\(_ :=> Const d) -> d) . reverse . DMap.toList <$> delayed)

1249+ join $ sample (sequence . fmap (\(_ :=> Const d) -> d) . DMap.toList <$> delayed)

1250+ setFinalPlaceholder

1229 liftIO $ writeIORef placeholders $! placeholders0

1251 liftIO $ writeIORef placeholders $! placeholders0

1230 getHydrationMode >>= \case

1252 getHydrationMode >>= \case

1231 HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (_, df, _, _, _)) -> Constant () <$ append (toNode df)) children0

1253 HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (_, df, _, _, _)) -> Constant () <$ append (toNode df)) children0

@@ -1241,10 +1263,10 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

1241

1263

1242{-# INLINABLE drawChildUpdate #-}

1264{-# INLINABLE drawChildUpdate #-}

1243drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)

1265drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)

1244− => HydrationDomBuilderEnv

1266+ => HydrationDomBuilderEnv t

1245 -> (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

1267 -> (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

1246 -> HydrationDomBuilderT t m (v' a)

1268 -> 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)

1248drawChildUpdate initialEnv markReady child = do

1270drawChildUpdate initialEnv markReady child = do

1249 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

1271 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

1250 let doc = _hydrationDomBuilderEnv_document initialEnv

1272 let doc = _hydrationDomBuilderEnv_document initialEnv

@@ -1254,19 +1276,14 @@ drawChildUpdate initialEnv markReady child = do

1254 (p, delayed) <- case hydrationMode of

1276 (p, delayed) <- case hydrationMode of

1255 HydrationMode_Hydrating -> pure

1277 HydrationMode_Hydrating -> pure

1256 ( Left $ _hydrationDomBuilderEnv_parent initialEnv

1278 ( Left $ _hydrationDomBuilderEnv_parent initialEnv

1257− , do

1279+ , insertAfterPreviousNode placeholder

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

1263 )

1280 )

1264 HydrationMode_Immediate -> do

1281 HydrationMode_Immediate -> do

1265 df <- createDocumentFragment doc

1282 df <- createDocumentFragment doc

1266 Node.appendChild_ df placeholder

1283 Node.appendChild_ df placeholder

1267 pure (Right df, pure ())

1284 pure (Right df, pure ())

1268 p' <- either pure (liftIO . newIORef . toNode) p

1285 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

1270 { _hydrationDomBuilderEnv_parent = p'

1287 { _hydrationDomBuilderEnv_parent = p'

1271 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1288 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1272 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

1289 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

@@ -1274,17 +1291,17 @@ drawChildUpdate initialEnv markReady child = do

1274 u <- liftIO $ readIORef unreadyChildren

1291 u <- liftIO $ readIORef unreadyChildren

1275 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready

1292 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready

1276 return $ Compose

1293 return $ Compose

1277− ( DOM_Replace delayed (pure ()) (pure finalState)

1294+ ( delayed >> finalState

1278 , either (const $ error "drawChildUpdate: Tried to use document fragment in hydration mode") id p

1295 , either (const $ error "drawChildUpdate: Tried to use document fragment in hydration mode") id p

1279 , placeholder, childReadyState, result

1296 , placeholder, childReadyState, result

1280 )

1297 )

1281

1298

1282{-# INLINABLE drawChildUpdateInt #-}

1299{-# INLINABLE drawChildUpdateInt #-}

1283drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)

1300drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)

1284− => HydrationDomBuilderEnv

1301+ => HydrationDomBuilderEnv t

1285 -> (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

1302 -> (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

1286 -> HydrationDomBuilderT t m v'

1303 -> 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')

1288drawChildUpdateInt initialEnv markReady child = do

1305drawChildUpdateInt initialEnv markReady child = do

1289 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing

1306 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing

1290 let doc = _hydrationDomBuilderEnv_document initialEnv

1307 let doc = _hydrationDomBuilderEnv_document initialEnv

@@ -1294,19 +1311,14 @@ drawChildUpdateInt initialEnv markReady child = do

1294 (p, delayed) <- case hydrationMode of

1311 (p, delayed) <- case hydrationMode of

1295 HydrationMode_Hydrating -> pure

1312 HydrationMode_Hydrating -> pure

1296 ( Left $ _hydrationDomBuilderEnv_parent initialEnv

1313 ( Left $ _hydrationDomBuilderEnv_parent initialEnv

1297− , do

1314+ , insertAfterPreviousNode placeholder

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

1303 )

1315 )

1304 HydrationMode_Immediate -> do

1316 HydrationMode_Immediate -> do

1305 df <- createDocumentFragment doc

1317 df <- createDocumentFragment doc

1306 Node.appendChild_ df placeholder

1318 Node.appendChild_ df placeholder

1307 pure (Right df, pure ())

1319 pure (Right df, pure ())

1308 p' <- either pure (liftIO . newIORef . toNode) p

1320 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

1310 { _hydrationDomBuilderEnv_parent = p'

1322 { _hydrationDomBuilderEnv_parent = p'

1311 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1323 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1312 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

1324 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

@@ -1314,17 +1326,11 @@ drawChildUpdateInt initialEnv markReady child = do

1314 u <- liftIO $ readIORef unreadyChildren

1326 u <- liftIO $ readIORef unreadyChildren

1315 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready

1327 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready

1316 return

1328 return

1317− ( DOM_Replace delayed (pure ()) (pure finalState)

1329+ ( delayed >> finalState

1318 , either (const $ error "drawChildUpdateInt: Tried to use document fragment in hydration mode") id p

1330 , either (const $ error "drawChildUpdateInt: Tried to use document fragment in hydration mode") id p

1319 , placeholder, childReadyState, result

1331 , placeholder, childReadyState, result

1320 )

1332 )

1321

1333

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−

1328instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where

1334instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where

1329 type Performable (HydrationDomBuilderT t m) = Performable m

1335 type Performable (HydrationDomBuilderT t m) = Performable m

1330 {-# INLINABLE performEvent_ #-}

1336 {-# 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

269 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5

270 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape

271 let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8

272− modify ("" :) -- TODO FIXME

273 modify . (:) =<< case mSetContents of

272 modify . (:) =<< case mSetContents of

274 Nothing -> return (pure (escape initialContents))

273 Nothing -> return (pure (escape initialContents))

275 Just setContents -> hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on

274 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

92 }

93 events <- askEvents

94 a <- lift $ runImmediateDomBuilderT client env events

95− hydrateDOM $ DOM_Node $ do

95+ addHydrationStep $ do

96 -- Delete up to the end marker

97 after <- deleteToPrerenderEnd

98 insertBefore df after