@@ -34,13 +34,11 @@ module Reflex.Dom.Builder.Hydration
34 ( EventTriggerRef (..)
34 ( EventTriggerRef (..)
35 , HydrationDomBuilderEnv (..)
35 , HydrationDomBuilderEnv (..)
36 , HydrationDomBuilderT (..)
36 , HydrationDomBuilderT (..)
37− , HydrationDomBuilderT' (..)
38 , HydrationDomBuilderState (..)
37 , HydrationDomBuilderState (..)
39 , HydrationMode (..)
38 , HydrationMode (..)
40 , HydrationRunnerT (..)
39 , HydrationRunnerT (..)
40+ , runHydrationRunnerT
41 , DOM(..), runDOMForest
41 , DOM(..), runDOMForest
42− , HydrationRunnerEnv (..)
43− , HydrationRunnerState (..)
44 , runHydrationDomBuilderT
42 , runHydrationDomBuilderT
45 , askParent
43 , askParent
46 , askEvents
44 , askEvents
@@ -181,8 +179,14 @@ import Foreign.JavaScript.Internal.Utils
181#ifndef ghcjs_HOST_OS
179#ifndef ghcjs_HOST_OS
182import GHCJS.DOM.Types (MonadJSM (..))
180import GHCJS.DOM.Types (MonadJSM (..))
184−instance MonadJSM m => MonadJSM (HydrationDomBuilderT' env state t m) where
182+instance MonadJSM m => MonadJSM (HydrationDomBuilderT t m) where
185− liftJSM' = HydrationDomBuilderT . liftJSM'
183+ liftJSM' = lift . liftJSM'
185+instance MonadJSM m => MonadJSM (HydrationRunnerT t m) where
186+ liftJSM' = lift . liftJSM'
188+instance MonadJSM m => MonadJSM (DomRenderHookT t m) where
189+ liftJSM' = lift . liftJSM'
188data HydrationDomSpace
192data HydrationDomSpace
@@ -211,29 +215,28 @@ instance DomSpace HydrationDomSpace where
211 in DMap.alter f' en $ _ghcjsEventSpec_filters es
215 in DMap.alter f' en $ _ghcjsEventSpec_filters es
214−data HydrationDomBuilderEnv t m = HydrationDomBuilderEnv
218+data HydrationDomBuilderEnv = HydrationDomBuilderEnv
215 { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
219 { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
220+ -- ^ Reference to the document
216 , _hydrationDomBuilderEnv_parent :: {-# UNPACK #-} !(IORef Node)
221 , _hydrationDomBuilderEnv_parent :: {-# UNPACK #-} !(IORef Node)
222+ -- ^ This is in an IORef because in the time up to hydration we can't actually know what the
223+ -- parent is - we populate this reference during the DOM traversal at hydration time
217− , _hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word) -- Number of children who still aren't fully rendered
224+ , _hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word)
225+ -- ^ Number of children who still aren't fully rendered
226+ , _hydrationDomBuilderEnv_commitAction :: !(JSM ())
218− , _hydrationDomBuilderEnv_commitAction :: !(JSM ()) -- Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
227+ -- ^ Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
219− , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode) -- In hydration mode?
228+ , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
229+ -- ^ In hydration mode? Should be switched to `HydrationMode_Immediate` after hydration is finished
220 , _hydrationDomBuilderEnv_prerenderDepth :: {-# UNPACK #-} !(IORef Word)
230 , _hydrationDomBuilderEnv_prerenderDepth :: {-# UNPACK #-} !(IORef Word)
223−data HydrationRunnerEnv = HydrationRunnerEnv
224− { _hydrationRunnerEnv_document :: {-# UNPACK #-} !Document
225− , _hydrationRunnerEnv_parent :: {-# UNPACK #-} !Node
226− , _hydrationRunnerEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word) -- Number of children who still aren't fully rendered
227− , _hydrationRunnerEnv_commitAction :: !(JSM ()) -- Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
230−--newtype Forest a = Forest { unForest :: [DOM a] } deriving (Functor, Foldable, Traversable)
231data DOM t m
234data DOM t m
232 = DOM_Element (HydrationRunnerT t m Node) [DOM t m]
235 = DOM_Element (HydrationRunnerT t m Node) [DOM t m]
233 -- ^ Nodes with children, the action returns the node for the children to use as a parent
236 -- ^ Nodes with children, the action returns the node for the children to use as a parent
234 | DOM_Node (HydrationRunnerT t m ())
237 | DOM_Node (HydrationRunnerT t m ())
235 -- ^ Nodes without children
238 -- ^ Nodes without children
236− | DOM_Replace (Behavior t [DOM t m])
239+ | DOM_Replace (HydrationRunnerT t m ()) (HydrationRunnerT t m ()) (Behavior t [DOM t m])
237 -- ^ runWithReplace content changes over time
240 -- ^ runWithReplace content changes over time
239runDOMForest
242runDOMForest
@@ -247,19 +250,36 @@ runDOMTree
247 => DOM t m -> HydrationRunnerT t m ()
250 => DOM t m -> HydrationRunnerT t m ()
248runDOMTree = \case
251runDOMTree = \case
249 DOM_Node m -> m
252 DOM_Node m -> m
250− DOM_Element m children -> m >>= \p -> localEnv (\_ -> HydrationRunnerState Nothing) (\e -> e { _hydrationRunnerEnv_parent = p }) $ runDOMForest children
253+ DOM_Element m children -> m >>= localRunner (runDOMForest children) Nothing
254+ DOM_Replace start end b -> do
251− DOM_Replace b -> runDOMForest =<< sample b
256+ runDOMForest =<< lift (sample b)
253data HydrationDomBuilderState t m = HydrationDomBuilderState
259data HydrationDomBuilderState t m = HydrationDomBuilderState
254 { _hydrationDomBuilderState_delayed :: [DOM t m]
260 { _hydrationDomBuilderState_delayed :: [DOM t m]
257-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events
263-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events
258−type HydrationRunnerT t m a = HydrationDomBuilderT' HydrationRunnerEnv HydrationRunnerState t m a
264+-- State contains reference to the previous node sibling, if any.
265+-- 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)
266+newtype HydrationRunnerT t m a = HydrationRunnerT { unHydrationRunnerT :: StateT (Maybe Node) (ReaderT Node (DomRenderHookT t m)) a }
267+ deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
268+#if MIN_VERSION_base(4,9,1)
269+ , MonadAsyncException
260−data HydrationRunnerState = HydrationRunnerState
273+localRunner :: Monad m => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a
261− { _hydrationRunnerState_previousNode :: {-# UNPACK #-} !(Maybe Node)
274+localRunner (HydrationRunnerT m) prev = HydrationRunnerT . lift . lift . runReaderT (evalStateT m prev)
277+ :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
278+ => HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
279+runHydrationRunnerT (HydrationRunnerT m) prev parent = runDomRenderHookT (runReaderT (evalStateT m prev) parent)
281+instance MonadTrans (HydrationRunnerT t) where
282+ lift = HydrationRunnerT . lift . lift . lift
264addAction :: Monad m => DOM t m -> HydrationDomBuilderT t m ()
284addAction :: Monad m => DOM t m -> HydrationDomBuilderT t m ()
265addAction a = HydrationDomBuilderT $ modify $ \(HydrationDomBuilderState as) -> HydrationDomBuilderState (a : as)
285addAction a = HydrationDomBuilderT $ modify $ \(HydrationDomBuilderState as) -> HydrationDomBuilderState (a : as)
@@ -272,33 +292,65 @@ addAction a = HydrationDomBuilderT $ modify $ \(HydrationDomBuilderState as) ->
272-- static builder). The action runs in 'HydrationRunnerT', which performs the
292-- static builder). The action runs in 'HydrationRunnerT', which performs the
273-- DOM takeover and sets up the events, after which point this monad will
293-- DOM takeover and sets up the events, after which point this monad will
274-- continue in the vein of 'ImmediateDomBuilderT'.
294-- continue in the vein of 'ImmediateDomBuilderT'.
275−type HydrationDomBuilderT t m a = HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m a
277−newtype HydrationDomBuilderT' env state t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT env (StateT state (RequesterT t JSM Identity (TriggerEventT t m))) a }
295+newtype HydrationDomBuilderT t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT HydrationDomBuilderEnv (StateT (HydrationDomBuilderState t m) (DomRenderHookT t m)) a }
278 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
296 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
279#if MIN_VERSION_base(4,9,1)
297#if MIN_VERSION_base(4,9,1)
280 , MonadAsyncException
298 , MonadAsyncException
284−instance PrimMonad m => PrimMonad (HydrationDomBuilderT' env state x m) where
302+instance PrimMonad m => PrimMonad (HydrationDomBuilderT x m) where
285− type PrimState (HydrationDomBuilderT' env state x m) = PrimState m
303+ type PrimState (HydrationDomBuilderT x m) = PrimState m
286 primitive = lift . primitive
304 primitive = lift . primitive
288−instance MonadTrans (HydrationDomBuilderT' env state t) where
306+instance MonadTrans (HydrationDomBuilderT t) where
289− lift = HydrationDomBuilderT . lift . lift . lift . lift
307+ lift = HydrationDomBuilderT . lift . lift . lift
309+-- | Shared behavior for HydrationDomBuilderT and HydrationRunnerT
310+newtype DomRenderHookT t m a = DomRenderHookT { unDomRenderHookT :: RequesterT t JSM Identity (TriggerEventT t m) a }
311+ deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
312+#if MIN_VERSION_base(4,9,1)
313+ , MonadAsyncException
317+{-# INLINABLE runDomRenderHookT #-}
319+ :: (MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef)
320+ => DomRenderHookT t m a
321+ -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
323+runDomRenderHookT (DomRenderHookT a) events = do
324+ flip runTriggerEventT events $ do
325+ rec (result, req) <- runRequesterT a rsp
326+ rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame f $
327+ traverseRequesterData (\r -> Identity <$> r) rm
330+ runInAnimationFrame f x = void . DOM.inAnimationFrame' $ \_ -> do
331+ v <- synchronously x
334+instance MonadTrans (DomRenderHookT t) where
335+ lift = DomRenderHookT . lift . lift
291−instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationDomBuilderT' env state t m) where
337+instance (Reflex t, MonadFix m) => DomRenderHook t (DomRenderHookT t m) where
292− withRenderHook hook (HydrationDomBuilderT a) = do
338+ withRenderHook hook (DomRenderHookT a) = do
293− e <- HydrationDomBuilderT ask
294− s <- HydrationDomBuilderT get
295− (a, s') <- HydrationDomBuilderT $ lift $ lift $ withRequesting $ \rsp -> do
339+ DomRenderHookT $ withRequesting $ \rsp -> do
296− (x, req) <- lift $ runRequesterT (runStateT (runReaderT a e) s) $ runIdentity <$> rsp
340+ (x, req) <- lift $ runRequesterT a $ runIdentity <$> rsp
297 return (ffor req $ \rm -> hook $ traverseRequesterData (\r -> Identity <$> r) rm, x)
341 return (ffor req $ \rm -> hook $ traverseRequesterData (\r -> Identity <$> r) rm, x)
298− HydrationDomBuilderT $ put s'
300− requestDomAction = HydrationDomBuilderT . lift . lift . requestingIdentity
342+ requestDomAction = DomRenderHookT . requestingIdentity
301− requestDomAction_ = HydrationDomBuilderT . lift . lift . requesting_
343+ requestDomAction_ = DomRenderHookT . requesting_
345+instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationDomBuilderT t m) where
346+ withRenderHook hook = HydrationDomBuilderT . mapReaderT (mapStateT (withRenderHook hook)) . unHydrationDomBuilderT
347+ requestDomAction = HydrationDomBuilderT . lift . lift . requestDomAction
348+ requestDomAction_ = HydrationDomBuilderT . lift . lift . requestDomAction_
350+instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationRunnerT t m) where
351+ withRenderHook hook = HydrationRunnerT . mapStateT (mapReaderT (withRenderHook hook)) . unHydrationRunnerT
352+ requestDomAction = HydrationRunnerT . lift . lift . requestDomAction
353+ requestDomAction_ = HydrationRunnerT . lift . lift . requestDomAction_
303{-# INLINABLE runHydrationDomBuilderT #-}
355{-# INLINABLE runHydrationDomBuilderT #-}
304runHydrationDomBuilderT
356runHydrationDomBuilderT
@@ -310,46 +362,28 @@ runHydrationDomBuilderT
310 , MonadRef m
362 , MonadRef m
311 , Ref m ~ IORef
363 , Ref m ~ IORef
313− => HydrationDomBuilderT' env state t m a
365+ => HydrationDomBuilderT t m a
314− -> env
366+ -> HydrationDomBuilderEnv
315− -> state
367+ -> HydrationDomBuilderState t m
316 -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
368 -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
317− -> m (a, state)
369+ -> m (a, HydrationDomBuilderState t m)
318−runHydrationDomBuilderT (HydrationDomBuilderT a) env st events = do
370+runHydrationDomBuilderT (HydrationDomBuilderT a) env st events = runDomRenderHookT (runStateT (runReaderT a env) st) events
319− flip runTriggerEventT events $ do
320− rec (result, req) <- runRequesterT (runStateT (runReaderT a env) st) rsp
321− rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame f $
322− traverseRequesterData (\r -> Identity <$> r) rm
325− runInAnimationFrame f x = void . DOM.inAnimationFrame' $ \_ -> do
326− v <- synchronously x
329−instance Monad m => HasDocument (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) where
372+instance Monad m => HasDocument (HydrationDomBuilderT t m) where
330 {-# INLINABLE askDocument #-}
373 {-# INLINABLE askDocument #-}
331− askDocument = askDocumentEnv
333−class HasDocEnv env where
334− askDocumentEnv :: Monad m => HydrationDomBuilderT' env state t m DOM.Document
336−instance HasDocEnv (HydrationDomBuilderEnv t m) where
337− askDocumentEnv = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document
374+ askDocument = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document
339−instance HasDocEnv HydrationRunnerEnv where
340− askDocumentEnv = HydrationDomBuilderT $ asks _hydrationRunnerEnv_document
342{-# INLINABLE localEnv #-}
376{-# INLINABLE localEnv #-}
343−localEnv :: Monad m => (s -> s) -> (e -> e) -> HydrationDomBuilderT' e s t m a -> HydrationDomBuilderT' e s t m a
377+localEnv :: Monad m => (HydrationDomBuilderState t m -> HydrationDomBuilderState t m) -> (HydrationDomBuilderEnv -> HydrationDomBuilderEnv) -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m a
344localEnv f g (HydrationDomBuilderT m) = HydrationDomBuilderT $ do
378localEnv f g (HydrationDomBuilderT m) = HydrationDomBuilderT $ do
345 env <- ask
379 env <- ask
346 hs <- get
380 hs <- get
347 lift $ lift $ evalStateT (runReaderT m $ g env) (f hs)
381 lift $ lift $ evalStateT (runReaderT m $ g env) (f hs)
349{-# INLINABLE append #-}
383{-# INLINABLE append #-}
350−append :: (MonadJSM m, HasParent env) => DOM.Node -> HydrationDomBuilderT' env state t m ()
384+append :: MonadJSM m => DOM.Node -> HydrationDomBuilderT t m ()
351append n = do
385append n = do
352− p <- askParent
386+ p <- getParent
353 appendChild_ p n
387 appendChild_ p n
354 return ()
388 return ()
@@ -358,60 +392,43 @@ data HydrationMode
358 | HydrationMode_Immediate
392 | HydrationMode_Immediate
359 deriving (Eq, Ord, Show)
393 deriving (Eq, Ord, Show)
361−class HasParent env where
395+{-# INLINABLE askParent #-}
362− askParent :: (Monad m, MonadIO m) => HydrationDomBuilderT' env state t m DOM.Node
396+askParent :: Monad m => HydrationRunnerT t m DOM.Node
363−
397+askParent = HydrationRunnerT ask
364−instance HasParent (HydrationDomBuilderEnv t m) where
365− {-# INLINABLE askParent #-}
366− askParent = liftIO . readIORef =<< HydrationDomBuilderT (asks _hydrationDomBuilderEnv_parent)
368−instance HasParent HydrationRunnerEnv where
369− {-# INLINABLE askParent #-}
370− askParent = HydrationDomBuilderT $ asks _hydrationRunnerEnv_parent
372−class HasUnreadyChildren env where
399+{-# INLINABLE getPreviousNode #-}
373− askUnreadyChildren :: Monad m => HydrationDomBuilderT' env state t m (IORef Word)
400+getPreviousNode :: Monad m => HydrationRunnerT t m (Maybe DOM.Node)
374− askCommitAction :: Monad m => HydrationDomBuilderT' env state t m (JSM ())
401+getPreviousNode = HydrationRunnerT get
376−instance HasUnreadyChildren (HydrationDomBuilderEnv t m) where
403+{-# INLINABLE setPreviousNode #-}
377− {-# INLINABLE askUnreadyChildren #-}
404+setPreviousNode :: Monad m => Maybe DOM.Node -> HydrationRunnerT t m ()
378− askUnreadyChildren = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_unreadyChildren
405+setPreviousNode = HydrationRunnerT . put
379− {-# INLINABLE askCommitAction #-}
380− askCommitAction = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_commitAction
382−instance HasUnreadyChildren HydrationRunnerEnv where
383− {-# INLINABLE askUnreadyChildren #-}
407+{-# INLINABLE getParent #-}
384− askUnreadyChildren = HydrationDomBuilderT $ asks _hydrationRunnerEnv_unreadyChildren
408+getParent :: MonadIO m => HydrationDomBuilderT t m DOM.Node
385− {-# INLINABLE askCommitAction #-}
409+getParent = liftIO . readIORef =<< HydrationDomBuilderT (asks _hydrationDomBuilderEnv_parent)
386− askCommitAction = HydrationDomBuilderT $ asks _hydrationRunnerEnv_commitAction
411+{-# INLINABLE askUnreadyChildren #-}
412+askUnreadyChildren :: Monad m => HydrationDomBuilderT t m (IORef Word)
413+askUnreadyChildren = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_unreadyChildren
389−class HasPreviousNode state where
415+{-# INLINABLE askCommitAction #-}
390− getPreviousNode :: Monad m => HydrationDomBuilderT' env state t m (Maybe DOM.Node)
416+askCommitAction :: Monad m => HydrationDomBuilderT t m (JSM ())
391− setPreviousNode :: Monad m => Maybe DOM.Node -> HydrationDomBuilderT' env state t m ()
417+askCommitAction = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_commitAction
393−instance HasPreviousNode HydrationRunnerState where
419+{-# INLINABLE getHydrationMode #-}
394− {-# INLINABLE getPreviousNode #-}
395− getPreviousNode = HydrationDomBuilderT $ gets _hydrationRunnerState_previousNode
396− {-# INLINABLE setPreviousNode #-}
397− setPreviousNode n = HydrationDomBuilderT $ modify $ \hs -> hs { _hydrationRunnerState_previousNode = n }
399−class HasHydrationMode env where
400− getHydrationMode :: MonadIO m => HydrationDomBuilderT' env state t m HydrationMode
420+getHydrationMode :: MonadIO m => HydrationDomBuilderT t m HydrationMode
402−instance HasHydrationMode (HydrationDomBuilderEnv t m) where
403− {-# INLINABLE getHydrationMode #-}
404− getHydrationMode = liftIO . readIORef =<< HydrationDomBuilderT (asks _hydrationDomBuilderEnv_hydrationMode)
421+getHydrationMode = liftIO . readIORef =<< HydrationDomBuilderT (asks _hydrationDomBuilderEnv_hydrationMode)
406{-# INLINABLE askEvents #-}
423{-# INLINABLE askEvents #-}
407−askEvents :: Monad m => HydrationDomBuilderT' env state t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
424+askEvents :: Monad m => HydrationDomBuilderT t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
408−askEvents = HydrationDomBuilderT . lift . lift . lift $ TriggerEventT.askEvents
425+askEvents = HydrationDomBuilderT . lift . lift . DomRenderHookT . lift $ TriggerEventT.askEvents
411{-# INLINABLE makeNodeInternal #-}
428{-# INLINABLE makeNodeInternal #-}
412makeNodeInternal
429makeNodeInternal
413− :: forall node env state t m. (MonadJSM m, IsNode node, Typeable node, HasParent env)
430+ :: forall node t m. (MonadJSM m, IsNode node, Typeable node)
414− => HydrationDomBuilderT' env state t m node -> HydrationDomBuilderT' env state t m node
431+ => HydrationDomBuilderT t m node -> HydrationDomBuilderT t m node
415makeNodeInternal mkNode = do
432makeNodeInternal mkNode = do
416 liftIO $ putStr $ show (typeRep (Proxy :: Proxy node)) <> ": "
433 liftIO $ putStr $ show (typeRep (Proxy :: Proxy node)) <> ": "
417 liftIO $ putStrLn $ "Not in hydration mode, creating node"
434 liftIO $ putStrLn $ "Not in hydration mode, creating node"
@@ -424,8 +441,8 @@ makeNodeInternal mkNode = do
424-- correct. It skips any nodes that are the wrong type, or that fail the
441-- correct. It skips any nodes that are the wrong type, or that fail the
425-- @check@. The previous node reference is also updated.
442-- @check@. The previous node reference is also updated.
426hydrateNode
443hydrateNode
427− :: (MonadJSM m, IsNode node, Typeable node, HasPreviousNode state, HasParent env)
444+ :: (MonadJSM m, IsNode node, Typeable node)
428− => (node -> HydrationDomBuilderT' env state t m Bool) -> HydrationDomBuilderT' env state t m node -> (DOM.JSVal -> node) -> HydrationDomBuilderT' env state t m node
445+ => (node -> HydrationRunnerT t m Bool) -> HydrationRunnerT t m node -> (DOM.JSVal -> node) -> HydrationRunnerT t m node
429hydrateNode check mkNode constructor = do
446hydrateNode check mkNode constructor = do
430 parent <- askParent
447 parent <- askParent
431 liftIO $ putStr $ show (typeRep constructor) <> ": "
448 liftIO $ putStr $ show (typeRep constructor) <> ": "
@@ -540,7 +557,7 @@ makeElement elementTag cfg child = do
540 ctx <- askJSM
557 ctx <- askJSM
541 events <- askEvents
558 events <- askEvents
543− let buildElement :: HydrationDomBuilderT' env state t m DOM.Element
560+ let buildElement :: MonadJSM n => n DOM.Element
544 buildElement = do
561 buildElement = do
545 e <- uncheckedCastTo DOM.Element <$> case cfg ^. namespace of
562 e <- uncheckedCastTo DOM.Element <$> case cfg ^. namespace of
546 Nothing -> createElement doc elementTag
563 Nothing -> createElement doc elementTag
@@ -550,7 +567,7 @@ makeElement elementTag cfg child = do
550 Just ans -> setAttributeNS e (Just ans) n v
567 Just ans -> setAttributeNS e (Just ans) n v
552 ssrAttr = "ssr" :: DOM.JSString
569 ssrAttr = "ssr" :: DOM.JSString
553− hasSSRAttribute :: DOM.Element -> HydrationDomBuilderT' env state t m Bool
570+ hasSSRAttribute :: DOM.Element -> HydrationRunnerT t m Bool
554 hasSSRAttribute e = case cfg ^. namespace of
571 hasSSRAttribute e = case cfg ^. namespace of
555 Nothing -> hasAttribute e ssrAttr -- TODO: disabled for debugging <* removeAttribute e ssrAttr
572 Nothing -> hasAttribute e ssrAttr -- TODO: disabled for debugging <* removeAttribute e ssrAttr
556 Just ns -> hasAttributeNS e (Just ns) ssrAttr -- TODO: disabled for debugging <* removeAttributeNS e (Just ns) ssrAttr
573 Just ns -> hasAttributeNS e (Just ns) ssrAttr -- TODO: disabled for debugging <* removeAttributeNS e (Just ns) ssrAttr
@@ -628,13 +645,14 @@ makeElement elementTag cfg child = do
628textNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Text
645textNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Text
629textNodeInternal !t mSetContents = getHydrationMode >>= \case
646textNodeInternal !t mSetContents = getHydrationMode >>= \case
630 HydrationMode_Immediate -> do
647 HydrationMode_Immediate -> do
631− n <- makeNodeInternal (askDocumentEnv >>= \doc -> createTextNode doc t)
648+ n <- makeNodeInternal (askDocument >>= \doc -> createTextNode doc t)
632 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
649 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
634 HydrationMode_Hydrating -> do
651 HydrationMode_Hydrating -> do
635 let activateText = do
653 let activateText = do
636 liftIO $ putStrLn $ "Action: Text: " <> show (DOM.toJSString t)
654 liftIO $ putStrLn $ "Action: Text: " <> show (DOM.toJSString t)
637− n <- hydrateNode (const $ pure True) (askDocumentEnv >>= \doc -> createTextNode doc t) DOM.Text
655+ n <- hydrateNode (const $ pure True) (createTextNode doc t) DOM.Text
638 --case mSetContents of
656 --case mSetContents of
639 -- Nothing -> liftIO $ putStrLn "No update events for text"
657 -- Nothing -> liftIO $ putStrLn "No update events for text"
640 -- Just e -> requestDomAction_ $ setNodeValue n . Just <$> e
658 -- Just e -> requestDomAction_ $ setNodeValue n . Just <$> e
@@ -646,20 +664,21 @@ textNodeInternal !t mSetContents = getHydrationMode >>= \case
646commentNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Comment
664commentNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Comment
647commentNodeInternal !t mSetContents = getHydrationMode >>= \case
665commentNodeInternal !t mSetContents = getHydrationMode >>= \case
648 HydrationMode_Immediate -> do
666 HydrationMode_Immediate -> do
649− n <- makeNodeInternal (askDocumentEnv >>= \doc -> createComment doc t)
667+ n <- makeNodeInternal (askDocument >>= \doc -> createComment doc t)
650 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
668 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
652 HydrationMode_Hydrating -> do
670 HydrationMode_Hydrating -> do
653 let activateComment = do
672 let activateComment = do
654 liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)
673 liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)
655− n <- hydrateNode (const $ pure True) (askDocumentEnv >>= \doc -> createComment doc t) DOM.Comment
674+ n <- hydrateNode (const $ pure True) (createComment doc t) DOM.Comment
656 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
675 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
657 addAction $ DOM_Node activateComment
676 addAction $ DOM_Node activateComment
658 pure $ error "commentNodeInternal: DOM.Comment"
677 pure $ error "commentNodeInternal: DOM.Comment"
660-- | We leave markers in the static builder as comments, and rip these comments
679-- | We leave markers in the static builder as comments, and rip these comments
661-- out at hydration time, replacing them with empty text nodes.
680-- out at hydration time, replacing them with empty text nodes.
662−skipToAndReplaceComment :: (MonadJSM m, Reflex t, MonadFix m) => Text -> IORef Text -> HydrationDomBuilderT t m (IORef DOM.Text, IORef Text)
681+skipToAndReplaceComment :: (MonadJSM m, Reflex t, MonadFix m) => Text -> IORef Text -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)
663skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
682skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
664 HydrationMode_Immediate -> do
683 HydrationMode_Immediate -> do
665 -- If we're in immediate mode, we don't try to replace an existing comment,
684 -- If we're in immediate mode, we don't try to replace an existing comment,
@@ -668,7 +687,7 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
668 append $ toNode t
687 append $ toNode t
669 textNodeRef <- liftIO $ newIORef t
688 textNodeRef <- liftIO $ newIORef t
670 keyRef <- liftIO $ newIORef ""
689 keyRef <- liftIO $ newIORef ""
671− pure (textNodeRef, keyRef)
690+ pure (pure (), textNodeRef, keyRef)
672 HydrationMode_Hydrating -> do
691 HydrationMode_Hydrating -> do
673 doc <- askDocument
692 doc <- askDocument
674 textNodeRef <- liftIO $ newIORef $ error "textNodeRef not yet initialized"
693 textNodeRef <- liftIO $ newIORef $ error "textNodeRef not yet initialized"
@@ -703,17 +722,17 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
703 liftIO $ do
722 liftIO $ do
704 writeIORef textNodeRef textNode
723 writeIORef textNodeRef textNode
705 writeIORef keyRef key
724 writeIORef keyRef key
706− addAction $ DOM_Node switchComment
725+-- addAction $ DOM_Node switchComment
707− pure (textNodeRef, keyRef)
726+ pure (switchComment, textNodeRef, keyRef)
710−skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m) => HydrationDomBuilderT t m (IORef DOM.Text, IORef Text)
729+skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m) => HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)
711skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")
730skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")
713−skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m) => IORef Text -> HydrationDomBuilderT t m (IORef DOM.Text)
732+skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m) => IORef Text -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text)
714−skipToReplaceEnd key = fmap fst $ skipToAndReplaceComment "replace-end" key
733+skipToReplaceEnd key = fmap (\(m,e,_) -> (m,e)) $ skipToAndReplaceComment "replace-end" key
716−instance (HasUnreadyChildren env, SupportsHydrationDomBuilder t m) => NotReady t (HydrationDomBuilderT' env state t m) where
735+instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT t m) where
717 notReadyUntil e = do
736 notReadyUntil e = do
718 eOnce <- headE e
737 eOnce <- headE e
719 unreadyChildren <- askUnreadyChildren
738 unreadyChildren <- askUnreadyChildren
@@ -730,8 +749,8 @@ instance (HasUnreadyChildren env, SupportsHydrationDomBuilder t m) => NotReady t
730 unreadyChildren <- askUnreadyChildren
749 unreadyChildren <- askUnreadyChildren
731 liftIO $ modifyIORef' unreadyChildren succ
750 liftIO $ modifyIORef' unreadyChildren succ
733−instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) where
752+instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT t m) where
734− type DomBuilderSpace (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) = HydrationDomSpace
753+ type DomBuilderSpace (HydrationDomBuilderT t m) = HydrationDomSpace
735 {-# INLINABLE textNode #-}
754 {-# INLINABLE textNode #-}
736 textNode (TextNodeConfig initialContents mSetContents) = do
755 textNode (TextNodeConfig initialContents mSetContents) = do
737 liftIO $ putStrLn $ "Text: " <> T.unpack initialContents
756 liftIO $ putStrLn $ "Text: " <> T.unpack initialContents
@@ -870,8 +889,8 @@ extractFragment fragment = do
870 extractBetweenExclusive (_hydrationDomFragment_document fragment) before after
889 extractBetweenExclusive (_hydrationDomFragment_document fragment) before after
871 liftIO $ writeIORef (_hydrationDomFragment_state fragment) FragmentState_Unmounted
890 liftIO $ writeIORef (_hydrationDomFragment_state fragment) FragmentState_Unmounted
873−instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) where
892+instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomBuilderT t m) where
874− type DomFragment (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) = HydrationDomFragment
893+ type DomFragment (HydrationDomBuilderT t m) = HydrationDomFragment
875 buildDomFragment w = do
894 buildDomFragment w = do
876 df <- createDocumentFragment =<< askDocument
895 df <- createDocumentFragment =<< askDocument
877 p <- liftIO $ newIORef $ toNode df
896 p <- liftIO $ newIORef $ toNode df
@@ -879,7 +898,7 @@ instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomB
879 state <- liftIO $ newIORef FragmentState_Unmounted
898 state <- liftIO $ newIORef FragmentState_Unmounted
880 return (HydrationDomFragment df state, result)
899 return (HydrationDomFragment df state, result)
881 mountDomFragment fragment setFragment = do
900 mountDomFragment fragment setFragment = do
882− parent <- askParent
901+ parent <- getParent
883 extractFragment fragment
902 extractFragment fragment
884 before <- textNodeInternal ("" :: Text) Nothing
903 before <- textNodeInternal ("" :: Text) Nothing
885 appendChild_ parent $ _hydrationDomFragment_document fragment
904 appendChild_ parent $ _hydrationDomFragment_document fragment
@@ -892,14 +911,20 @@ instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomB
892 liftIO $ writeIORef (_hydrationDomFragment_state childFragment) $ FragmentState_Mounted (before, after)
911 liftIO $ writeIORef (_hydrationDomFragment_state childFragment) $ FragmentState_Mounted (before, after)
893 liftIO $ writeIORef (_hydrationDomFragment_state fragment) $ FragmentState_Mounted (before, after)
912 liftIO $ writeIORef (_hydrationDomFragment_state fragment) $ FragmentState_Mounted (before, after)
914+instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (DomRenderHookT t m) where
915+ runWithReplace a0 a' = DomRenderHookT $ runWithReplace (unDomRenderHookT a0) (fmapCheap unDomRenderHookT a')
916+ traverseIntMapWithKeyWithAdjust f m = DomRenderHookT . traverseIntMapWithKeyWithAdjust (\k -> unDomRenderHookT . f k) m
917+ traverseDMapWithKeyWithAdjust f m = DomRenderHookT . traverseDMapWithKeyWithAdjust (\k -> unDomRenderHookT . f k) m
918+ traverseDMapWithKeyWithAdjustWithMove f m = DomRenderHookT . traverseDMapWithKeyWithAdjustWithMove (\k -> unDomRenderHookT . f k) m
895−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' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) where
920+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
896 {-# INLINABLE runWithReplace #-}
921 {-# INLINABLE runWithReplace #-}
897 runWithReplace a0 a' = do
922 runWithReplace a0 a' = do
898 liftIO $ putStrLn "In runWithReplace"
923 liftIO $ putStrLn "In runWithReplace"
899 initialEnv <- HydrationDomBuilderT ask
924 initialEnv <- HydrationDomBuilderT ask
900 let hydrating = _hydrationDomBuilderEnv_hydrationMode initialEnv
925 let hydrating = _hydrationDomBuilderEnv_hydrationMode initialEnv
901 initialHydrationMode <- liftIO $ readIORef hydrating
926 initialHydrationMode <- liftIO $ readIORef hydrating
902− (before, beforeKey) <- skipToReplaceStart
927+ (hydrateStart, before, beforeKey) <- skipToReplaceStart
903 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
928 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
904 haveEverBeenReady <- liftIO $ newIORef False
929 haveEverBeenReady <- liftIO $ newIORef False
905 currentCohort <- liftIO $ newIORef (-1 :: Int) -- Equal to the cohort currently in the DOM
930 currentCohort <- liftIO $ newIORef (-1 :: Int) -- Equal to the cohort currently in the DOM
@@ -914,10 +939,8 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
914 when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
939 when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
915 -- We draw 'after' in this roundabout way to avoid using MonadFix
940 -- We draw 'after' in this roundabout way to avoid using MonadFix
916 doc <- askDocument
941 doc <- askDocument
917− parent <- askParent
942+ parent <- getParent
918− after <- skipToReplaceEnd beforeKey
943+ (hydrateEnd, after) <- skipToReplaceEnd beforeKey
919− -- TODO improve skipToReplace nonsense
920− addAction $ DOM_Node $ setPreviousNode . Just . toNode =<< liftIO (readIORef before)
921 let drawInitialChild = do
944 let drawInitialChild = do
922 liftIO $ putStrLn "drawInitialChild"
945 liftIO $ putStrLn "drawInitialChild"
923 p <- liftIO (readIORef hydrating) >>= \case
946 p <- liftIO (readIORef hydrating) >>= \case
@@ -969,7 +992,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
969 return (actions, result)
992 return (actions, result)
970 let (hydrationAction, commitAction) = fanEither $ fmap fst evt
993 let (hydrationAction, commitAction) = fanEither $ fmap fst evt
971 base :: Behavior t [DOM t m] <- hold (fst result0) hydrationAction
994 base :: Behavior t [DOM t m] <- hold (fst result0) hydrationAction
972− addAction $ DOM_Replace base
995+ addAction $ DOM_Replace hydrateStart hydrateEnd base
973 requestDomAction_ $ fmapMaybe id commitAction
996 requestDomAction_ $ fmapMaybe id commitAction
974 return (snd result0, fmap snd evt)
997 return (snd result0, fmap snd evt)
@@ -1062,7 +1085,12 @@ traverseDMapWithKeyWithAdjust' = do
1062 liftIO $ writeIORef placeholders $! fromMaybe phs $ apply (weakenPatchDMapWith (\(Compose (_, ph, _, _)) -> ph) $ PatchDMap p) phs
1085 liftIO $ writeIORef placeholders $! fromMaybe phs $ apply (weakenPatchDMapWith (\(Compose (_, ph, _, _)) -> ph) $ PatchDMap p) phs
1064{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
1087{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
1088+traverseIntMapWithKeyWithAdjust'
1065−traverseIntMapWithKeyWithAdjust' :: forall t m v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadIO m, MonadJSM m, PrimMonad m) => (IntMap.Key -> v -> HydrationDomBuilderT t m v') -> IntMap v -> Event t (PatchIntMap v) -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))
1089+ :: forall t m v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadIO m, MonadJSM m, PrimMonad m)
1090+ => (IntMap.Key -> v -> HydrationDomBuilderT t m v')
1092+ -> Event t (PatchIntMap v)
1093+ -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))
1066traverseIntMapWithKeyWithAdjust' = do
1094traverseIntMapWithKeyWithAdjust' = do
1067 let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do
1095 let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do
1068 let new :: IntMap.Key -> Maybe (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))
1096 let new :: IntMap.Key -> Maybe (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))
@@ -1099,10 +1127,10 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
1099 , Monoid (p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1127 , Monoid (p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1100 , Functor p
1128 , Functor p
1102− => ( (IntMap.Key -> v -> RequesterT t JSM Identity (TriggerEventT t m) (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1130+ => ( (IntMap.Key -> v -> DomRenderHookT t m (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1103 -> IntMap v
1131 -> IntMap v
1104 -> Event t (p v)
1132 -> Event t (p v)
1105− -> RequesterT t JSM Identity (TriggerEventT t m) (IntMap (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'), Event t (p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')))
1133+ -> DomRenderHookT t m (IntMap (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'), Event t (p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')))
1106 ) -- ^ The base monad's traversal
1134 ) -- ^ The base monad's traversal
1107 -> (p (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
1135 -> (p (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
1108 -> (IORef (IntMap DOM.Text) -> IORef DOM.Text -> p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> JSM ()) -- ^ Apply a patch to the DOM
1136 -> (IORef (IntMap DOM.Text) -> IORef DOM.Text -> p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> JSM ()) -- ^ Apply a patch to the DOM
@@ -1111,7 +1139,7 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
1111 -> Event t (p v)
1139 -> Event t (p v)
1112 -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
1140 -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
1113hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1141hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1114− (_, key) <- skipToReplaceStart
1142+ (hydrateStart, _, key) <- skipToReplaceStart
1115 initialEnv <- HydrationDomBuilderT ask
1143 initialEnv <- HydrationDomBuilderT ask
1116 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1144 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1117 pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
1145 pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
@@ -1168,7 +1196,7 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
1168 getHydrationMode >>= \case
1196 getHydrationMode >>= \case
1169 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (df, _, _, _) -> void $ append $ toNode df) children0
1197 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (df, _, _, _) -> void $ append $ toNode df) children0
1170 _ -> pure ()
1198 _ -> pure ()
1171− lastPlaceholderRef <- skipToReplaceEnd key
1199+ (hydrateEnd, lastPlaceholderRef) <- skipToReplaceEnd key
1172 requestDomAction_ $ ffor children' $ \p -> do
1200 requestDomAction_ $ ffor children' $ \p -> do
1173 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1201 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1174 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
1202 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
@@ -1193,10 +1221,10 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
1193 , Patch (p k (Constant Int))
1221 , Patch (p k (Constant Int))
1195 => (forall vv vv'.
1223 => (forall vv vv'.
1196− (forall a. k a -> vv a -> RequesterT t JSM Identity (TriggerEventT t m) (vv' a))
1224+ (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
1197 -> DMap k vv
1225 -> DMap k vv
1198 -> Event t (p k vv)
1226 -> Event t (p k vv)
1199− -> RequesterT t JSM Identity (TriggerEventT t m) (DMap k vv', Event t (p k vv'))
1227+ -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
1200 ) -- ^ The base monad's traversal
1228 ) -- ^ The base monad's traversal
1201 -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type
1229 -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type
1202 -> (p k (Compose ((,,,) 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
1230 -> (p k (Compose ((,,,) 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
@@ -1206,7 +1234,7 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
1206 -> Event t (p k v)
1234 -> Event t (p k v)
1207 -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))
1235 -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))
1208hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ (f :: forall a. k a -> v a -> HydrationDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do
1236hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ (f :: forall a. k a -> v a -> HydrationDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do
1209− (_, key) <- skipToReplaceStart
1237+ (hydrateStart, _, key) <- skipToReplaceStart
1210 initialEnv <- HydrationDomBuilderT ask
1238 initialEnv <- HydrationDomBuilderT ask
1211 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1239 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1212 pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) <- liftIO $ newIORef mempty
1240 pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) <- liftIO $ newIORef mempty
@@ -1263,7 +1291,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
1263 getHydrationMode >>= \case
1291 getHydrationMode >>= \case
1264 HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (df, _, _, _)) -> Constant () <$ append (toNode df)) children0
1292 HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (df, _, _, _)) -> Constant () <$ append (toNode df)) children0
1265 _ -> pure ()
1293 _ -> pure ()
1266− lastPlaceholderRef <- skipToReplaceEnd key
1294+ (hydrateEnd, lastPlaceholderRef) <- skipToReplaceEnd key
1267 requestDomAction_ $ ffor children' $ \p -> do
1295 requestDomAction_ $ ffor children' $ \p -> do
1268 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1296 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1269 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
1297 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
@@ -1276,10 +1304,10 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
1276{-# INLINABLE drawChildUpdate #-}
1304{-# INLINABLE drawChildUpdate #-}
1277drawChildUpdate :: (MonadIO m, MonadJSM m)
1305drawChildUpdate :: (MonadIO m, MonadJSM m)
1278 => IORef (HydrationDomBuilderState t m)
1306 => IORef (HydrationDomBuilderState t m)
1279− -> HydrationDomBuilderEnv t m
1307+ -> HydrationDomBuilderEnv
1280 -> (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
1308 -> (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
1281 -> HydrationDomBuilderT t m (v' a)
1309 -> HydrationDomBuilderT t m (v' a)
1282− -> RequesterT t JSM Identity (TriggerEventT t m) (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)
1310+ -> DomRenderHookT t m (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)
1283drawChildUpdate stateRef initialEnv markReady child = do
1311drawChildUpdate stateRef initialEnv markReady child = do
1284 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
1312 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
1285 let doc = _hydrationDomBuilderEnv_document initialEnv
1313 let doc = _hydrationDomBuilderEnv_document initialEnv
@@ -1314,10 +1342,10 @@ drawChildUpdate stateRef initialEnv markReady child = do
1314{-# INLINABLE drawChildUpdateInt #-}
1342{-# INLINABLE drawChildUpdateInt #-}
1315drawChildUpdateInt :: (MonadIO m, MonadJSM m)
1343drawChildUpdateInt :: (MonadIO m, MonadJSM m)
1316 => IORef (HydrationDomBuilderState t m)
1344 => IORef (HydrationDomBuilderState t m)
1317− -> HydrationDomBuilderEnv t m
1345+ -> HydrationDomBuilderEnv
1318 -> (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
1346 -> (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
1319 -> HydrationDomBuilderT t m v'
1347 -> HydrationDomBuilderT t m v'
1320− -> RequesterT t JSM Identity (TriggerEventT t m) (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')
1348+ -> DomRenderHookT t m (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')
1321drawChildUpdateInt stateRef initialEnv markReady child = do
1349drawChildUpdateInt stateRef initialEnv markReady child = do
1322 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing
1350 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing
1323 let doc = _hydrationDomBuilderEnv_document initialEnv
1351 let doc = _hydrationDomBuilderEnv_document initialEnv
@@ -1370,24 +1398,30 @@ insertBefore new existing = do
1370 liftIO $ putStrLn "insertBefore2"
1398 liftIO $ putStrLn "insertBefore2"
1371 DOM.insertBefore_ p new (Just existing) -- If there's no parent, that means we've been removed from the DOM; this should not happen if the we're removing ourselves from the performEvent properly
1399 DOM.insertBefore_ p new (Just existing) -- If there's no parent, that means we've been removed from the DOM; this should not happen if the we're removing ourselves from the performEvent properly
1373−instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT' env state t m) where
1401+instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where
1374− type Performable (HydrationDomBuilderT' env state t m) = Performable m
1402+ type Performable (HydrationDomBuilderT t m) = Performable m
1375 {-# INLINABLE performEvent_ #-}
1403 {-# INLINABLE performEvent_ #-}
1376 performEvent_ e = lift $ performEvent_ e
1404 performEvent_ e = lift $ performEvent_ e
1377 {-# INLINABLE performEvent #-}
1405 {-# INLINABLE performEvent #-}
1378 performEvent e = lift $ performEvent e
1406 performEvent e = lift $ performEvent e
1380−instance PostBuild t m => PostBuild t (HydrationDomBuilderT' env state t m) where
1408+instance PostBuild t m => PostBuild t (HydrationDomBuilderT t m) where
1381 {-# INLINABLE getPostBuild #-}
1409 {-# INLINABLE getPostBuild #-}
1382 getPostBuild = lift getPostBuild
1410 getPostBuild = lift getPostBuild
1384−instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationDomBuilderT' env state t m) where
1412+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationDomBuilderT t m) where
1385 {-# INLINABLE newEventWithTrigger #-}
1413 {-# INLINABLE newEventWithTrigger #-}
1386 newEventWithTrigger = lift . newEventWithTrigger
1414 newEventWithTrigger = lift . newEventWithTrigger
1387 {-# INLINABLE newFanEventWithTrigger #-}
1415 {-# INLINABLE newFanEventWithTrigger #-}
1388 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
1416 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
1418+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where
1419+ {-# INLINABLE newEventWithTrigger #-}
1420+ newEventWithTrigger = lift . newEventWithTrigger
1421+ {-# INLINABLE newFanEventWithTrigger #-}
1422+ newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
1390−instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (HydrationDomBuilderT' env state t m) where
1424+instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (HydrationDomBuilderT t m) where
1391 {-# INLINABLE newTriggerEvent #-}
1425 {-# INLINABLE newTriggerEvent #-}
1392 newTriggerEvent = HydrationDomBuilderT . lift . lift $ newTriggerEvent
1426 newTriggerEvent = HydrationDomBuilderT . lift . lift $ newTriggerEvent
1393 {-# INLINABLE newTriggerEventWithOnComplete #-}
1427 {-# INLINABLE newTriggerEventWithOnComplete #-}
@@ -1395,12 +1429,20 @@ instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) =>
1395 {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
1429 {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
1396 newEventWithLazyTriggerWithOnComplete f = HydrationDomBuilderT . lift . lift $ newEventWithLazyTriggerWithOnComplete f
1430 newEventWithLazyTriggerWithOnComplete f = HydrationDomBuilderT . lift . lift $ newEventWithLazyTriggerWithOnComplete f
1432+instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (DomRenderHookT t m) where
1433+ {-# INLINABLE newTriggerEvent #-}
1434+ newTriggerEvent = DomRenderHookT . lift $ newTriggerEvent
1435+ {-# INLINABLE newTriggerEventWithOnComplete #-}
1436+ newTriggerEventWithOnComplete = DomRenderHookT . lift $ newTriggerEventWithOnComplete
1437+ {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
1438+ newEventWithLazyTriggerWithOnComplete f = DomRenderHookT . lift $ newEventWithLazyTriggerWithOnComplete f
1398−instance HasJSContext m => HasJSContext (HydrationDomBuilderT' env state t m) where
1440+instance HasJSContext m => HasJSContext (HydrationDomBuilderT t m) where
1399− type JSContextPhantom (HydrationDomBuilderT' env state t m) = JSContextPhantom m
1441+ type JSContextPhantom (HydrationDomBuilderT t m) = JSContextPhantom m
1400 askJSContext = lift askJSContext
1442 askJSContext = lift askJSContext
1402−instance MonadRef m => MonadRef (HydrationDomBuilderT' env state t m) where
1444+instance MonadRef m => MonadRef (HydrationDomBuilderT t m) where
1403− type Ref (HydrationDomBuilderT' env state t m) = Ref m
1445+ type Ref (HydrationDomBuilderT t m) = Ref m
1404 {-# INLINABLE newRef #-}
1446 {-# INLINABLE newRef #-}
1405 newRef = lift . newRef
1447 newRef = lift . newRef
1406 {-# INLINABLE readRef #-}
1448 {-# INLINABLE readRef #-}
@@ -1408,12 +1450,12 @@ instance MonadRef m => MonadRef (HydrationDomBuilderT' env state t m) where
1408 {-# INLINABLE writeRef #-}
1450 {-# INLINABLE writeRef #-}
1409 writeRef r = lift . writeRef r
1451 writeRef r = lift . writeRef r
1411−instance MonadAtomicRef m => MonadAtomicRef (HydrationDomBuilderT' env state t m) where
1453+instance MonadAtomicRef m => MonadAtomicRef (HydrationDomBuilderT t m) where
1412 {-# INLINABLE atomicModifyRef #-}
1454 {-# INLINABLE atomicModifyRef #-}
1413 atomicModifyRef r = lift . atomicModifyRef r
1455 atomicModifyRef r = lift . atomicModifyRef r
1415−instance (HasJS x m, ReflexHost t) => HasJS x (HydrationDomBuilderT' env state t m) where
1457+instance (HasJS x m, ReflexHost t) => HasJS x (HydrationDomBuilderT t m) where
1416− type JSX (HydrationDomBuilderT' env state t m) = JSX m
1458+ type JSX (HydrationDomBuilderT t m) = JSX m
1417 liftJS = lift . liftJS
1459 liftJS = lift . liftJS
1419{-# INLINABLE wrapDomEvent #-}
1461{-# INLINABLE wrapDomEvent #-}
@@ -1433,11 +1475,11 @@ subscribeDomEvent elementOnevent getValue eventChan et = elementOnevent $ do
1433 etr <- newIORef $ Just et
1475 etr <- newIORef $ Just et
1434 writeChan eventChan [EventTriggerRef etr :=> TriggerInvocation v (return ())]
1476 writeChan eventChan [EventTriggerRef etr :=> TriggerInvocation v (return ())]
1436−instance MonadSample t m => MonadSample t (HydrationDomBuilderT' env state t m) where
1478+instance MonadSample t m => MonadSample t (HydrationDomBuilderT t m) where
1437 {-# INLINABLE sample #-}
1479 {-# INLINABLE sample #-}
1438 sample = lift . sample
1480 sample = lift . sample
1440−instance MonadHold t m => MonadHold t (HydrationDomBuilderT' env state t m) where
1482+instance MonadHold t m => MonadHold t (HydrationDomBuilderT t m) where
1441 {-# INLINABLE hold #-}
1483 {-# INLINABLE hold #-}
1442 hold v0 v' = lift $ hold v0 v'
1484 hold v0 v' = lift $ hold v0 v'
1443 {-# INLINABLE holdDyn #-}
1485 {-# INLINABLE holdDyn #-}