@@ -34,7 +34,6 @@ module Reflex.Dom.Builder.Hydration
3434 ( EventTriggerRef (..)
3535 , HydrationDomBuilderEnv (..)
3636 , HydrationDomBuilderT (..)
37− , HydrationDomBuilderState (..)
3837 , HydrationMode (..)
3938 , HydrationRunnerT (..)
4039 , runHydrationRunnerT
@@ -237,7 +236,8 @@ data DOM t m
237236 | DOM_Node (HydrationRunnerT t m ())
238237 -- ^ Nodes without children
239238 | DOM_Replace (HydrationRunnerT t m ()) (HydrationRunnerT t m ()) (Behavior t [DOM t m])
240− -- ^ runWithReplace content changes over time
239+ -- ^ First and second fields setup the start and end markers respectively, the
240+ -- third contains the actual content which changes over time
241241
242242runDOMForest
243243 :: (Ref m ~ IORef, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, DOM.MonadJSM m, DOM.MonadJSM (Performable m), MonadRef m, MonadSample t m)
@@ -256,10 +256,6 @@ runDOMTree = \case
256256 runDOMForest =<< lift (sample b)
257257 end
258258
259−data HydrationDomBuilderState t m = HydrationDomBuilderState
260− { _hydrationDomBuilderState_delayed :: [DOM t m]
261− }
262−
263259-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events
264260-- State contains reference to the previous node sibling, if any.
265261-- TODO: This probably doesn't need to be a full transformer of `m`, seems like we only need (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m)
@@ -281,8 +277,10 @@ runHydrationRunnerT (HydrationRunnerT m) prev parent = runDomRenderHookT (runRea
281277instance MonadTrans (HydrationRunnerT t) where
282278 lift = HydrationRunnerT . lift . lift . lift
283279
284−addAction :: Monad m => DOM t m -> HydrationDomBuilderT t m ()
285−addAction a = HydrationDomBuilderT $ modify $ \(HydrationDomBuilderState as) -> HydrationDomBuilderState (a : as)
280+hydrateDOM :: MonadIO m => DOM t m -> HydrationDomBuilderT t m ()
281+hydrateDOM dom = getHydrationMode >>= \case
282+ HydrationMode_Hydrating -> HydrationDomBuilderT $ modify (dom :)
283+ HydrationMode_Immediate -> pure ()
286284
287285-- TODO probably can separate these two monads entirely, they have grown apart
288286-- over the course of refactoring
@@ -292,7 +290,7 @@ addAction a = HydrationDomBuilderT $ modify $ \(HydrationDomBuilderState as) ->
292290-- static builder). The action runs in 'HydrationRunnerT', which performs the
293291-- DOM takeover and sets up the events, after which point this monad will
294292-- continue in the vein of 'ImmediateDomBuilderT'.
295−newtype HydrationDomBuilderT t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT HydrationDomBuilderEnv (StateT (HydrationDomBuilderState t m) (DomRenderHookT t m)) a }
293+newtype HydrationDomBuilderT t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT HydrationDomBuilderEnv (StateT [DOM t m] (DomRenderHookT t m)) a }
296294 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
297295#if MIN_VERSION_base(4,9,1)
298296 , MonadAsyncException
@@ -364,21 +362,17 @@ runHydrationDomBuilderT
364362 )
365363 => HydrationDomBuilderT t m a
366364 -> HydrationDomBuilderEnv
367− -> HydrationDomBuilderState t m
368365 -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
369− -> m (a, HydrationDomBuilderState t m)
370−runHydrationDomBuilderT (HydrationDomBuilderT a) env st events = runDomRenderHookT (runStateT (runReaderT a env) st) events
366+ -> m (a, [DOM t m])
367+runHydrationDomBuilderT (HydrationDomBuilderT a) env events = runDomRenderHookT (runStateT (runReaderT a env) []) events
371368
372369instance Monad m => HasDocument (HydrationDomBuilderT t m) where
373370 {-# INLINABLE askDocument #-}
374371 askDocument = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document
375372
376373{-# INLINABLE localEnv #-}
377−localEnv :: Monad m => (HydrationDomBuilderState t m -> HydrationDomBuilderState t m) -> (HydrationDomBuilderEnv -> HydrationDomBuilderEnv) -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m a
378−localEnv f g (HydrationDomBuilderT m) = HydrationDomBuilderT $ do
379− env <- ask
380− hs <- get
381− lift $ lift $ evalStateT (runReaderT m $ g env) (f hs)
374+localEnv :: Monad m => (HydrationDomBuilderEnv -> HydrationDomBuilderEnv) -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m a
375+localEnv f = HydrationDomBuilderT . local f . unHydrationDomBuilderT
382376
383377{-# INLINABLE append #-}
384378append :: MonadJSM m => DOM.Node -> HydrationDomBuilderT t m ()
@@ -596,7 +590,7 @@ makeElement elementTag cfg child = do
596590 e <- makeNodeInternal buildElement
597591 p <- liftIO $ newIORef $ toNode e
598592 -- Run the child builder with updated parent and previous sibling references
599− result <- localEnv (\hs -> hs) (\env -> env { _hydrationDomBuilderEnv_parent = p }) child
593+ result <- localEnv (\env -> env { _hydrationDomBuilderEnv_parent = p }) child
600594 events <- askEvents
601595 eventTriggerRefs <- wrap events e $ extractRawElementConfig cfg
602596 es <- newFanEventWithTrigger $ triggerBody eventTriggerRefs e
@@ -606,8 +600,7 @@ makeElement elementTag cfg child = do
606600 parent <- liftIO $ newIORef $ error "Parent not yet initialized"
607601 env <- HydrationDomBuilderT ask
608602 let env' = env { _hydrationDomBuilderEnv_parent = parent}
609− hs = HydrationDomBuilderState { _hydrationDomBuilderState_delayed = [] }
610− (result, hs') <- HydrationDomBuilderT $ lift $ lift $ runStateT (runReaderT (unHydrationDomBuilderT child) env') hs
603+ (result, childDom) <- HydrationDomBuilderT $ lift $ lift $ runStateT (runReaderT (unHydrationDomBuilderT child) env') []
611604 wrapResult <- liftIO newEmptyMVar
612605 let activateElement = do
613606 e <- hydrateNode hasSSRAttribute buildElement DOM.Element
@@ -617,7 +610,7 @@ makeElement elementTag cfg child = do
617610 refs <- wrap events e $ extractRawElementConfig cfg
618611 liftIO $ putMVar wrapResult (e, refs)
619612 pure $ toNode e
620− addAction $ DOM_Element activateElement $ _hydrationDomBuilderState_delayed hs'
613+ hydrateDOM $ DOM_Element activateElement childDom
621614
622615 -- We need the EventSelector to switch to the real event handler after activation
623616 es <- newFanEventWithTrigger $ \(WrapArg en) t -> do
@@ -657,7 +650,7 @@ textNodeInternal !t mSetContents = getHydrationMode >>= \case
657650 -- Nothing -> liftIO $ putStrLn "No update events for text"
658651 -- Just e -> requestDomAction_ $ setNodeValue n . Just <$> e
659652 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
660− addAction $ DOM_Node activateText
653+ hydrateDOM $ DOM_Node activateText
661654 pure $ error "textNodeInternal: DOM.Text"
662655
663656{-# INLINABLE commentNodeInternal #-}
@@ -673,7 +666,7 @@ commentNodeInternal !t mSetContents = getHydrationMode >>= \case
673666 liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)
674667 n <- hydrateNode (const $ pure True) (createComment doc t) DOM.Comment
675668 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
676− addAction $ DOM_Node activateComment
669+ hydrateDOM $ DOM_Node activateComment
677670 pure $ error "commentNodeInternal: DOM.Comment"
678671
679672-- | We leave markers in the static builder as comments, and rip these comments
@@ -722,7 +715,7 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
722715 liftIO $ do
723716 writeIORef textNodeRef textNode
724717 writeIORef keyRef key
725−-- addAction $ DOM_Node switchComment
718+-- hydrateDOM $ DOM_Node switchComment
726719 pure (switchComment, textNodeRef, keyRef)
727720
728721
@@ -894,7 +887,7 @@ instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomB
894887 buildDomFragment w = do
895888 df <- createDocumentFragment =<< askDocument
896889 p <- liftIO $ newIORef $ toNode df
897− result <- localEnv id (\env -> env { _hydrationDomBuilderEnv_parent = p }) w
890+ result <- localEnv (\env -> env { _hydrationDomBuilderEnv_parent = p }) w
898891 state <- liftIO $ newIORef FragmentState_Unmounted
899892 return (HydrationDomFragment df state, result)
900893 mountDomFragment fragment setFragment = do
@@ -947,7 +940,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
947940 HydrationMode_Hydrating -> liftIO $ newIORef parent
948941 HydrationMode_Immediate -> liftIO . newIORef . toNode =<< createDocumentFragment doc
949942 unreadyChildren <- liftIO $ newIORef 0
950− (result, HydrationDomBuilderState h') <- flip runStateT (HydrationDomBuilderState []) $ runReaderT (unHydrationDomBuilderT a0) initialEnv
943+ (result, dom) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT a0) initialEnv
951944 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
952945 , _hydrationDomBuilderEnv_commitAction = myCommitAction
953946 , _hydrationDomBuilderEnv_parent = p
@@ -956,7 +949,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
956949 0 -> writeIORef haveEverBeenReady True
957950 _ -> modifyIORef' parentUnreadyChildren succ
958951 liftIO $ putStrLn "drawInitialChild: end"
959− return (h', result)
952+ return (dom, result)
960953 a'' <- numberOccurrences a'
961954 (result0, evt) <- HydrationDomBuilderT $ lift $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(cohortId, child) -> do
962955 h <- liftIO $ readIORef hydrating
@@ -975,7 +968,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
975968 insertBefore p' after'
976969 liftIO $ writeIORef currentCohort cohortId
977970 myCommitAction
978− (result, HydrationDomBuilderState h') <- flip runStateT (HydrationDomBuilderState []) $ runReaderT (unHydrationDomBuilderT child) $ initialEnv
971+ (result, dom) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT child) $ initialEnv
979972 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
980973 , _hydrationDomBuilderEnv_commitAction = case h of
981974 HydrationMode_Hydrating -> myCommitAction
@@ -987,12 +980,12 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
987980 then Just $ commitAction
988981 else Nothing -- A child will run it when unreadyChildren is decremented to 0
989982 actions = case h of
990− HydrationMode_Hydrating -> Left h'
983+ HydrationMode_Hydrating -> Left dom
991984 HydrationMode_Immediate -> Right commitActionToRunNow
992985 return (actions, result)
993986 let (hydrationAction, commitAction) = fanEither $ fmap fst evt
994987 base :: Behavior t [DOM t m] <- hold (fst result0) hydrationAction
995− addAction $ DOM_Replace hydrateStart hydrateEnd base
988+ hydrateDOM $ DOM_Replace hydrateStart hydrateEnd base
996989 requestDomAction_ $ fmapMaybe id commitAction
997990 return (snd result0, fmap snd evt)
998991
@@ -1303,7 +1296,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
13031296
13041297{-# INLINABLE drawChildUpdate #-}
13051298drawChildUpdate :: (MonadIO m, MonadJSM m)
1306− => IORef (HydrationDomBuilderState t m)
1299+ => IORef [DOM t m]
13071300 -> HydrationDomBuilderEnv
13081301 -> (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
13091302 -> HydrationDomBuilderT t m (v' a)
@@ -1341,7 +1334,7 @@ drawChildUpdate stateRef initialEnv markReady child = do
13411334
13421335{-# INLINABLE drawChildUpdateInt #-}
13431336drawChildUpdateInt :: (MonadIO m, MonadJSM m)
1344− => IORef (HydrationDomBuilderState t m)
1337+ => IORef [DOM t m]
13451338 -> HydrationDomBuilderEnv
13461339 -> (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
13471340 -> HydrationDomBuilderT t m v'