@@ -189,11 +189,11 @@ addHydrationStepWithSetup setup f = getHydrationMode >>= \case
189189 HydrationDomBuilderT $ modify' (>> f s)
190190
191191-- | Add a hydration step
192−addHydrationStep :: (MonadIO m, Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m)) => HydrationRunnerT t m () -> HydrationDomBuilderT t m ()
192+addHydrationStep
193+ :: (MonadIO m, Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
194+ => HydrationRunnerT t m () -> HydrationDomBuilderT t m ()
193195addHydrationStep m = getHydrationMode >>= \case
194− HydrationMode_Immediate -> do
195− events <- askEvents
196− lift $ runHydrationRunnerT m Nothing undefined events
196+ HydrationMode_Immediate -> lift . runHydrationRunnerT m Nothing undefined =<< askEvents
197197 HydrationMode_Hydrating -> HydrationDomBuilderT $ modify' (>> m)
198198
199199-- | A monad for DomBuilder which just gets the results of children and pushes
@@ -893,7 +893,7 @@ instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjus
893893 traverseDMapWithKeyWithAdjust f m = DomRenderHookT . traverseDMapWithKeyWithAdjust (\k -> unDomRenderHookT . f k) m
894894 traverseDMapWithKeyWithAdjustWithMove f m = DomRenderHookT . traverseDMapWithKeyWithAdjustWithMove (\k -> unDomRenderHookT . f k) m
895895
896−instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, Ref m ~ IORef, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadRef m) => Adjustable t (HydrationDomBuilderT t m) where
896+instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m) => Adjustable t (HydrationDomBuilderT t m) where
897897 {-# INLINABLE runWithReplace #-}
898898 runWithReplace a0 a' = do
899899 initialEnv <- HydrationDomBuilderT ask
@@ -983,15 +983,15 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
983983 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'
984984 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
985985 traverseDMapWithKeyWithAdjustWithMove = do
986− let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do
987− let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState k))) a)
986+ let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose (TraverseDMapChild t m k) v')) old = do
987+ let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseDMapChild t m k) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState k))) a)
988988 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case
989− PatchDMapWithMove.From_Insert (Compose (_, _, _, sRef, _)) -> do
990− readIORef sRef >>= \case
989+ PatchDMapWithMove.From_Insert (Compose (TraverseDMapChild (Right myTypeImmediate) _)) -> do
990+ readIORef (_traverseDMapChildImmediate_childReadyState myTypeImmediate) >>= \case
991991 ChildReadyState_Ready -> return PatchDMapWithMove.From_Delete
992992 ChildReadyState_Unready _ -> do
993− writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k
994− return $ PatchDMapWithMove.From_Insert $ Constant sRef
993+ writeIORef (_traverseDMapChildImmediate_childReadyState myTypeImmediate) $ ChildReadyState_Unready $ Just $ Some.This k
994+ return $ PatchDMapWithMove.From_Insert $ Constant (_traverseDMapChildImmediate_childReadyState myTypeImmediate)
995995 PatchDMapWithMove.From_Delete -> return PatchDMapWithMove.From_Delete
996996 PatchDMapWithMove.From_Move fromKey -> return $ PatchDMapWithMove.From_Move fromKey
997997 deleteOrMove :: forall a. k a -> Product (Constant (IORef (ChildReadyState k))) (ComposeMaybe k) a -> IO (Constant () a)
@@ -1001,11 +1001,10 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
10011001 p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p
10021002 _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old
10031003 return $ applyAlways p' old
1004− hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholderRef (p_ :: PatchDMapWithMove k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) -> do
1004+ hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholder (p_ :: PatchDMapWithMove k (Compose (TraverseDMapChild t m k) v')) -> do
10051005 let p = unPatchDMapWithMove p_
10061006 phsBefore <- liftIO $ readIORef placeholders
1007− lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
1008− let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
1007+ let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseDMapChild t m k) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
10091008 collectIfMoved k e = do
10101009 let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before
10111010 nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore
@@ -1016,13 +1015,14 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
10161015 True -> do
10171016 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder
10181017 collected <- DMap.traverseWithKey collectIfMoved p
1019− let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (\(Compose (_, _, ph, _, _)) -> ph) p_) phsBefore --TODO: Don't recompute this
1020− let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> JSM (Constant () a)
1018+ let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (_traverseDMapChildImmediate_placeholder . error "FIXME" . _traverseDMapChild_mode . getCompose) p_) phsBefore --TODO: Don't recompute this
1019+ let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseDMapChild t m k) v') a -> JSM (Constant () a)
10211020 placeFragment k e = do
10221021 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter
10231022 case PatchDMapWithMove._nodeInfo_from e of
1024− PatchDMapWithMove.From_Insert (Compose (_, df, _, _, _)) -> do
1025− df `insertBefore` nextPlaceholder
1023+ PatchDMapWithMove.From_Insert (Compose (TraverseDMapChild x _)) -> case x of
1024+ Left _ -> pure ()
1025+ Right immediate -> _traverseDMapChildImmediate_fragment immediate `insertBefore` nextPlaceholder
10261026 PatchDMapWithMove.From_Delete -> do
10271027 return ()
10281028 PatchDMapWithMove.From_Move fromKey -> do
@@ -1034,40 +1034,54 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM
10341034
10351035{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}
10361036traverseDMapWithKeyWithAdjust'
1037− :: forall t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadIO m, MonadJSM m, PrimMonad m, DMap.GCompare k)
1037+ :: forall t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, PrimMonad m, DMap.GCompare k)
10381038 => (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))
10391039 -> DMap k v
10401040 -> Event t (PatchDMap k v)
10411041 -> HydrationDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))
10421042traverseDMapWithKeyWithAdjust' = do
1043− let updateChildUnreadiness (p :: PatchDMap k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do
1044− let new :: forall a. k a -> ComposeMaybe (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState k))) a)
1043+ let updateChildUnreadiness (p :: PatchDMap k (Compose (TraverseDMapChild t m k) v')) old = do
1044+ let new :: forall a. k a -> ComposeMaybe (Compose (TraverseDMapChild t m k) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState k))) a)
10451045 new k (ComposeMaybe m) = ComposeMaybe <$> case m of
10461046 Nothing -> return Nothing
1047− Just (Compose (_, _, _, sRef, _)) -> do
1048− readIORef sRef >>= \case
1047+ Just (Compose (TraverseDMapChild (Left hydration) _)) -> pure Nothing
1048+ Just (Compose (TraverseDMapChild (Right immediate) _)) -> do
1049+ readIORef (_traverseDMapChildImmediate_childReadyState immediate) >>= \case
10491050 ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready
10501051 ChildReadyState_Unready _ -> do
1051− writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k
1052− return $ Just $ Constant sRef
1052+ writeIORef (_traverseDMapChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ Some.This k
1053+ return $ Just $ Constant (_traverseDMapChildImmediate_childReadyState immediate)
10531054 delete _ (Constant sRef) = do
10541055 writeIORef sRef $ ChildReadyState_Unready Nothing
10551056 return $ Constant ()
10561057 p' <- fmap PatchDMap $ DMap.traverseWithKey new $ unPatchDMap p
10571058 _ <- DMap.traverseWithKey delete $ PatchDMap.getDeletions p old
10581059 return $ applyAlways p' old
1059− hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap updateChildUnreadiness $ \placeholders lastPlaceholderRef (PatchDMap p) -> do
1060+ hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap updateChildUnreadiness $ \placeholders lastPlaceholder (PatchDMap patch) -> do
10601061 phs <- liftIO $ readIORef placeholders
1061− forM_ (DMap.toList p) $ \(k :=> ComposeMaybe mv) -> do
1062− lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
1062+ forM_ (DMap.toList patch) $ \(k :=> ComposeMaybe mv) -> do
10631063 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phs
1064− forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder
1065− forM_ mv $ \(Compose (_, df, _, _, _)) -> df `insertBefore` nextPlaceholder
1066− liftIO $ writeIORef placeholders $! fromMaybe phs $ apply (weakenPatchDMapWith (\(Compose (_, _, ph, _, _)) -> ph) $ PatchDMap p) phs
1064+ -- Delete old node
1065+ forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> do
1066+ thisPlaceholder `deleteUpTo` nextPlaceholder
1067+ -- Insert new node
1068+ forM_ mv $ \(Compose (TraverseDMapChild e _)) -> case e of
1069+ Left _hydration -> pure ()
1070+ Right immediate -> do
1071+ _traverseDMapChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1072+ let weakened :: PatchMap (Some.Some k) (Either (TraverseDMapChildHydration t m) (TraverseDMapChildImmediate k))
1073+ weakened = weakenPatchDMapWith (_traverseDMapChild_mode . getCompose) $ PatchDMap patch
1074+ filtered :: PatchMap (Some.Some k) DOM.Text
1075+ filtered = PatchMap $ flip Map.mapMaybe (unPatchMap weakened) $ \case
1076+ Nothing -> Just Nothing -- deletion
1077+ Just (Left _) -> Nothing
1078+ Just (Right immediate) -> Just $ Just $ _traverseDMapChildImmediate_placeholder immediate
1079+ a = apply filtered phs
1080+ liftIO $ writeIORef placeholders $! fromMaybe phs a
10671081
10681082{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
10691083traverseIntMapWithKeyWithAdjust'
1070− :: forall t m v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadIO m, MonadJSM m, PrimMonad m)
1084+ :: forall t m v v'. (Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m, MonadHold t m)
10711085 => (IntMap.Key -> v -> HydrationDomBuilderT t m v')
10721086 -> IntMap v
10731087 -> Event t (PatchIntMap v)
@@ -1101,14 +1115,13 @@ traverseIntMapWithKeyWithAdjust' = do
11011115{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}
11021116hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
11031117 ( Adjustable t m
1104− , MonadIO m
1118+ , MonadHold t m
11051119 , MonadJSM m
11061120 , MonadFix m
11071121 , PrimMonad m
11081122 , Monoid (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
11091123 , Functor p
11101124 , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
1111− , MonadHold t m
11121125 , Patch (p (HydrationRunnerT t m ()))
11131126 )
11141127 => ( (IntMap.Key -> v -> DomRenderHookT t m (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
@@ -1123,7 +1136,6 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
11231136 -> Event t (p v)
11241137 -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
11251138hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1126− (_hydrateStart, _, key) <- skipToReplaceStart
11271139 initialEnv <- HydrationDomBuilderT ask
11281140 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
11291141 pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
@@ -1190,7 +1202,6 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
11901202 getHydrationMode >>= \case
11911203 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0
11921204 _ -> pure ()
1193− (_hydrateEnd, _lastPlaceholderRef) <- skipToReplaceEnd key
11941205 requestDomAction_ $ ffor children' $ \p -> do
11951206 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
11961207 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
@@ -1207,6 +1218,24 @@ insertAfterPreviousNode node = do
12071218 Node.insertBefore_ parent node nextNode
12081219 setPreviousNode $ Just $ toNode node
12091220
1221+data TraverseDMapChildImmediate k = TraverseDMapChildImmediate
1222+ { _traverseDMapChildImmediate_fragment :: DOM.DocumentFragment
1223+ -- ^ Child is appended to this fragment
1224+ , _traverseDMapChildImmediate_placeholder :: DOM.Text
1225+ -- ^ Placeholder reference
1226+ , _traverseDMapChildImmediate_childReadyState :: IORef (ChildReadyState k)
1227+ }
1228+
1229+newtype TraverseDMapChildHydration t m = TraverseDMapChildHydration
1230+ { _traverseDMapChildHydration_delayed :: HydrationRunnerT t m DOM.Text
1231+ -- ^ Action to run at switchover, returns the placeholder
1232+ }
1233+
1234+data TraverseDMapChild t m k a = TraverseDMapChild
1235+ { _traverseDMapChild_mode :: Either (TraverseDMapChildHydration t m) (TraverseDMapChildImmediate k)
1236+ , _traverseDMapChild_result :: a
1237+ }
1238+
12101239{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
12111240hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
12121241 ( Adjustable t m
@@ -1217,35 +1246,39 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
12171246 , PrimMonad m
12181247 , MonadFix m
12191248 , Patch (p k v)
1220− , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
1221− , Patch (p k (Const (HydrationRunnerT t m ())))
1222− , PatchTarget (p k (Const (HydrationRunnerT t m ()))) ~ DMap k (Const (HydrationRunnerT t m ()))
1223− , Monoid (p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))
12241249 , Patch (p k (Constant Int))
1250+ , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
1251+ , Patch (p k (Compose (TraverseDMapChild t m k) v'))
1252+ , PatchTarget (p k (Compose (TraverseDMapChild t m k) v')) ~ DMap k (Compose (TraverseDMapChild t m k) v')
1253+ , Monoid (p k (Compose (TraverseDMapChild t m k) v'))
12251254 )
12261255 => (forall vv vv'.
12271256 (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
12281257 -> DMap k vv
12291258 -> Event t (p k vv)
12301259 -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
1231− ) -- ^ The base monad's traversal
1232− -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type
1233− -> (p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k))))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1234− -> (IORef (Map.Map (Some.Some k) DOM.Text) -> IORef DOM.Text -> p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> JSM ()) -- ^ Apply a patch to the DOM
1260+ )
1261+ -- ^ The base monad's traversal
1262+ -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv')
1263+ -- ^ A way of mapping over the patch type
1264+ -> (p k (Compose (TraverseDMapChild t m k) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k)))))
1265+ -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1266+ -> (IORef (Map.Map (Some.Some k) DOM.Text) -> DOM.Text -> p k (Compose (TraverseDMapChild t m k) v') -> JSM ())
1267+ -- ^ Apply a patch to the DOM
12351268 -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))
12361269 -> DMap k v
12371270 -> Event t (p k v)
12381271 -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))
12391272hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ (f :: forall a. k a -> v a -> HydrationDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do
1240−-- (hydrateStart, _, key) <- skipToReplaceStart -- TODO
1273+ doc <- askDocument
12411274 initialEnv <- HydrationDomBuilderT ask
12421275 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1243− pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) <- liftIO $ newIORef mempty
1276+ pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose (TraverseDMapChild t m k) v')) <- liftIO $ newIORef mempty
12441277 haveEverBeenReady <- liftIO $ newIORef False
1245− placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"
1246− lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"
1278+ placeholders <- liftIO $ newIORef Map.empty
1279+ lastPlaceholder <- createTextNode doc ("" :: Text)
12471280 let applyDomUpdate p = do
1248− applyDomUpdate_ placeholders lastPlaceholderRef p
1281+ applyDomUpdate_ placeholders lastPlaceholder p
12491282 markSelfReady
12501283 liftIO $ writeIORef pendingChange $! mempty
12511284 markSelfReady = do
@@ -1272,38 +1305,36 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
12721305 liftIO $ writeIORef pendingChange (newUnready, p)
12731306 when (DMap.null newUnready) $ do
12741307 applyDomUpdate p
1275− (children0, children') <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'
1276− let processChild k (Compose (_, _, _, sRef, _)) = ComposeMaybe <$> do
1277− readIORef sRef >>= \case
1278− ChildReadyState_Ready -> return Nothing
1279− ChildReadyState_Unready _ -> do
1280− writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k
1281− return $ Just $ Constant sRef
1308+ (children0 :: DMap k (Compose (TraverseDMapChild t m k) v'), children' :: Event t (p k (Compose (TraverseDMapChild t m k) v')))
1309+ <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'
1310+ let processChild k (Compose (TraverseDMapChild e _)) = case e of
1311+ Left _ -> pure $ ComposeMaybe Nothing
1312+ Right immediate -> ComposeMaybe <$> do
1313+ readIORef (_traverseDMapChildImmediate_childReadyState immediate) >>= \case
1314+ ChildReadyState_Ready -> return Nothing
1315+ ChildReadyState_Unready _ -> do
1316+ writeIORef (_traverseDMapChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ Some.This k
1317+ return $ Just $ Constant (_traverseDMapChildImmediate_childReadyState immediate)
12821318 initialUnready <- liftIO $ DMap.mapMaybeWithKey (\_ -> getComposeMaybe) <$> DMap.traverseWithKey processChild children0
12831319 liftIO $ if DMap.null initialUnready
12841320 then writeIORef haveEverBeenReady True
12851321 else do
12861322 modifyIORef' parentUnreadyChildren succ
12871323 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
1288− let result0 = DMap.map (\(Compose (_, _, _, _, v)) -> v) children0
1289− placeholders0 = weakenDMapWith (\(Compose (_, _, ph, _, _)) -> ph) children0
1290− delayed0 :: DMap k (Const (HydrationRunnerT t m ()))
1291− delayed0 = DMap.map (\(Compose (delayed, _, _, _, _)) -> Const delayed) children0
1292− delayed' :: Event t (p k (Const (HydrationRunnerT t m ())))
1293− delayed' = ffor children' $ mapPatch $ \(Compose (d, _, _, _, _)) -> Const d
1294− result' = ffor children' $ mapPatch $ \(Compose (_, _, _, _, r)) -> r
1295− doc <- askDocument
1296− let setFinalPlaceholder = do
1297− ph <- createTextNode doc ("" :: Text)
1298− insertAfterPreviousNode ph
1299− liftIO $ writeIORef lastPlaceholderRef ph
1300− addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do
1301− _ <- join $ sample (traverse (\(_ :=> Const d) -> d) . DMap.toList <$> delayed)
1302− setFinalPlaceholder
1303− liftIO $ writeIORef placeholders $! placeholders0
13041324 getHydrationMode >>= \case
1305− HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (_, df, _, _, _)) -> Constant () <$ append (toNode df)) children0
1306− _ -> pure ()
1325+ HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do
1326+ dm :: DMap k (Compose (TraverseDMapChild t m k) v') <- sample $ currentIncremental children
1327+ phs <- traverse id $ weakenDMapWith (either _traverseDMapChildHydration_delayed (pure . _traverseDMapChildImmediate_placeholder) . _traverseDMapChild_mode . getCompose) dm
1328+ liftIO $ writeIORef placeholders $! phs
1329+ insertAfterPreviousNode lastPlaceholder
1330+ HydrationMode_Immediate -> do
1331+ let activate i = do
1332+ append $ toNode $ _traverseDMapChildImmediate_fragment i
1333+ pure $ _traverseDMapChildImmediate_placeholder i
1334+ phs <- traverse id $ weakenDMapWith ((either (error "delayed") activate) . _traverseDMapChild_mode . getCompose) children0
1335+ liftIO $ writeIORef placeholders $! phs
1336+ append $ toNode lastPlaceholder
1337+
13071338 requestDomAction_ $ ffor children' $ \p -> do
13081339 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
13091340 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
@@ -1311,6 +1342,8 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
13111342 liftIO $ writeIORef pendingChange (newUnready, newP)
13121343 when (DMap.null newUnready) $ do
13131344 applyDomUpdate newP
1345+ let result0 = DMap.map (_traverseDMapChild_result . getCompose) children0
1346+ result' = ffor children' $ mapPatch $ _traverseDMapChild_result . getCompose
13141347 return (result0, result')
13151348
13161349{-# INLINABLE drawChildUpdate #-}
@@ -1318,35 +1351,47 @@ drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)
13181351 => HydrationDomBuilderEnv t
13191352 -> (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
13201353 -> HydrationDomBuilderT t m (v' a)
1321− -> DomRenderHookT t m (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)
1322−drawChildUpdate initialEnv markReady child = do
1323− childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
1324− let doc = _hydrationDomBuilderEnv_document initialEnv
1325− unreadyChildren <- liftIO $ newIORef 0
1326− hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv
1327− placeholder <- createTextNode doc ("" :: Text)
1328− (p, delayed) <- case hydrationMode of
1329− HydrationMode_Hydrating -> pure
1330− ( Left $ _hydrationDomBuilderEnv_parent initialEnv
1331− , insertAfterPreviousNode placeholder
1332− )
1333− HydrationMode_Immediate -> do
1334− df <- createDocumentFragment doc
1335− Node.appendChild_ df placeholder
1336− pure (Right df, pure ())
1337− p' <- either pure (liftIO . newIORef . toNode) p
1338− (result, finalState) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1339− { _hydrationDomBuilderEnv_parent = p'
1340− , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1341− , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1354+ -> DomRenderHookT t m (Compose (TraverseDMapChild t m k) v' a)
1355+drawChildUpdate initialEnv markReady child = liftIO (readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv) >>= \case
1356+ HydrationMode_Hydrating -> do
1357+ let doc = _hydrationDomBuilderEnv_document initialEnv
1358+ unreadyChildren <- liftIO $ newIORef 0
1359+ (result, childDelayed) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1360+ { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1361+ }
1362+ let delayed = do
1363+ placeholder <- createTextNode doc ("" :: Text)
1364+ insertAfterPreviousNode placeholder
1365+ pure placeholder
1366+ return $ Compose $ TraverseDMapChild
1367+ { _traverseDMapChild_result = result
1368+ , _traverseDMapChild_mode = Left TraverseDMapChildHydration
1369+ { _traverseDMapChildHydration_delayed = delayed <* childDelayed
13421370 }
1343− u <- liftIO $ readIORef unreadyChildren
1344− when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
1345− return $ Compose
1346− ( delayed >> finalState
1347− , either (const $ error "drawChildUpdate: Tried to use document fragment in hydration mode") id p
1348− , placeholder, childReadyState, result
1349− )
1371+ }
1372+ HydrationMode_Immediate -> do
1373+ childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
1374+ let doc = _hydrationDomBuilderEnv_document initialEnv
1375+ unreadyChildren <- liftIO $ newIORef 0
1376+ df <- createDocumentFragment doc
1377+ placeholder <- createTextNode doc ("" :: Text)
1378+ Node.appendChild_ df placeholder
1379+ parentRef <- liftIO . newIORef $ toNode df
1380+ (result, _s) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1381+ { _hydrationDomBuilderEnv_parent = parentRef
1382+ , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1383+ , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1384+ }
1385+ u <- liftIO $ readIORef unreadyChildren
1386+ when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
1387+ return $ Compose $ TraverseDMapChild
1388+ { _traverseDMapChild_result = result
1389+ , _traverseDMapChild_mode = Right TraverseDMapChildImmediate
1390+ { _traverseDMapChildImmediate_fragment = df
1391+ , _traverseDMapChildImmediate_placeholder = placeholder
1392+ , _traverseDMapChildImmediate_childReadyState = childReadyState
1393+ }
1394+ }
13501395
13511396{-# INLINABLE drawChildUpdateInt #-}
13521397drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)