@@ -124,10 +124,11 @@ import Data.Some (Some)
124124import qualified Data.Some as Some
125125import Data.Text (Text)
126126import qualified Data.Text as T
127+import Data.Typeable (Typeable, typeRep)
127128import GHC.Generics (Generic)
128129import qualified GHCJS.DOM as DOM
129130import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
130−import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS)
131+import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute, hasAttributeNS)
131132import qualified GHCJS.DOM.Element as Element
132133import qualified GHCJS.DOM.Event as Event
133134import qualified GHCJS.DOM.GlobalEventHandlers as Events
@@ -303,20 +304,20 @@ getHydrationMode = do
303304
304305{-# INLINABLE textNodeInternal #-}
305306textNodeInternal :: (MonadJSM m, ToDOMString contents) => contents -> HydrationDomBuilderT t m DOM.Text
306−textNodeInternal !t = makeNodeInternal (askDocument >>= \doc -> liftJSM $ createTextNode doc t) DOM.Text
307+textNodeInternal !t = makeNodeInternal (const $ pure True) (askDocument >>= \doc -> liftJSM $ createTextNode doc t) DOM.Text
307308
308309{-# INLINABLE commentNodeInternal #-}
309310commentNodeInternal :: (MonadJSM m, ToDOMString contents) => contents -> HydrationDomBuilderT t m DOM.Comment
310−commentNodeInternal !t = makeNodeInternal (askDocument >>= \doc -> liftJSM $ createComment doc t) DOM.Comment
311+commentNodeInternal !t = makeNodeInternal (const $ pure True) (askDocument >>= \doc -> liftJSM $ createComment doc t) DOM.Comment
311312
312313{-# INLINABLE makeNodeInternal #-}
313−makeNodeInternal :: (MonadJSM m, IsNode node) => HydrationDomBuilderT t m node -> (DOM.JSVal -> node) -> HydrationDomBuilderT t m node
314−makeNodeInternal mkNode constructor = do
314+makeNodeInternal :: (MonadJSM m, IsNode node, Typeable node) => (node -> HydrationDomBuilderT t m Bool) -> HydrationDomBuilderT t m node -> (DOM.JSVal -> node) -> HydrationDomBuilderT t m node
315+makeNodeInternal check mkNode constructor = do
315316 doc <- askDocument
316317 parent <- askParent
317318 getHydrationMode >>= \case
318319 HydrationMode_Immediate -> do
319− liftIO $ print $ "Not in hydration mode, creating node"
320+ liftIO $ putStrLn $ "Not in hydration mode, creating node: " <> show (typeRep constructor)
320321 n <- mkNode
321322 append $ toNode n
322323 return n
@@ -329,9 +330,13 @@ makeNodeInternal mkNode constructor = do
329330 Nothing -> do
330331 liftIO $ putStrLn $ "Wrong node type, skipping"
331332 go (Just node)
332− Just tn -> do
333− liftIO $ print $ "Using existing node"
334− return tn
333+ Just tn -> check tn >>= \case
334+ True -> do
335+ liftIO $ putStrLn $ "Using existing node"
336+ return tn
337+ False -> do
338+ liftIO $ putStrLn $ "Node failed check, skipping"
339+ go (Just node)
335340 n <- go lastHydrationNode
336341 liftIO $ modifyIORef' lastHydrationNodeRef (\_ -> Just $ toNode n)
337342 return n
@@ -445,7 +450,6 @@ wrap events e cfg = do
445450makeElement :: 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)
446451makeElement elementTag cfg child = do
447452 doc <- askDocument
448− parent <- askParent
449453 let buildElement = do
450454 e <- uncheckedCastTo DOM.Element <$> case cfg ^. namespace of
451455 Nothing -> createElement doc elementTag
@@ -454,8 +458,12 @@ makeElement elementTag cfg child = do
454458 Nothing -> setAttribute e n v
455459 Just ans -> setAttributeNS e (Just ans) n v
456460 pure e
461+ ssrAttr = "ssr" :: DOM.JSString
462+ hasSSRAttribute e = case cfg ^. namespace of
463+ Nothing -> hasAttribute e ssrAttr -- TODO: disabled for debugging <* removeAttribute e ssrAttr
464+ Just ns -> hasAttributeNS e (Just ns) ssrAttr -- TODO: disabled for debugging <* removeAttributeNS e (Just ns) ssrAttr
457465 -- TODO: prerender needs completely replacing
458− e <- makeNodeInternal buildElement DOM.Element
466+ e <- makeNodeInternal hasSSRAttribute buildElement DOM.Element
459467 -- Run the child builder with updated parent and previous sibling references
460468 childNode <- liftIO $ newIORef Nothing
461469 result <- localEnv (\env -> env { _hydrationDomBuilderEnv_parent = toNode e, _hydrationDomBuilderEnv_hydrationNode = childNode }) child
@@ -467,7 +475,7 @@ makeElement elementTag cfg child = do
467475 liftIO $ fire es
468476 hydrationResultRef <- HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_hydrationResult
469477 liftIO $ modifyIORef' hydrationResultRef (beh :)
470− collapsed <- switchHold never $ ffor ese $ \es -> DMap.singleton (WrapArg Click) . Identity <$> (select es (WrapArg Click))
478+ collapsed <- switchHold never $ ffor ese $ \es -> DMap.singleton (WrapArg Click) . Identity <$> (select es (WrapArg Click)) -- TODO! this can't stay here, obviously.
471479 let evts = fan collapsed
472480 return ((Element evts (), result), e)
473481
@@ -649,7 +657,7 @@ instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomB
649657 liftIO $ writeIORef (_hydrationDomFragment_state childFragment) $ FragmentState_Mounted (before, after)
650658 liftIO $ writeIORef (_hydrationDomFragment_state fragment) $ FragmentState_Mounted (before, after)
651659
652−skipToCommentId :: MonadJSM m => Text -> HydrationDomBuilderT t m (DOM.Comment, Text)
660+skipToCommentId :: MonadJSM m => Text -> HydrationDomBuilderT t m (DOM.Node, Text)
653661skipToCommentId prefix = do
654662 doc <- askDocument
655663 parent <- askParent
@@ -672,20 +680,27 @@ skipToCommentId prefix = do
672680 go (Just node)
673681 (a, key) <- go lastHydrationNode
674682 liftIO $ modifyIORef' lastHydrationNodeRef (\_ -> Just $ toNode a)
675− pure (a, key)
683+ pure (toNode a, key)
676684
677−skipToReplaceStart :: MonadJSM m => HydrationDomBuilderT t m (DOM.Comment, Text)
685+skipToReplaceStart :: MonadJSM m => HydrationDomBuilderT t m (DOM.Node, Text)
678686skipToReplaceStart = skipToCommentId "replace-start"
679687
680−skipToReplaceEnd :: MonadJSM m => Text -> HydrationDomBuilderT t m DOM.Comment
688+skipToReplaceEnd :: MonadJSM m => Text -> HydrationDomBuilderT t m DOM.Node
681689skipToReplaceEnd key = fmap fst $ skipToCommentId $ "replace-end" <> key
682690
683691instance (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
684692 {-# INLINABLE runWithReplace #-}
685693 runWithReplace a0 a' = do
694+ liftIO $ putStrLn "In runWithReplace"
686695 initialEnv <- HydrationDomBuilderT ask
687− (before, beforeKey) <- skipToReplaceStart
688696 let hydrating = _hydrationDomBuilderEnv_hydrationMode initialEnv
697+ initialHydrationMode <- liftIO $ readIORef hydrating
698+ (before, beforeKey) <- case initialHydrationMode of
699+ HydrationMode_Hydrating -> skipToReplaceStart
700+ HydrationMode_Immediate -> do
701+ t <- textNodeInternal ("" :: Text)
702+ append $ toNode t
703+ pure (toNode t, "")
689704 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
690705 haveEverBeenReady <- liftIO $ newIORef False
691706 currentCohort <- liftIO $ newIORef (-1 :: Int) -- Equal to the cohort currently in the DOM
@@ -701,7 +716,12 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
701716 -- We draw 'after' in this roundabout way to avoid using MonadFix
702717 doc <- askDocument
703718 parent <- askParent
704− after <- skipToReplaceEnd beforeKey
719+ after <- case initialHydrationMode of
720+ HydrationMode_Hydrating -> skipToReplaceEnd beforeKey
721+ HydrationMode_Immediate -> do
722+ t <- textNodeInternal ("" :: Text)
723+ append $ toNode t
724+ pure (toNode t)
705725 let drawInitialChild = do
706726 liftIO $ putStrLn "drawInitialChild"
707727 df <- createDocumentFragment doc
@@ -726,6 +746,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
726746 df <- createDocumentFragment doc
727747 unreadyChildren <- liftIO $ newIORef 0
728748 let commitAction = do
749+ liftIO $ putStrLn "Committing runWithReplace update"
729750 c <- liftIO $ readIORef currentCohort
730751 when (c <= cohortId) $ do -- If a newer cohort has already been committed, just ignore this
731752 deleteBetweenExclusive before after
@@ -743,7 +764,9 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
743764 uc <- liftIO $ readIORef unreadyChildren
744765 result <- case h of
745766 HydrationMode_Hydrating -> pure Nothing
746− HydrationMode_Immediate -> Just <$> child'
767+ HydrationMode_Immediate -> do
768+ liftIO $ putStrLn "Running child in immediate mode"
769+ Just <$> child'
747770 let commitActionToRunNow = if uc == 0
748771 then Just $ commitAction
749772 else Nothing -- A child will run it when unreadyChildren is decremented to 0