git.iko.soy/reflex-dom
on develop help sign in
Refactor checkpoint
41f3cc2Tom Smalley
reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+413−221
compare with develop
unifiedsplit
@@ -3,7 +3,10 @@
3{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DataKinds #-}
5{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE DefaultSignatures #-}
6+{-# LANGUAGE DeriveFoldable #-}
7+{-# LANGUAGE DeriveFunctor #-}
6{-# LANGUAGE DeriveGeneric #-}
8{-# LANGUAGE DeriveGeneric #-}
9+{-# LANGUAGE DeriveTraversable #-}
7{-# LANGUAGE EmptyDataDecls #-}
10{-# LANGUAGE EmptyDataDecls #-}
8{-# LANGUAGE FlexibleContexts #-}
11{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleInstances #-}
12{-# LANGUAGE FlexibleInstances #-}
@@ -31,7 +34,13 @@ module Reflex.Dom.Builder.Hydration
31 ( EventTriggerRef (..)
34 ( EventTriggerRef (..)
32 , HydrationDomBuilderEnv (..)
35 , HydrationDomBuilderEnv (..)
33 , HydrationDomBuilderT (..)
36 , HydrationDomBuilderT (..)
37+ , HydrationDomBuilderT' (..)
38+ , HydrationDomBuilderState (..)
34 , HydrationMode (..)
39 , HydrationMode (..)
40+ , HydrationRunnerT (..)
41+ , DOM(..), runDOMForest
42+ , HydrationRunnerEnv (..)
43+ , HydrationRunnerState (..)
35 , runHydrationDomBuilderT
44 , runHydrationDomBuilderT
36 , askParent
45 , askParent
37 , askEvents
46 , askEvents
@@ -113,6 +122,7 @@ import Data.Default
113import Data.Dependent.Map (DMap)
122import Data.Dependent.Map (DMap)
114import qualified Data.Dependent.Map as DMap
123import qualified Data.Dependent.Map as DMap
115import Data.Dependent.Sum
124import Data.Dependent.Sum
125+import Data.Foldable (foldl')
116import Data.Functor.Compose
126import Data.Functor.Compose
117import Data.Functor.Constant
127import Data.Functor.Constant
118import Data.Functor.Misc
128import Data.Functor.Misc
@@ -125,7 +135,7 @@ import Data.Some (Some)
125import qualified Data.Some as Some
135import qualified Data.Some as Some
126import Data.Text (Text)
136import Data.Text (Text)
127import qualified Data.Text as T
137import qualified Data.Text as T
128−import Data.Typeable (Typeable, typeRep)
138+import Data.Typeable (Typeable, typeRep, Proxy(..))
129import GHC.Generics (Generic)
139import GHC.Generics (Generic)
130import qualified GHCJS.DOM as DOM
140import qualified GHCJS.DOM as DOM
131import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
141import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
@@ -170,7 +180,7 @@ import Foreign.JavaScript.Internal.Utils
170#ifndef ghcjs_HOST_OS
180#ifndef ghcjs_HOST_OS
171import GHCJS.DOM.Types (MonadJSM (..))
181import GHCJS.DOM.Types (MonadJSM (..))
172
182
173−instance MonadJSM m => MonadJSM (HydrationDomBuilderT t m) where
183+instance MonadJSM m => MonadJSM (HydrationDomBuilderT' env state t m) where
174 liftJSM' = HydrationDomBuilderT . liftJSM'
184 liftJSM' = HydrationDomBuilderT . liftJSM'
175#endif
185#endif
176
186
@@ -200,39 +210,84 @@ instance DomSpace HydrationDomSpace where
200 in DMap.alter f' en $ _ghcjsEventSpec_filters es
210 in DMap.alter f' en $ _ghcjsEventSpec_filters es
201 }
211 }
202
212
203−data HydrationDomBuilderEnv t m
213+data HydrationDomBuilderEnv t m = HydrationDomBuilderEnv
204− = HydrationDomBuilderEnv { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
214+ { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
205− , _hydrationDomBuilderEnv_parent :: {-# UNPACK #-} !Node
215+ , _hydrationDomBuilderEnv_parent :: {-# UNPACK #-} !(IORef Node)
206− , _hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word) -- Number of children who still aren't fully rendered
216+ , _hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word) -- Number of children who still aren't fully rendered
207− , _hydrationDomBuilderEnv_commitAction :: !(JSM ()) -- Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
217+ , _hydrationDomBuilderEnv_commitAction :: !(JSM ()) -- Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
208− , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode) -- In hydration mode?
218+ , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode) -- In hydration mode?
209− , _hydrationDomBuilderEnv_prerenderDepth :: {-# UNPACK #-} !(IORef Word)
219+ , _hydrationDomBuilderEnv_prerenderDepth :: {-# UNPACK #-} !(IORef Word)
210− , _hydrationDomBuilderEnv_eventChan :: {-# UNPACK #-} !(Chan [DSum (EventTriggerRef t) TriggerInvocation])
211− }
212−
213−data HydrationState t m = HydrationState
214− { _hydrationState_actions :: [Behavior t (m ())]
215− , _hydrationState_previousNode :: {-# UNPACK #-} !(Maybe Node)
216 }
220 }
217
221
222+data HydrationRunnerEnv = HydrationRunnerEnv
223+ { _hydrationRunnerEnv_document :: {-# UNPACK #-} !Document
224+ , _hydrationRunnerEnv_parent :: {-# UNPACK #-} !Node
225+ , _hydrationRunnerEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word) -- Number of children who still aren't fully rendered
226+ , _hydrationRunnerEnv_commitAction :: !(JSM ()) -- Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
227+ }
228+
229+--newtype Forest a = Forest { unForest :: [DOM a] } deriving (Functor, Foldable, Traversable)
230+data DOM t m
231+ = DOM_Element (HydrationRunnerT t m Node) [DOM t m]
232+ -- ^ Nodes with children, the action returns the node for the children to use as a parent
233+ | DOM_Node (HydrationRunnerT t m ())
234+ -- ^ Nodes without children
235+ | DOM_Replace (Behavior t [DOM t m])
236+ -- ^ runWithReplace content changes over time
237+
238+runDOMForest
239+ :: (Ref m ~ IORef, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, DOM.MonadJSM m, DOM.MonadJSM (Performable m), MonadRef m, MonadSample t m)
240+ => [DOM t m]
241+ -> HydrationRunnerT t m ()
242+runDOMForest = foldl' (\acc d -> runDOMTree d >> acc) (pure ())
243+
244+runDOMTree
245+ :: (Ref m ~ IORef, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, DOM.MonadJSM m, DOM.MonadJSM (Performable m), MonadRef m, MonadSample t m)
246+ => DOM t m -> HydrationRunnerT t m ()
247+runDOMTree = \case
248+ DOM_Node m -> m
249+ DOM_Element m children -> m >>= \p -> localEnv (\_ -> HydrationRunnerState Nothing) (\e -> e { _hydrationRunnerEnv_parent = p }) $ runDOMForest children
250+ DOM_Replace b -> runDOMForest =<< sample b
251+
252+data HydrationDomBuilderState t m = HydrationDomBuilderState
253+ { _hydrationDomBuilderState_delayed :: [DOM t m]
254+ }
255+
256+-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events
257+type HydrationRunnerT t m a = HydrationDomBuilderT' HydrationRunnerEnv HydrationRunnerState t m a
258+
259+data HydrationRunnerState = HydrationRunnerState
260+ { _hydrationRunnerState_previousNode :: {-# UNPACK #-} !(Maybe Node)
261+ }
262+
218−addAction :: Monad m => Behavior t (m ()) -> HydrationDomBuilderT t m ()
263+addAction :: Monad m => DOM t m -> HydrationDomBuilderT t m ()
219−addAction a = HydrationDomBuilderT $ modify $ \(HydrationState as n) -> HydrationState (a : as) n
264+addAction a = HydrationDomBuilderT $ modify $ \(HydrationDomBuilderState as) -> HydrationDomBuilderState (a : as)
265+
266+-- TODO probably can separate these two monads entirely, they have grown apart
267+-- over the course of refactoring
220
268
269+-- | A monad for DomBuilder which just gets the results of children and pushes
270+-- work into an action that is delayed until after postBuild (to match the
271+-- static builder). The action runs in 'HydrationRunnerT', which performs the
272+-- DOM takeover and sets up the events, after which point this monad will
273+-- continue in the vein of 'ImmediateDomBuilderT'.
274+type HydrationDomBuilderT t m a = HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m a
275+
221−newtype HydrationDomBuilderT t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT (HydrationDomBuilderEnv t m) (StateT (HydrationState t m) (RequesterT t JSM Identity (TriggerEventT t m))) a }
276+newtype HydrationDomBuilderT' env state t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT env (StateT state (RequesterT t JSM Identity (TriggerEventT t m))) a }
222 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
277 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
223#if MIN_VERSION_base(4,9,1)
278#if MIN_VERSION_base(4,9,1)
224 , MonadAsyncException
279 , MonadAsyncException
225#endif
280#endif
226 )
281 )
227
282
228−instance PrimMonad m => PrimMonad (HydrationDomBuilderT x m) where
283+instance PrimMonad m => PrimMonad (HydrationDomBuilderT' env state x m) where
229− type PrimState (HydrationDomBuilderT x m) = PrimState m
284+ type PrimState (HydrationDomBuilderT' env state x m) = PrimState m
230 primitive = lift . primitive
285 primitive = lift . primitive
231
286
232−instance MonadTrans (HydrationDomBuilderT t) where
287+instance MonadTrans (HydrationDomBuilderT' env state t) where
233 lift = HydrationDomBuilderT . lift . lift . lift . lift
288 lift = HydrationDomBuilderT . lift . lift . lift . lift
234
289
235−instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationDomBuilderT t m) where
290+instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationDomBuilderT' env state t m) where
236 withRenderHook hook (HydrationDomBuilderT a) = do
291 withRenderHook hook (HydrationDomBuilderT a) = do
237 e <- HydrationDomBuilderT ask
292 e <- HydrationDomBuilderT ask
238 s <- HydrationDomBuilderT get
293 s <- HydrationDomBuilderT get
@@ -241,8 +296,8 @@ instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationDomBuilderT t m) wh
241 return (ffor req $ \rm -> hook $ traverseRequesterData (\r -> Identity <$> r) rm, x)
296 return (ffor req $ \rm -> hook $ traverseRequesterData (\r -> Identity <$> r) rm, x)
242 HydrationDomBuilderT $ put s'
297 HydrationDomBuilderT $ put s'
243 pure a
298 pure a
244− requestDomAction = HydrationDomBuilderT . lift . requestingIdentity
299+ requestDomAction = HydrationDomBuilderT . lift . lift . requestingIdentity
245− requestDomAction_ = HydrationDomBuilderT . lift . requesting_
300+ requestDomAction_ = HydrationDomBuilderT . lift . lift . requesting_
246
301
247{-# INLINABLE runHydrationDomBuilderT #-}
302{-# INLINABLE runHydrationDomBuilderT #-}
248runHydrationDomBuilderT
303runHydrationDomBuilderT
@@ -254,51 +309,44 @@ runHydrationDomBuilderT
254 , MonadRef m
309 , MonadRef m
255 , Ref m ~ IORef
310 , Ref m ~ IORef
256 )
311 )
257− => HydrationDomBuilderT t m a
312+ => HydrationDomBuilderT' env state t m a
258− -> HydrationDomBuilderEnv t m
313+ -> env
259− -> Maybe Node
314+ -> state
260− -> m (a, [Behavior t (m ())])
315+ -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
316+ -> m (a, state)
261−runHydrationDomBuilderT (HydrationDomBuilderT a) env prev = do
317+runHydrationDomBuilderT (HydrationDomBuilderT a) env st events = do
262− (a, hs) <- flip runTriggerEventT (_hydrationDomBuilderEnv_eventChan env) $ do
318+ flip runTriggerEventT events $ do
263− rec (result, req) <- runRequesterT (runStateT (runReaderT a env) (HydrationState [] prev)) rsp
319+ rec (result, req) <- runRequesterT (runStateT (runReaderT a env) st) rsp
264 rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame f $
320 rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame f $
265 traverseRequesterData (\r -> Identity <$> r) rm
321 traverseRequesterData (\r -> Identity <$> r) rm
266 return result
322 return result
267− return (a, _hydrationState_actions hs)
268 where
323 where
269 runInAnimationFrame f x = void . DOM.inAnimationFrame' $ \_ -> do
324 runInAnimationFrame f x = void . DOM.inAnimationFrame' $ \_ -> do
270 v <- synchronously x
325 v <- synchronously x
271 void . liftIO $ f v
326 void . liftIO $ f v
272
327
273−instance Monad m => HasDocument (HydrationDomBuilderT t m) where
328+instance Monad m => HasDocument (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) where
274 {-# INLINABLE askDocument #-}
329 {-# INLINABLE askDocument #-}
275− askDocument = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document
330+ askDocument = askDocumentEnv
276
331
277−{-# INLINABLE askParent #-}
332+class HasDocEnv env where
278−askParent :: Monad m => HydrationDomBuilderT t m Node
333+ askDocumentEnv :: Monad m => HydrationDomBuilderT' env state t m DOM.Document
279−askParent = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_parent
280
334
281−{-# INLINABLE askEvents #-}
335+instance HasDocEnv (HydrationDomBuilderEnv t m) where
282−askEvents :: Monad m => HydrationDomBuilderT t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
336+ askDocumentEnv = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document
283−askEvents = HydrationDomBuilderT . lift . lift . lift $ TriggerEventT.askEvents
337+
338+instance HasDocEnv HydrationRunnerEnv where
339+ askDocumentEnv = HydrationDomBuilderT $ asks _hydrationRunnerEnv_document
284
340
285{-# INLINABLE localEnv #-}
341{-# INLINABLE localEnv #-}
286−localEnv :: Monad m => (HydrationState t m -> HydrationState t m) -> (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m) -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m a
342+localEnv :: Monad m => (s -> s) -> (e -> e) -> HydrationDomBuilderT' e s t m a -> HydrationDomBuilderT' e s t m a
287localEnv f g (HydrationDomBuilderT m) = HydrationDomBuilderT $ do
343localEnv f g (HydrationDomBuilderT m) = HydrationDomBuilderT $ do
288 env <- ask
344 env <- ask
289 hs <- get
345 hs <- get
290 lift $ lift $ evalStateT (runReaderT m $ g env) (f hs)
346 lift $ lift $ evalStateT (runReaderT m $ g env) (f hs)
291
347
292−{-# INLINABLE getPreviousNode #-}
293−getPreviousNode :: Monad m => HydrationDomBuilderT t m (Maybe DOM.Node)
294−getPreviousNode = HydrationDomBuilderT $ gets _hydrationState_previousNode
295−
296−{-# INLINABLE setPreviousNode #-}
297−setPreviousNode :: Monad m => Maybe DOM.Node -> HydrationDomBuilderT t m ()
298−setPreviousNode n = HydrationDomBuilderT $ modify $ \hs -> hs { _hydrationState_previousNode = n }
299−
300{-# INLINABLE append #-}
348{-# INLINABLE append #-}
301−append :: MonadJSM m => DOM.Node -> HydrationDomBuilderT t m ()
349+append :: (MonadJSM m, HasParent env) => DOM.Node -> HydrationDomBuilderT' env state t m ()
302append n = do
350append n = do
303 p <- askParent
351 p <- askParent
304 appendChild_ p n
352 appendChild_ p n
@@ -309,51 +357,96 @@ data HydrationMode
309 | HydrationMode_Immediate
357 | HydrationMode_Immediate
310 deriving (Eq, Ord, Show)
358 deriving (Eq, Ord, Show)
311
359
312−{-# INLINABLE getHydrationMode #-}
360+class HasParent env where
313−getHydrationMode :: MonadIO m => HydrationDomBuilderT t m HydrationMode
361+ askParent :: (Monad m, MonadIO m) => HydrationDomBuilderT' env state t m DOM.Node
314−getHydrationMode = liftIO . readIORef =<< HydrationDomBuilderT (asks _hydrationDomBuilderEnv_hydrationMode)
315
362
363+instance HasParent (HydrationDomBuilderEnv t m) where
364+ {-# INLINABLE askParent #-}
365+ askParent = liftIO . readIORef =<< HydrationDomBuilderT (asks _hydrationDomBuilderEnv_parent)
366+
367+instance HasParent HydrationRunnerEnv where
316−{-# INLINABLE textNodeInternal #-}
368+ {-# INLINABLE askParent #-}
317−textNodeInternal :: (MonadJSM m, ToDOMString contents) => contents -> HydrationDomBuilderT t m DOM.Text
369+ askParent = HydrationDomBuilderT $ asks _hydrationRunnerEnv_parent
318−textNodeInternal !t = makeNodeInternal (const $ pure True) (askDocument >>= \doc -> createTextNode doc t) DOM.Text
370+
371+class HasUnreadyChildren env where
372+ askUnreadyChildren :: Monad m => HydrationDomBuilderT' env state t m (IORef Word)
373+ askCommitAction :: Monad m => HydrationDomBuilderT' env state t m (JSM ())
374+
375+instance HasUnreadyChildren (HydrationDomBuilderEnv t m) where
376+ {-# INLINABLE askUnreadyChildren #-}
377+ askUnreadyChildren = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_unreadyChildren
378+ {-# INLINABLE askCommitAction #-}
379+ askCommitAction = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_commitAction
380+
381+instance HasUnreadyChildren HydrationRunnerEnv where
382+ {-# INLINABLE askUnreadyChildren #-}
383+ askUnreadyChildren = HydrationDomBuilderT $ asks _hydrationRunnerEnv_unreadyChildren
384+ {-# INLINABLE askCommitAction #-}
385+ askCommitAction = HydrationDomBuilderT $ asks _hydrationRunnerEnv_commitAction
386+
387+
388+class HasPreviousNode state where
389+ getPreviousNode :: Monad m => HydrationDomBuilderT' env state t m (Maybe DOM.Node)
390+ setPreviousNode :: Monad m => Maybe DOM.Node -> HydrationDomBuilderT' env state t m ()
391+
392+instance HasPreviousNode HydrationRunnerState where
393+ {-# INLINABLE getPreviousNode #-}
394+ getPreviousNode = HydrationDomBuilderT $ gets _hydrationRunnerState_previousNode
395+ {-# INLINABLE setPreviousNode #-}
396+ setPreviousNode n = HydrationDomBuilderT $ modify $ \hs -> hs { _hydrationRunnerState_previousNode = n }
397+
398+class HasHydrationMode env where
399+ getHydrationMode :: MonadIO m => HydrationDomBuilderT' env state t m HydrationMode
400+
401+instance HasHydrationMode (HydrationDomBuilderEnv t m) where
402+ {-# INLINABLE getHydrationMode #-}
403+ getHydrationMode = liftIO . readIORef =<< HydrationDomBuilderT (asks _hydrationDomBuilderEnv_hydrationMode)
404+
405+{-# INLINABLE askEvents #-}
406+askEvents :: Monad m => HydrationDomBuilderT' env state t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
407+askEvents = HydrationDomBuilderT . lift . lift . lift $ TriggerEventT.askEvents
319
408
320−{-# INLINABLE commentNodeInternal #-}
321−commentNodeInternal :: (MonadJSM m, ToDOMString contents) => contents -> HydrationDomBuilderT t m DOM.Comment
322−commentNodeInternal !t = makeNodeInternal (const $ pure True) (askDocument >>= \doc -> createComment doc t) DOM.Comment
323
409
324{-# INLINABLE makeNodeInternal #-}
410{-# INLINABLE makeNodeInternal #-}
411+makeNodeInternal
412+ :: forall node env state t m. (MonadJSM m, IsNode node, Typeable node, HasParent env)
413+ => HydrationDomBuilderT' env state t m node -> HydrationDomBuilderT' env state t m node
414+makeNodeInternal mkNode = do
415+ liftIO $ putStr $ show (typeRep (Proxy :: Proxy node)) <> ": "
416+ liftIO $ putStrLn $ "Not in hydration mode, creating node"
417+ n <- mkNode
418+ append $ toNode n
419+ return n
420+
421+{-# INLINABLE hydrateNode #-}
325−-- | This function, in hydration mode, expects the existing DOM at the current
422+-- | This function expects the existing DOM at the current hydration node to be
326−-- hydration node to be correct. It skips any nodes that are the wrong type, or
423+-- correct. It skips any nodes that are the wrong type, or that fail the
327−-- that fail the @check@. The previous node reference is also updated.
424+-- @check@. The previous node reference is also updated.
425+hydrateNode
426+ :: (MonadJSM m, IsNode node, Typeable node, HasPreviousNode state, HasParent env)
328−makeNodeInternal :: (MonadJSM m, IsNode node, Typeable node) => (node -> HydrationDomBuilderT t m Bool) -> HydrationDomBuilderT t m node -> (DOM.JSVal -> node) -> HydrationDomBuilderT t m node
427+ => (node -> HydrationDomBuilderT' env state t m Bool) -> HydrationDomBuilderT' env state t m node -> (DOM.JSVal -> node) -> HydrationDomBuilderT' env state t m node
329−makeNodeInternal check mkNode constructor = do
428+hydrateNode check mkNode constructor = do
330− doc <- askDocument
331 parent <- askParent
429 parent <- askParent
332 liftIO $ putStr $ show (typeRep constructor) <> ": "
430 liftIO $ putStr $ show (typeRep constructor) <> ": "
333− getHydrationMode >>= \case
334− HydrationMode_Immediate -> do
335− liftIO $ putStrLn $ "Not in hydration mode, creating node"
336− n <- mkNode
337− append $ toNode n
338− return n
339− HydrationMode_Hydrating -> do
340− lastHydrationNode <- getPreviousNode
431+ lastHydrationNode <- getPreviousNode
341− let go mLastNode = do
432+ let go mLastNode = do
342− node <- maybe (Node.getFirstChildUnchecked parent) Node.getNextSiblingUnchecked mLastNode
433+ node <- maybe (Node.getFirstChildUnchecked parent) Node.getNextSiblingUnchecked mLastNode
343− DOM.castTo constructor node >>= \case
434+ DOM.castTo constructor node >>= \case
344− Nothing -> do
435+ Nothing -> do
345− liftIO $ putStrLn $ "Wrong node type, skipping"
436+ liftIO $ putStr $ "Wrong node type, skipping... "
346− go (Just node)
437+ go (Just node)
347− Just tn -> check tn >>= \case
438+ Just tn -> check tn >>= \case
348− True -> do
439+ True -> do
349− liftIO $ putStrLn $ "Using existing node"
440+ liftIO $ putStr $ "Using existing node... "
350− return tn
441+ return tn
351− False -> do
442+ False -> do
352− liftIO $ putStrLn $ "Node failed check, skipping"
443+ liftIO $ putStr $ "Node failed check, skipping... "
353− go (Just node)
444+ go (Just node)
354− n <- go lastHydrationNode
445+ n <- go lastHydrationNode
446+ liftIO $ putStrLn ""
355− setPreviousNode $ Just $ toNode n
447+ setPreviousNode $ Just $ toNode n
356− return n
448+ return n
449+
357
450
358-- | s and e must both be children of the same node and s must precede e;
451-- | s and e must both be children of the same node and s must precede e;
359-- all nodes between s and e will be removed, but s and e will not be removed
452-- all nodes between s and e will be removed, but s and e will not be removed
@@ -457,10 +550,16 @@ wrap events e cfg = do
457 return es
550 return es
458
551
459{-# INLINABLE makeElement #-}
552{-# INLINABLE makeElement #-}
553+makeElement
460−makeElement :: forall er t m a. (MonadJSM m, MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, Adjustable t m, Ref m ~ IORef, PerformEvent t m, MonadJSM (Performable m), MonadRef m) => Text -> ElementConfig er t HydrationDomSpace -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m ((Element er HydrationDomSpace t, a), DOM.Element)
554+ :: forall er t m a. (MonadJSM m, MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, Adjustable t m, Ref m ~ IORef, PerformEvent t m, MonadJSM (Performable m), MonadRef m)
555+ => Text
556+ -> ElementConfig er t HydrationDomSpace
557+ -> HydrationDomBuilderT t m a
558+ -> HydrationDomBuilderT t m ((Element er HydrationDomSpace t, a), DOM.Element)
461makeElement elementTag cfg child = do
559makeElement elementTag cfg child = do
462 doc <- askDocument
560 doc <- askDocument
463− let buildElement = do
561+ let buildElement :: HydrationDomBuilderT' env state t m DOM.Element
562+ buildElement = do
464 e <- uncheckedCastTo DOM.Element <$> case cfg ^. namespace of
563 e <- uncheckedCastTo DOM.Element <$> case cfg ^. namespace of
465 Nothing -> createElement doc elementTag
564 Nothing -> createElement doc elementTag
466 Just ens -> createElementNS doc (Just ens) elementTag
565 Just ens -> createElementNS doc (Just ens) elementTag
@@ -469,52 +568,161 @@ makeElement elementTag cfg child = do
469 Just ans -> setAttributeNS e (Just ans) n v
568 Just ans -> setAttributeNS e (Just ans) n v
470 pure e
569 pure e
471 ssrAttr = "ssr" :: DOM.JSString
570 ssrAttr = "ssr" :: DOM.JSString
571+ hasSSRAttribute :: DOM.Element -> HydrationDomBuilderT' env state t m Bool
472 hasSSRAttribute e = case cfg ^. namespace of
572 hasSSRAttribute e = case cfg ^. namespace of
473 Nothing -> hasAttribute e ssrAttr -- TODO: disabled for debugging <* removeAttribute e ssrAttr
573 Nothing -> hasAttribute e ssrAttr -- TODO: disabled for debugging <* removeAttribute e ssrAttr
474 Just ns -> hasAttributeNS e (Just ns) ssrAttr -- TODO: disabled for debugging <* removeAttributeNS e (Just ns) ssrAttr
574 Just ns -> hasAttributeNS e (Just ns) ssrAttr -- TODO: disabled for debugging <* removeAttributeNS e (Just ns) ssrAttr
575+ getHydrationMode >>= \case
576+ HydrationMode_Immediate -> do
475− -- TODO: prerender needs completely replacing
577+ -- TODO: prerender needs completely replacing
476− e <- makeNodeInternal hasSSRAttribute buildElement DOM.Element
578+ e <- makeNodeInternal buildElement
579+ p <- liftIO $ newIORef $ toNode e
477− -- Run the child builder with updated parent and previous sibling references
580+ -- Run the child builder with updated parent and previous sibling references
478− result <- localEnv (\hs -> hs { _hydrationState_previousNode = Nothing }) (\env -> env { _hydrationDomBuilderEnv_parent = toNode e }) child
581+ result <- localEnv (\hs -> hs) (\env -> env { _hydrationDomBuilderEnv_parent = p }) child
479− events <- askEvents
582+ events <- askEvents
583+ es <- wrap events e $ extractRawElementConfig cfg
584+ return ((Element es (), result), e)
585+ HydrationMode_Hydrating -> do
586+ -- Schedule everything for after postBuild, except for getting the result itself
587+ p <- liftIO $ newIORef $ error "Parent not yet initialized"
480− env <- HydrationDomBuilderT ask
588+ env <- HydrationDomBuilderT ask
589+ let env' = env { _hydrationDomBuilderEnv_parent = p}
590+ hs = HydrationDomBuilderState { _hydrationDomBuilderState_delayed = [] }
591+ (result, hs') <- HydrationDomBuilderT $ lift $ lift $ runStateT (runReaderT (unHydrationDomBuilderT child) env') hs
481− (ese, fire) <- newTriggerEvent
592+ (ese, fire) <- newTriggerEvent
593+ let activateElement = do
594+ e <- hydrateNode hasSSRAttribute buildElement DOM.Element
595+ liftIO $ writeIORef p $ toNode e
596+ events <- askEvents
482− addAction $ pure $ void $ runHydrationDomBuilderT (liftIO . fire <=< wrap events e $ extractRawElementConfig cfg) env Nothing
597+ void $ liftIO . fire <=< wrap events e $ extractRawElementConfig cfg
598+ pure $ toNode e
599+ addAction $ DOM_Element activateElement $ _hydrationDomBuilderState_delayed hs'
600+ -- TODO! vvv this can't stay here, obviously.
483− collapsed <- switchHold never $ ffor ese $ \es -> DMap.singleton (WrapArg Click) . Identity <$> (select es (WrapArg Click)) -- TODO! this can't stay here, obviously.
601+ collapsed <- switchHold never $ ffor ese $ \es -> DMap.singleton (WrapArg Click) . Identity <$> (select es (WrapArg Click))
484− let evts = fan collapsed
602+ return ((Element (fan collapsed) (), result), error "makeElement: DOM.Element")
485− return ((Element evts (), result), e)
603+
486−
604+{-# INLINABLE textNodeInternal #-}
605+textNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Text
606+textNodeInternal !t mSetContents = getHydrationMode >>= \case
607+ HydrationMode_Immediate -> do
608+ n <- makeNodeInternal (askDocumentEnv >>= \doc -> createTextNode doc t)
609+ mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
610+ pure n
611+ HydrationMode_Hydrating -> do
612+ let activateText = do
613+ liftIO $ putStrLn $ "Action: Text: " <> show (DOM.toJSString t)
614+ n <- hydrateNode (const $ pure True) (askDocumentEnv >>= \doc -> createTextNode doc t) DOM.Text
615+ --case mSetContents of
616+ -- Nothing -> liftIO $ putStrLn "No update events for text"
617+ -- Just e -> requestDomAction_ $ setNodeValue n . Just <$> e
618+ mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
619+ addAction $ DOM_Node activateText
620+ pure $ error "textNodeInternal: DOM.Text"
621+
622+{-# INLINABLE commentNodeInternal #-}
623+commentNodeInternal :: (MonadJSM m, MonadFix m, ToDOMString contents, Reflex t) => contents -> Maybe (Event t contents) -> HydrationDomBuilderT t m DOM.Comment
624+commentNodeInternal !t mSetContents = getHydrationMode >>= \case
625+ HydrationMode_Immediate -> do
626+ n <- makeNodeInternal (askDocumentEnv >>= \doc -> createComment doc t)
627+ mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
628+ pure n
629+ HydrationMode_Hydrating -> do
630+ let activateComment = do
631+ liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)
632+ n <- hydrateNode (const $ pure True) (askDocumentEnv >>= \doc -> createComment doc t) DOM.Comment
633+ mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
634+ addAction $ DOM_Node activateComment
635+ pure $ error "commentNodeInternal: DOM.Comment"
636+
637+-- | We leave markers in the static builder as comments, and rip these comments
638+-- out at hydration time, replacing them with empty text nodes.
639+skipToAndReplaceComment :: (MonadJSM m, Reflex t, MonadFix m) => Text -> IORef Text -> HydrationDomBuilderT t m (IORef DOM.Text, IORef Text)
640+skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
641+ HydrationMode_Immediate -> do
642+ -- If we're in immediate mode, we don't try to replace an existing comment,
643+ -- and just return a dummy key
644+ t <- textNodeInternal ("" :: Text) Nothing
645+ append $ toNode t
646+ textNodeRef <- liftIO $ newIORef t
647+ keyRef <- liftIO $ newIORef ""
648+ pure (textNodeRef, keyRef)
649+ HydrationMode_Hydrating -> do
650+ doc <- askDocument
651+ textNodeRef <- liftIO $ newIORef $ error "textNodeRef not yet initialized"
652+ keyRef <- liftIO $ newIORef $ error "keyRef not yet initialized"
653+ let go key0 mLastNode = do
654+ parent <- askParent
655+ node <- maybe (Node.getFirstChildUnchecked parent) Node.getNextSiblingUnchecked mLastNode
656+ DOM.castTo DOM.Comment node >>= \case
657+ Just comment -> do
658+ commentText <- Node.getTextContentUnchecked comment
659+ liftIO $ putStr $ T.unpack $ "[" <> prefix <> "]"
660+ liftIO $ putStr $ T.unpack $ "{" <> commentText <> "}"
661+ case T.stripPrefix (prefix <> key0) commentText of
662+ Just key -> do
663+ -- Replace the comment with an (invisible) text node
664+ textNode <- createTextNode doc ("" :: Text)
665+ liftIO $ putStr "Replacing existing comment..."
666+ Node.replaceChild_ parent textNode comment
667+ pure (textNode, key)
668+ Nothing -> do
669+ liftIO $ putStr "Bad key in comment, skipping... "
670+ go key0 (Just node)
671+ Nothing -> do
672+ liftIO $ putStr "Not a comment, skipping... "
673+ go key0 (Just node)
674+ switchComment = do
675+ key0 <- liftIO $ readIORef key0Ref
676+ liftIO $ putStrLn $ "///////////////////////////////// switchComment " <> T.unpack key0
677+ (textNode, key) <- go key0 =<< getPreviousNode
678+ liftIO $ putStrLn $ T.unpack key
679+ setPreviousNode $ Just $ toNode textNode
680+ liftIO $ do
681+ writeIORef textNodeRef textNode
682+ writeIORef keyRef key
683+ addAction $ DOM_Node switchComment
684+ pure (textNodeRef, keyRef)
685+
686+
687+skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m) => HydrationDomBuilderT t m (IORef DOM.Text, IORef Text)
688+skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")
689+
690+skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m) => IORef Text -> HydrationDomBuilderT t m (IORef DOM.Text)
691+skipToReplaceEnd key = fmap fst $ skipToAndReplaceComment "replace-end" key
692+
487−instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT t m) where
693+instance (HasUnreadyChildren env, SupportsHydrationDomBuilder t m) => NotReady t (HydrationDomBuilderT' env state t m) where
488 notReadyUntil e = do
694 notReadyUntil e = do
489 eOnce <- headE e
695 eOnce <- headE e
490− env <- HydrationDomBuilderT ask
696+ unreadyChildren <- askUnreadyChildren
491− let unreadyChildren = _hydrationDomBuilderEnv_unreadyChildren env
697+ commitAction <- askCommitAction
492 liftIO $ modifyIORef' unreadyChildren succ
698 liftIO $ modifyIORef' unreadyChildren succ
493 let ready = do
699 let ready = do
494 old <- liftIO $ readIORef unreadyChildren
700 old <- liftIO $ readIORef unreadyChildren
495 let new = pred old
701 let new = pred old
496 liftIO $ writeIORef unreadyChildren $! new
702 liftIO $ writeIORef unreadyChildren $! new
497− when (new == 0) $ _hydrationDomBuilderEnv_commitAction env
703+ when (new == 0) commitAction
498 requestDomAction_ $ ready <$ eOnce
704 requestDomAction_ $ ready <$ eOnce
499 notReady = do
705 notReady = do
500 env <- HydrationDomBuilderT ask
706 env <- HydrationDomBuilderT ask
501− let unreadyChildren = _hydrationDomBuilderEnv_unreadyChildren env
707+ unreadyChildren <- askUnreadyChildren
502 liftIO $ modifyIORef' unreadyChildren succ
708 liftIO $ modifyIORef' unreadyChildren succ
503
709
504−instance SupportsHydrationDomBuilder t m => DomBuilder t (HydrationDomBuilderT t m) where
710+instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) where
505− type DomBuilderSpace (HydrationDomBuilderT t m) = HydrationDomSpace
711+ type DomBuilderSpace (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) = HydrationDomSpace
506 {-# INLINABLE textNode #-}
712 {-# INLINABLE textNode #-}
507 textNode (TextNodeConfig initialContents mSetContents) = do
713 textNode (TextNodeConfig initialContents mSetContents) = do
508− n <- textNodeInternal initialContents
714+ liftIO $ putStrLn $ "Text: " <> T.unpack initialContents
509− mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
715+ textNodeInternal initialContents mSetContents
510 return $ TextNode ()
716 return $ TextNode ()
511 {-# INLINABLE commentNode #-}
717 {-# INLINABLE commentNode #-}
512 commentNode (CommentNodeConfig initialContents mSetContents) = do
718 commentNode (CommentNodeConfig initialContents mSetContents) = do
513− n <- commentNodeInternal initialContents
719+ liftIO $ putStrLn $ "Comment: " <> T.unpack initialContents
514− mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
720+ commentNodeInternal initialContents mSetContents
515 return $ CommentNode ()
721 return $ CommentNode ()
516 {-# INLINABLE element #-}
722 {-# INLINABLE element #-}
723+ element elementTag cfg child = do
724+ liftIO $ putStrLn $ "Element: " <> T.unpack elementTag
517− element elementTag cfg child = fst <$> makeElement elementTag cfg child
725+ fst <$> makeElement elementTag cfg child
518 {-# INLINABLE inputElement #-}
726 {-# INLINABLE inputElement #-}
519 inputElement cfg = do
727 inputElement cfg = do
520 ((e, _), domElement) <- makeElement "input" (cfg ^. inputElementConfig_elementConfig) $ return ()
728 ((e, _), domElement) <- makeElement "input" (cfg ^. inputElementConfig_elementConfig) $ return ()
@@ -639,19 +847,20 @@ extractFragment fragment = do
639 extractBetweenExclusive (_hydrationDomFragment_document fragment) before after
847 extractBetweenExclusive (_hydrationDomFragment_document fragment) before after
640 liftIO $ writeIORef (_hydrationDomFragment_state fragment) FragmentState_Unmounted
848 liftIO $ writeIORef (_hydrationDomFragment_state fragment) FragmentState_Unmounted
641
849
642−instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomBuilderT t m) where
850+instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) where
643− type DomFragment (HydrationDomBuilderT t m) = HydrationDomFragment
851+ type DomFragment (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) (HydrationDomBuilderState t m) t m) = HydrationDomFragment
644 buildDomFragment w = do
852 buildDomFragment w = do
645 df <- createDocumentFragment =<< askDocument
853 df <- createDocumentFragment =<< askDocument
854+ p <- liftIO $ newIORef $ toNode df
646− result <- localEnv id (\env -> env { _hydrationDomBuilderEnv_parent = toNode df }) w
855+ result <- localEnv id (\env -> env { _hydrationDomBuilderEnv_parent = p }) w
647 state <- liftIO $ newIORef FragmentState_Unmounted
856 state <- liftIO $ newIORef FragmentState_Unmounted
648 return (HydrationDomFragment df state, result)
857 return (HydrationDomFragment df state, result)
649 mountDomFragment fragment setFragment = do
858 mountDomFragment fragment setFragment = do
650 parent <- askParent
859 parent <- askParent
651 extractFragment fragment
860 extractFragment fragment
652− before <- textNodeInternal ("" :: Text)
861+ before <- textNodeInternal ("" :: Text) Nothing
653 appendChild_ parent $ _hydrationDomFragment_document fragment
862 appendChild_ parent $ _hydrationDomFragment_document fragment
654− after <- textNodeInternal ("" :: Text)
863+ after <- textNodeInternal ("" :: Text) Nothing
655 xs <- foldDyn (\new (previous, _) -> (new, Just previous)) (fragment, Nothing) setFragment
864 xs <- foldDyn (\new (previous, _) -> (new, Just previous)) (fragment, Nothing) setFragment
656 requestDomAction_ $ ffor (updated xs) $ \(childFragment, Just previousFragment) -> do
865 requestDomAction_ $ ffor (updated xs) $ \(childFragment, Just previousFragment) -> do
657 extractFragment previousFragment
866 extractFragment previousFragment
@@ -660,61 +869,14 @@ instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomB
660 liftIO $ writeIORef (_hydrationDomFragment_state childFragment) $ FragmentState_Mounted (before, after)
869 liftIO $ writeIORef (_hydrationDomFragment_state childFragment) $ FragmentState_Mounted (before, after)
661 liftIO $ writeIORef (_hydrationDomFragment_state fragment) $ FragmentState_Mounted (before, after)
870 liftIO $ writeIORef (_hydrationDomFragment_state fragment) $ FragmentState_Mounted (before, after)
662
871
663−-- | We leave markers in the static builder as comments, and rip these comments
664−-- out at hydration time, replacing them with empty text nodes.
665−skipToAndReplaceComment :: MonadJSM m => Text -> HydrationDomBuilderT t m (DOM.Text, Text)
666−skipToAndReplaceComment prefix = getHydrationMode >>= \case
667− HydrationMode_Immediate -> do
668− -- If we're in immediate mode, we don't try to replace an existing comment,
669− -- and just return a dummy key
670− t <- textNodeInternal ("" :: Text)
671− pure (t, "")
672− HydrationMode_Hydrating -> do
673− doc <- askDocument
674− parent <- askParent
675− lastHydrationNode <- getPreviousNode
676− let go mLastNode = do
677− node <- maybe (Node.getFirstChildUnchecked parent) Node.getNextSiblingUnchecked mLastNode
678− DOM.castTo DOM.Comment node >>= \case
679− Just comment -> do
680− commentText <- Node.getTextContentUnchecked comment
681− case T.stripPrefix prefix commentText of
682− Just key -> do
683− -- Replace the comment with an (invisible) text node
684− textNode <- createTextNode doc ("" :: Text)
685− Node.replaceChild_ parent textNode comment
686− pure (textNode, key)
687− Nothing -> do
688− liftIO $ putStrLn $ "Bad key in comment, skipping"
689− go (Just node)
690− Nothing -> do
691− commentText <- Node.getTextContentUnchecked node
692− liftIO $ putStrLn $ "Not a comment, skipping"
693− liftIO $ putStrLn commentText
694− go (Just node)
695− (a, key) <- go lastHydrationNode
696− setPreviousNode $ Just $ toNode a
697− pure (a, key)
698−
699−skipToReplaceStart :: MonadJSM m => HydrationDomBuilderT t m (DOM.Text, Text)
700−skipToReplaceStart = skipToAndReplaceComment "replace-start"
701−
702−skipToReplaceEnd :: MonadJSM m => Text -> HydrationDomBuilderT t m DOM.Text
703−skipToReplaceEnd key = fmap fst $ skipToAndReplaceComment $ "replace-end" <> key
704−
705−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
872+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
706 {-# INLINABLE runWithReplace #-}
873 {-# INLINABLE runWithReplace #-}
707 runWithReplace a0 a' = do
874 runWithReplace a0 a' = do
708 liftIO $ putStrLn "In runWithReplace"
875 liftIO $ putStrLn "In runWithReplace"
709 initialEnv <- HydrationDomBuilderT ask
876 initialEnv <- HydrationDomBuilderT ask
710 let hydrating = _hydrationDomBuilderEnv_hydrationMode initialEnv
877 let hydrating = _hydrationDomBuilderEnv_hydrationMode initialEnv
711 initialHydrationMode <- liftIO $ readIORef hydrating
878 initialHydrationMode <- liftIO $ readIORef hydrating
712− (before, beforeKey) <- case initialHydrationMode of
713− HydrationMode_Hydrating -> skipToReplaceStart
879+ (before, beforeKey) <- skipToReplaceStart
714− HydrationMode_Immediate -> do
715− t <- textNodeInternal ("" :: Text)
716− append $ toNode t
717− pure (t, "")
718 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
880 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
719 haveEverBeenReady <- liftIO $ newIORef False
881 haveEverBeenReady <- liftIO $ newIORef False
720 currentCohort <- liftIO $ newIORef (-1 :: Int) -- Equal to the cohort currently in the DOM
882 currentCohort <- liftIO $ newIORef (-1 :: Int) -- Equal to the cohort currently in the DOM
@@ -730,19 +892,16 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
730 -- We draw 'after' in this roundabout way to avoid using MonadFix
892 -- We draw 'after' in this roundabout way to avoid using MonadFix
731 doc <- askDocument
893 doc <- askDocument
732 parent <- askParent
894 parent <- askParent
733− after <- case initialHydrationMode of
734− HydrationMode_Hydrating -> skipToReplaceEnd beforeKey
895+ after <- skipToReplaceEnd beforeKey
735− HydrationMode_Immediate -> do
896+ -- TODO improve skipToReplace nonsense
736− t <- textNodeInternal ("" :: Text)
897+ addAction $ DOM_Node $ setPreviousNode . Just . toNode =<< liftIO (readIORef before)
737− append $ toNode t
738− pure t
739 let drawInitialChild = do
898 let drawInitialChild = do
740 liftIO $ putStrLn "drawInitialChild"
899 liftIO $ putStrLn "drawInitialChild"
741 p <- liftIO (readIORef hydrating) >>= \case
900 p <- liftIO (readIORef hydrating) >>= \case
742− HydrationMode_Hydrating -> pure parent
901+ HydrationMode_Hydrating -> liftIO $ newIORef parent
743− HydrationMode_Immediate -> toNode <$> createDocumentFragment doc
902+ HydrationMode_Immediate -> liftIO . newIORef . toNode =<< createDocumentFragment doc
744 unreadyChildren <- liftIO $ newIORef 0
903 unreadyChildren <- liftIO $ newIORef 0
745− (result, HydrationState h' _) <- flip runStateT (HydrationState [] Nothing) $ runReaderT (unHydrationDomBuilderT a0) initialEnv
904+ (result, HydrationDomBuilderState h') <- flip runStateT (HydrationDomBuilderState []) $ runReaderT (unHydrationDomBuilderT a0) initialEnv
746 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
905 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
747 , _hydrationDomBuilderEnv_commitAction = myCommitAction
906 , _hydrationDomBuilderEnv_commitAction = myCommitAction
748 , _hydrationDomBuilderEnv_parent = p
907 , _hydrationDomBuilderEnv_parent = p
@@ -754,25 +913,30 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
754 return (h', result)
913 return (h', result)
755 a'' <- numberOccurrences a'
914 a'' <- numberOccurrences a'
756 (result0, evt) <- HydrationDomBuilderT $ lift $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(cohortId, child) -> do
915 (result0, evt) <- HydrationDomBuilderT $ lift $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(cohortId, child) -> do
757− p <- liftIO (readIORef hydrating) >>= \case
916+ h <- liftIO $ readIORef hydrating
917+ p' <- case h of
758 HydrationMode_Hydrating -> pure parent
918 HydrationMode_Hydrating -> pure parent
759 HydrationMode_Immediate -> toNode <$> createDocumentFragment doc
919 HydrationMode_Immediate -> toNode <$> createDocumentFragment doc
920+ p <- liftIO $ newIORef p'
760 unreadyChildren <- liftIO $ newIORef 0
921 unreadyChildren <- liftIO $ newIORef 0
761 let commitAction = do
922 let commitAction = do
762 liftIO $ putStrLn "Committing runWithReplace update"
923 liftIO $ putStrLn "Committing runWithReplace update"
763 c <- liftIO $ readIORef currentCohort
924 c <- liftIO $ readIORef currentCohort
925+ !before' <- liftIO $ readIORef before
926+ !after' <- liftIO $ readIORef after
764 when (c <= cohortId) $ do -- If a newer cohort has already been committed, just ignore this
927 when (c <= cohortId) $ do -- If a newer cohort has already been committed, just ignore this
765− deleteBetweenExclusive before after
928+ deleteBetweenExclusive before' after'
766− insertBefore p after
929+ insertBefore p' after'
767 liftIO $ writeIORef currentCohort cohortId
930 liftIO $ writeIORef currentCohort cohortId
768 myCommitAction
931 myCommitAction
769− (result, HydrationState h' _) <- flip runStateT (HydrationState [] $ Just $ toNode before) $ runReaderT (unHydrationDomBuilderT child) $ initialEnv
932+ (result, HydrationDomBuilderState h') <- flip runStateT (HydrationDomBuilderState []) $ runReaderT (unHydrationDomBuilderT child) $ initialEnv
770 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
933 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
771− , _hydrationDomBuilderEnv_commitAction = commitAction
934+ , _hydrationDomBuilderEnv_commitAction = case h of
935+ HydrationMode_Hydrating -> myCommitAction
936+ HydrationMode_Immediate -> commitAction
772 , _hydrationDomBuilderEnv_parent = p
937 , _hydrationDomBuilderEnv_parent = p
773 }
938 }
774 uc <- liftIO $ readIORef unreadyChildren
939 uc <- liftIO $ readIORef unreadyChildren
775− h <- liftIO $ readIORef hydrating
776 let commitActionToRunNow = if uc == 0
940 let commitActionToRunNow = if uc == 0
777 then Just $ commitAction
941 then Just $ commitAction
778 else Nothing -- A child will run it when unreadyChildren is decremented to 0
942 else Nothing -- A child will run it when unreadyChildren is decremented to 0
@@ -781,9 +945,8 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
781 HydrationMode_Immediate -> Right commitActionToRunNow
945 HydrationMode_Immediate -> Right commitActionToRunNow
782 return (actions, result)
946 return (actions, result)
783 let (hydrationAction, commitAction) = fanEither $ fmap fst evt
947 let (hydrationAction, commitAction) = fanEither $ fmap fst evt
784− f :: [Behavior t (m ())] -> Behavior t (m ())
785− f = fmap (void . sequence) . sequence
786− addAction . join =<< hold (f $ fst result0) (fmap f hydrationAction)
948+ base :: Behavior t [DOM t m] <- hold (fst result0) hydrationAction
949+ addAction $ DOM_Replace base
787 requestDomAction_ $ fmapMaybe id commitAction
950 requestDomAction_ $ fmapMaybe id commitAction
788 return (snd result0, fmap snd evt)
951 return (snd result0, fmap snd evt)
789
952
@@ -925,6 +1088,7 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
925 -> Event t (p v)
1088 -> Event t (p v)
926 -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
1089 -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
927hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1090hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1091+ (_, key) <- skipToReplaceStart
928 initialEnv <- HydrationDomBuilderT ask
1092 initialEnv <- HydrationDomBuilderT ask
929 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1093 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
930 pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
1094 pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
@@ -959,7 +1123,9 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
959 liftIO $ writeIORef pendingChange (newUnready, p)
1123 liftIO $ writeIORef pendingChange (newUnready, p)
960 when (IntMap.null newUnready) $ do
1124 when (IntMap.null newUnready) $ do
961 applyDomUpdate p
1125 applyDomUpdate p
1126+ stateRef <- liftIO . newIORef =<< HydrationDomBuilderT get
962− (children0, children') <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdateInt initialEnv markChildReady $ f k v) dm0 dm'
1127+ (children0, children') <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdateInt stateRef initialEnv markChildReady $ f k v) dm0 dm'
1128+ HydrationDomBuilderT . put =<< liftIO (readIORef stateRef)
963 let processChild k (_, _, sRef, _) = do
1129 let processChild k (_, _, sRef, _) = do
964 readIORef sRef >>= \case
1130 readIORef sRef >>= \case
965 ChildReadyStateInt_Ready -> return Nothing
1131 ChildReadyStateInt_Ready -> return Nothing
@@ -976,8 +1142,10 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
976 placeholders0 = fmap (\(_, ph, _, _) -> ph) children0
1142 placeholders0 = fmap (\(_, ph, _, _) -> ph) children0
977 result' = ffor children' $ fmap $ \(_, _, _, r) -> r
1143 result' = ffor children' $ fmap $ \(_, _, _, r) -> r
978 liftIO $ writeIORef placeholders $! placeholders0
1144 liftIO $ writeIORef placeholders $! placeholders0
1145+ getHydrationMode >>= \case
979− _ <- IntMap.traverseWithKey (\_ (df, _, _, _) -> void $ append $ toNode df) children0
1146+ HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (df, _, _, _) -> void $ append $ toNode df) children0
980− liftIO . writeIORef lastPlaceholderRef =<< textNodeInternal ("" :: Text)
1147+ _ -> pure ()
1148+ lastPlaceholderRef <- skipToReplaceEnd key
981 requestDomAction_ $ ffor children' $ \p -> do
1149 requestDomAction_ $ ffor children' $ \p -> do
982 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1150 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
983 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
1151 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
@@ -1072,7 +1240,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
1072 getHydrationMode >>= \case
1240 getHydrationMode >>= \case
1073 HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (df, _, _, _)) -> Constant () <$ append (toNode df)) children0
1241 HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (df, _, _, _)) -> Constant () <$ append (toNode df)) children0
1074 _ -> pure ()
1242 _ -> pure ()
1075− liftIO . writeIORef lastPlaceholderRef =<< skipToReplaceEnd key
1243+ lastPlaceholderRef <- skipToReplaceEnd key
1076 requestDomAction_ $ ffor children' $ \p -> do
1244 requestDomAction_ $ ffor children' $ \p -> do
1077 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1245 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1078 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
1246 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
@@ -1084,7 +1252,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
1084
1252
1085{-# INLINABLE drawChildUpdate #-}
1253{-# INLINABLE drawChildUpdate #-}
1086drawChildUpdate :: (MonadIO m, MonadJSM m)
1254drawChildUpdate :: (MonadIO m, MonadJSM m)
1087− => IORef (HydrationState t m)
1255+ => IORef (HydrationDomBuilderState t m)
1088 -> HydrationDomBuilderEnv t m
1256 -> HydrationDomBuilderEnv t m
1089 -> (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
1257 -> (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
1090 -> HydrationDomBuilderT t m (v' a)
1258 -> HydrationDomBuilderT t m (v' a)
@@ -1099,43 +1267,64 @@ drawChildUpdate stateRef initialEnv markReady child = do
1099 p <- case hydrationMode of
1267 p <- case hydrationMode of
1100 HydrationMode_Hydrating -> do
1268 HydrationMode_Hydrating -> do
1101 let p = _hydrationDomBuilderEnv_parent initialEnv
1269 let p = _hydrationDomBuilderEnv_parent initialEnv
1270+ p' <- liftIO $ readIORef p
1102− case _hydrationState_previousNode initialState of
1271+-- case _hydrationState_previousNode initialState of
1103− Nothing -> Node.appendChild_ p placeholder
1272+-- Nothing -> Node.appendChild_ p' placeholder
1104− Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ p placeholder
1273+-- Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ p' placeholder
1105 pure (Left p)
1274 pure (Left p)
1106 HydrationMode_Immediate -> do
1275 HydrationMode_Immediate -> do
1107 df <- createDocumentFragment doc
1276 df <- createDocumentFragment doc
1108 Node.appendChild_ df placeholder
1277 Node.appendChild_ df placeholder
1109 pure (Right df)
1278 pure (Right df)
1279+ p' <- either pure (liftIO . newIORef . toNode) p
1110 let env = initialEnv
1280 let env = initialEnv
1111− { _hydrationDomBuilderEnv_parent = either id toNode p
1281+ { _hydrationDomBuilderEnv_parent = p'
1112 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1282 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1113 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1283 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1114 }
1284 }
1115− (result, finalState) <- runStateT (runReaderT (unHydrationDomBuilderT child) env) (initialState { _hydrationState_previousNode = Just $ toNode placeholder })
1285+ (result, finalState) <- runStateT (runReaderT (unHydrationDomBuilderT child) env) initialState-- { _hydrationState_previousNode = Just $ toNode placeholder })
1116 liftIO $ writeIORef stateRef finalState
1286 liftIO $ writeIORef stateRef finalState
1117 u <- liftIO $ readIORef unreadyChildren
1287 u <- liftIO $ readIORef unreadyChildren
1118 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
1288 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
1119− return (Compose (either (const $ error "Tried to use document fragment in hydration mode") id p, placeholder, childReadyState, result))
1289+ return (Compose (either (const $ error "drawChildUpdate: Tried to use document fragment in hydration mode") id p, placeholder, childReadyState, result))
1120
1290
1121{-# INLINABLE drawChildUpdateInt #-}
1291{-# INLINABLE drawChildUpdateInt #-}
1122drawChildUpdateInt :: (MonadIO m, MonadJSM m)
1292drawChildUpdateInt :: (MonadIO m, MonadJSM m)
1293+ => IORef (HydrationDomBuilderState t m)
1123− => HydrationDomBuilderEnv t m
1294+ -> HydrationDomBuilderEnv t m
1124 -> (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
1295 -> (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
1125 -> HydrationDomBuilderT t m v'
1296 -> HydrationDomBuilderT t m v'
1126 -> RequesterT t JSM Identity (TriggerEventT t m) (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')
1297 -> RequesterT t JSM Identity (TriggerEventT t m) (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')
1127−drawChildUpdateInt initialEnv markReady child = do
1298+drawChildUpdateInt stateRef initialEnv markReady child = do
1128 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing
1299 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing
1300+ let doc = _hydrationDomBuilderEnv_document initialEnv
1129 unreadyChildren <- liftIO $ newIORef 0
1301 unreadyChildren <- liftIO $ newIORef 0
1130− df <- createDocumentFragment $ _hydrationDomBuilderEnv_document initialEnv
1302+ hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv
1131− (placeholder, result) <- flip evalStateT (HydrationState [] Nothing) $ runReaderT (unHydrationDomBuilderT $ (,) <$> textNodeInternal ("" :: Text) <*> child) $ initialEnv
1303+ initialState <- liftIO $ readIORef stateRef
1304+ placeholder <- createTextNode doc ("" :: Text)
1305+ p <- case hydrationMode of
1306+ HydrationMode_Hydrating -> do
1307+ let p = _hydrationDomBuilderEnv_parent initialEnv
1308+ p' <- liftIO $ readIORef p
1309+-- case _hydrationState_previousNode initialState of
1310+-- Nothing -> Node.appendChild_ p' placeholder
1311+-- Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ p' placeholder
1312+ pure (Left p)
1313+ HydrationMode_Immediate -> do
1314+ df <- createDocumentFragment doc
1315+ Node.appendChild_ df placeholder
1316+ pure (Right df)
1317+ p' <- either pure (liftIO . newIORef . toNode) p
1318+ let env = initialEnv
1132− { _hydrationDomBuilderEnv_parent = toNode df
1319+ { _hydrationDomBuilderEnv_parent = p'
1133− , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1320+ , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1134− , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1321+ , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1135− }
1322+ }
1323+ (result, finalState) <- runStateT (runReaderT (unHydrationDomBuilderT child) env) initialState --{ _hydrationState_previousNode = Just $ toNode placeholder })
1324+ liftIO $ writeIORef stateRef finalState
1136 u <- liftIO $ readIORef unreadyChildren
1325 u <- liftIO $ readIORef unreadyChildren
1137 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready
1326 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready
1138− return (df, placeholder, childReadyState, result)
1327+ return (either (const $ error "drawChildUpdateInt: Tried to use document fragment in hydration mode") id p, placeholder, childReadyState, result)
1139
1328
1140mkHasFocus :: (MonadHold t m, Reflex t) => Element er d t -> m (Dynamic t Bool)
1329mkHasFocus :: (MonadHold t m, Reflex t) => Element er d t -> m (Dynamic t Bool)
1141mkHasFocus e = do
1330mkHasFocus e = do
@@ -1147,32 +1336,35 @@ mkHasFocus e = do
1147
1336
1148insertAfter :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
1337insertAfter :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
1149insertAfter new existing = do
1338insertAfter new existing = do
1339+ liftIO $ putStrLn "insertAfter"
1150 p <- getParentNodeUnchecked existing
1340 p <- getParentNodeUnchecked existing
1151 Node.getNextSibling existing >>= DOM.insertBefore_ p new
1341 Node.getNextSibling existing >>= DOM.insertBefore_ p new
1152
1342
1153insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
1343insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
1154insertBefore new existing = do
1344insertBefore new existing = do
1345+ liftIO $ putStrLn "insertBefore"
1155 p <- getParentNodeUnchecked existing
1346 p <- getParentNodeUnchecked existing
1347+ liftIO $ putStrLn "insertBefore2"
1156 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
1348 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
1157
1349
1158−instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where
1350+instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT' env state t m) where
1159− type Performable (HydrationDomBuilderT t m) = Performable m
1351+ type Performable (HydrationDomBuilderT' env state t m) = Performable m
1160 {-# INLINABLE performEvent_ #-}
1352 {-# INLINABLE performEvent_ #-}
1161 performEvent_ e = lift $ performEvent_ e
1353 performEvent_ e = lift $ performEvent_ e
1162 {-# INLINABLE performEvent #-}
1354 {-# INLINABLE performEvent #-}
1163 performEvent e = lift $ performEvent e
1355 performEvent e = lift $ performEvent e
1164
1356
1165−instance PostBuild t m => PostBuild t (HydrationDomBuilderT t m) where
1357+instance PostBuild t m => PostBuild t (HydrationDomBuilderT' env state t m) where
1166 {-# INLINABLE getPostBuild #-}
1358 {-# INLINABLE getPostBuild #-}
1167 getPostBuild = lift getPostBuild
1359 getPostBuild = lift getPostBuild
1168
1360
1169−instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationDomBuilderT t m) where
1361+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationDomBuilderT' env state t m) where
1170 {-# INLINABLE newEventWithTrigger #-}
1362 {-# INLINABLE newEventWithTrigger #-}
1171 newEventWithTrigger = lift . newEventWithTrigger
1363 newEventWithTrigger = lift . newEventWithTrigger
1172 {-# INLINABLE newFanEventWithTrigger #-}
1364 {-# INLINABLE newFanEventWithTrigger #-}
1173 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
1365 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
1174
1366
1175−instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (HydrationDomBuilderT t m) where
1367+instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (HydrationDomBuilderT' env state t m) where
1176 {-# INLINABLE newTriggerEvent #-}
1368 {-# INLINABLE newTriggerEvent #-}
1177 newTriggerEvent = HydrationDomBuilderT . lift . lift $ newTriggerEvent
1369 newTriggerEvent = HydrationDomBuilderT . lift . lift $ newTriggerEvent
1178 {-# INLINABLE newTriggerEventWithOnComplete #-}
1370 {-# INLINABLE newTriggerEventWithOnComplete #-}
@@ -1180,12 +1372,12 @@ instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) =>
1180 {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
1372 {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
1181 newEventWithLazyTriggerWithOnComplete f = HydrationDomBuilderT . lift . lift $ newEventWithLazyTriggerWithOnComplete f
1373 newEventWithLazyTriggerWithOnComplete f = HydrationDomBuilderT . lift . lift $ newEventWithLazyTriggerWithOnComplete f
1182
1374
1183−instance HasJSContext m => HasJSContext (HydrationDomBuilderT t m) where
1375+instance HasJSContext m => HasJSContext (HydrationDomBuilderT' env state t m) where
1184− type JSContextPhantom (HydrationDomBuilderT t m) = JSContextPhantom m
1376+ type JSContextPhantom (HydrationDomBuilderT' env state t m) = JSContextPhantom m
1185 askJSContext = lift askJSContext
1377 askJSContext = lift askJSContext
1186
1378
1187−instance MonadRef m => MonadRef (HydrationDomBuilderT t m) where
1379+instance MonadRef m => MonadRef (HydrationDomBuilderT' env state t m) where
1188− type Ref (HydrationDomBuilderT t m) = Ref m
1380+ type Ref (HydrationDomBuilderT' env state t m) = Ref m
1189 {-# INLINABLE newRef #-}
1381 {-# INLINABLE newRef #-}
1190 newRef = lift . newRef
1382 newRef = lift . newRef
1191 {-# INLINABLE readRef #-}
1383 {-# INLINABLE readRef #-}
@@ -1193,12 +1385,12 @@ instance MonadRef m => MonadRef (HydrationDomBuilderT t m) where
1193 {-# INLINABLE writeRef #-}
1385 {-# INLINABLE writeRef #-}
1194 writeRef r = lift . writeRef r
1386 writeRef r = lift . writeRef r
1195
1387
1196−instance MonadAtomicRef m => MonadAtomicRef (HydrationDomBuilderT t m) where
1388+instance MonadAtomicRef m => MonadAtomicRef (HydrationDomBuilderT' env state t m) where
1197 {-# INLINABLE atomicModifyRef #-}
1389 {-# INLINABLE atomicModifyRef #-}
1198 atomicModifyRef r = lift . atomicModifyRef r
1390 atomicModifyRef r = lift . atomicModifyRef r
1199
1391
1200−instance (HasJS x m, ReflexHost t) => HasJS x (HydrationDomBuilderT t m) where
1392+instance (HasJS x m, ReflexHost t) => HasJS x (HydrationDomBuilderT' env state t m) where
1201− type JSX (HydrationDomBuilderT t m) = JSX m
1393+ type JSX (HydrationDomBuilderT' env state t m) = JSX m
1202 liftJS = lift . liftJS
1394 liftJS = lift . liftJS
1203
1395
1204{-# INLINABLE wrapDomEvent #-}
1396{-# INLINABLE wrapDomEvent #-}
@@ -1218,11 +1410,11 @@ subscribeDomEvent elementOnevent getValue eventChan et = elementOnevent $ do
1218 etr <- newIORef $ Just et
1410 etr <- newIORef $ Just et
1219 writeChan eventChan [EventTriggerRef etr :=> TriggerInvocation v (return ())]
1411 writeChan eventChan [EventTriggerRef etr :=> TriggerInvocation v (return ())]
1220
1412
1221−instance MonadSample t m => MonadSample t (HydrationDomBuilderT t m) where
1413+instance MonadSample t m => MonadSample t (HydrationDomBuilderT' env state t m) where
1222 {-# INLINABLE sample #-}
1414 {-# INLINABLE sample #-}
1223 sample = lift . sample
1415 sample = lift . sample
1224
1416
1225−instance MonadHold t m => MonadHold t (HydrationDomBuilderT t m) where
1417+instance MonadHold t m => MonadHold t (HydrationDomBuilderT' env state t m) where
1226 {-# INLINABLE hold #-}
1418 {-# INLINABLE hold #-}
1227 hold v0 v' = lift $ hold v0 v'
1419 hold v0 v' = lift $ hold v0 v'
1228 {-# INLINABLE holdDyn #-}
1420 {-# INLINABLE holdDyn #-}
reflex-dom-core/src/Reflex/Dom/Prerender.hs+1−1
@@ -89,7 +89,7 @@ instance ( HasJS js m
89 , MonadFix m
89 , MonadFix m
90 , MonadFix (Performable m)
90 , MonadFix (Performable m)
91 , ReflexHost t
91 , ReflexHost t
92− ) => Prerender js (HydrationDomBuilderT t m) where
92+ ) => Prerender js (HydrationDomBuilderT' (HydrationDomBuilderEnv t m) state t m) where
93 prerenderClientDict = Just Dict
93 prerenderClientDict = Just Dict
94 startPrerenderBlock = do
94 startPrerenderBlock = do
95 depth <- HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_prerenderDepth
95 depth <- HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_prerenderDepth