@@ -49,7 +49,6 @@ module Reflex.Dom.Builder.Hydration
4949 , traverseDMapWithKeyWithAdjust'
5050 , hoistTraverseWithKeyWithAdjust
5151 , traverseIntMapWithKeyWithAdjust'
52− , hoistTraverseIntMapWithKeyWithAdjust
5352 ) where
5453
5554import Control.Concurrent
@@ -71,6 +70,7 @@ import Data.Functor.Product
7170import Data.IORef
7271import Data.IntMap.Strict (IntMap)
7372import Data.Maybe
73+import Data.Some (Some(..))
7474import Data.Text (Text)
7575import Data.Typeable (Typeable)
7676import Foreign.JavaScript.Internal.Utils
@@ -83,7 +83,7 @@ import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, IsNode, Node, To
8383import Reflex.Adjustable.Class
8484import Reflex.Class as Reflex
8585import Reflex.Dom.Builder.Class
86−import Reflex.Dom.Builder.Immediate hiding (askEvents, askParent, append, wrap, makeElement, textNodeInternal, traverseIntMapWithKeyWithAdjust', traverseDMapWithKeyWithAdjust', hoistTraverseWithKeyWithAdjust, hoistTraverseIntMapWithKeyWithAdjust, drawChildUpdate)
86+import Reflex.Dom.Builder.Immediate hiding (askEvents, askParent, append, wrap, makeElement, textNodeInternal, traverseIntMapWithKeyWithAdjust', traverseDMapWithKeyWithAdjust', hoistTraverseWithKeyWithAdjust, hoistTraverseIntMapWithKeyWithAdjust, drawChildUpdate, ChildReadyState(..))
8787import Reflex.Dynamic
8888import Reflex.Host.Class
8989import Reflex.PerformEvent.Class
@@ -97,7 +97,6 @@ import qualified Data.Dependent.Map as DMap
9797import qualified Data.FastMutableIntMap as FastMutableIntMap
9898import qualified Data.IntMap.Strict as IntMap
9999import qualified Data.Map as Map
100−import qualified Data.Some as Some
101100import qualified Data.Text as T
102101import qualified GHCJS.DOM as DOM
103102import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
@@ -997,31 +996,31 @@ instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m) =>
997996 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'
998997 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
999998 traverseDMapWithKeyWithAdjustWithMove = do
1000− let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose (TraverseDMapChild t m k) v')) old = do
1001− 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)
999+ let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')) old = do
1000+ let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
10021001 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case
1003− PatchDMapWithMove.From_Insert (Compose (TraverseDMapChild (Right myTypeImmediate) _)) -> do
1004− readIORef (_traverseDMapChildImmediate_childReadyState myTypeImmediate) >>= \case
1002+ PatchDMapWithMove.From_Insert (Compose (TraverseChild (Right myTypeImmediate) _)) -> do
1003+ readIORef (_traverseChildImmediate_childReadyState myTypeImmediate) >>= \case
10051004 ChildReadyState_Ready -> return PatchDMapWithMove.From_Delete
10061005 ChildReadyState_Unready _ -> do
1007− writeIORef (_traverseDMapChildImmediate_childReadyState myTypeImmediate) $ ChildReadyState_Unready $ Just $ Some.This k
1008− return $ PatchDMapWithMove.From_Insert $ Constant (_traverseDMapChildImmediate_childReadyState myTypeImmediate)
1006+ writeIORef (_traverseChildImmediate_childReadyState myTypeImmediate) $ ChildReadyState_Unready $ Just $ This k
1007+ return $ PatchDMapWithMove.From_Insert $ Constant (_traverseChildImmediate_childReadyState myTypeImmediate)
10091008 PatchDMapWithMove.From_Delete -> return PatchDMapWithMove.From_Delete
10101009 PatchDMapWithMove.From_Move fromKey -> return $ PatchDMapWithMove.From_Move fromKey
1011− deleteOrMove :: forall a. k a -> Product (Constant (IORef (ChildReadyState k))) (ComposeMaybe k) a -> IO (Constant () a)
1010+ deleteOrMove :: forall a. k a -> Product (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) a -> IO (Constant () a)
10121011 deleteOrMove _ (Pair (Constant sRef) (ComposeMaybe mToKey)) = do
1013− writeIORef sRef $ ChildReadyState_Unready $ Some.This <$> mToKey -- This will be Nothing if deleting, and Just if moving, so it works out in both cases
1012+ writeIORef sRef $ ChildReadyState_Unready $ This <$> mToKey -- This will be Nothing if deleting, and Just if moving, so it works out in both cases
10141013 return $ Constant ()
10151014 p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p
10161015 _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old
10171016 return $ applyAlways p' old
1018− hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholder (p_ :: PatchDMapWithMove k (Compose (TraverseDMapChild t m k) v')) -> do
1017+ hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholder (p_ :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')) -> do
10191018 let p = unPatchDMapWithMove p_
10201019 phsBefore <- liftIO $ readIORef placeholders
1021− let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseDMapChild t m k) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
1020+ let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
10221021 collectIfMoved k e = do
1023− let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before
1024− nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore
1022+ let mThisPlaceholder = Map.lookup (This k) phsBefore -- Will be Nothing if this element wasn't present before
1023+ nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (This k) phsBefore
10251024 case isJust $ getComposeMaybe $ PatchDMapWithMove._nodeInfo_to e of
10261025 False -> do
10271026 mapM_ (`deleteUpTo` nextPlaceholder) mThisPlaceholder
@@ -1029,14 +1028,14 @@ instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m) =>
10291028 True -> do
10301029 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder
10311030 collected <- DMap.traverseWithKey collectIfMoved p
1032− let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (_traverseDMapChildImmediate_placeholder . error "FIXME" . _traverseDMapChild_mode . getCompose) p_) phsBefore --TODO: Don't recompute this
1033− let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseDMapChild t m k) v') a -> JSM (Constant () a)
1031+ let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (_traverseChildImmediate_placeholder . error "FIXME" . _traverseChild_mode . getCompose) p_) phsBefore --TODO: Don't recompute this
1032+ let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant () a)
10341033 placeFragment k e = do
1035− let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter
1034+ let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (This k) phsAfter
10361035 case PatchDMapWithMove._nodeInfo_from e of
1037− PatchDMapWithMove.From_Insert (Compose (TraverseDMapChild x _)) -> case x of
1036+ PatchDMapWithMove.From_Insert (Compose (TraverseChild x _)) -> case x of
10381037 Left _ -> pure ()
1039− Right immediate -> _traverseDMapChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1038+ Right immediate -> _traverseChildImmediate_fragment immediate `insertBefore` nextPlaceholder
10401039 PatchDMapWithMove.From_Delete -> do
10411040 return ()
10421041 PatchDMapWithMove.From_Move fromKey -> do
@@ -1054,17 +1053,17 @@ traverseDMapWithKeyWithAdjust'
10541053 -> Event t (PatchDMap k v)
10551054 -> HydrationDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))
10561055traverseDMapWithKeyWithAdjust' = do
1057− let updateChildUnreadiness (p :: PatchDMap k (Compose (TraverseDMapChild t m k) v')) old = do
1058− let new :: forall a. k a -> ComposeMaybe (Compose (TraverseDMapChild t m k) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState k))) a)
1056+ let updateChildUnreadiness (p :: PatchDMap k (Compose (TraverseChild t m (Some k)) v')) old = do
1057+ let new :: forall a. k a -> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
10591058 new k (ComposeMaybe m) = ComposeMaybe <$> case m of
10601059 Nothing -> return Nothing
1061− Just (Compose (TraverseDMapChild (Left hydration) _)) -> pure Nothing
1062− Just (Compose (TraverseDMapChild (Right immediate) _)) -> do
1063− readIORef (_traverseDMapChildImmediate_childReadyState immediate) >>= \case
1060+ Just (Compose (TraverseChild (Left hydration) _)) -> pure Nothing
1061+ Just (Compose (TraverseChild (Right immediate) _)) -> do
1062+ readIORef (_traverseChildImmediate_childReadyState immediate) >>= \case
10641063 ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready
10651064 ChildReadyState_Unready _ -> do
1066− writeIORef (_traverseDMapChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ Some.This k
1067− return $ Just $ Constant (_traverseDMapChildImmediate_childReadyState immediate)
1065+ writeIORef (_traverseChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ This k
1066+ return $ Just $ Constant (_traverseChildImmediate_childReadyState immediate)
10681067 delete _ (Constant sRef) = do
10691068 writeIORef sRef $ ChildReadyState_Unready Nothing
10701069 return $ Constant ()
@@ -1074,24 +1073,23 @@ traverseDMapWithKeyWithAdjust' = do
10741073 hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap updateChildUnreadiness $ \placeholders lastPlaceholder (PatchDMap patch) -> do
10751074 phs <- liftIO $ readIORef placeholders
10761075 forM_ (DMap.toList patch) $ \(k :=> ComposeMaybe mv) -> do
1077− let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phs
1076+ let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (This k) phs
10781077 -- Delete old node
1079− forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> do
1078+ forM_ (Map.lookup (This k) phs) $ \thisPlaceholder -> do
10801079 thisPlaceholder `deleteUpTo` nextPlaceholder
10811080 -- Insert new node
1082− forM_ mv $ \(Compose (TraverseDMapChild e _)) -> case e of
1081+ forM_ mv $ \(Compose (TraverseChild e _)) -> case e of
10831082 Left _hydration -> pure ()
10841083 Right immediate -> do
1085− _traverseDMapChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1086− let weakened :: PatchMap (Some.Some k) (Either (TraverseDMapChildHydration t m) (TraverseDMapChildImmediate k))
1087− weakened = weakenPatchDMapWith (_traverseDMapChild_mode . getCompose) $ PatchDMap patch
1088− filtered :: PatchMap (Some.Some k) DOM.Text
1084+ _traverseChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1085+ let weakened :: PatchMap (Some k) (Either (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
1086+ weakened = weakenPatchDMapWith (_traverseChild_mode . getCompose) $ PatchDMap patch
1087+ filtered :: PatchMap (Some k) DOM.Text
10891088 filtered = PatchMap $ flip Map.mapMaybe (unPatchMap weakened) $ \case
10901089 Nothing -> Just Nothing -- deletion
10911090 Just (Left _) -> Nothing
1092− Just (Right immediate) -> Just $ Just $ _traverseDMapChildImmediate_placeholder immediate
1093− a = apply filtered phs
1094− liftIO $ writeIORef placeholders $! fromMaybe phs a
1091+ Just (Right immediate) -> Just $ Just $ _traverseChildImmediate_placeholder immediate
1092+ liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered phs
10951093
10961094{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
10971095traverseIntMapWithKeyWithAdjust'
@@ -1101,63 +1099,97 @@ traverseIntMapWithKeyWithAdjust'
11011099 -> Event t (PatchIntMap v)
11021100 -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))
11031101traverseIntMapWithKeyWithAdjust' = do
1104− let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do
1105− let new :: IntMap.Key -> Maybe (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))
1102+ let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (TraverseChild t m Int v')) old = do
1103+ let new :: IntMap.Key -> Maybe (TraverseChild t m Int v') -> IO (Maybe (IORef (ChildReadyState Int)))
11061104 new k m = case m of
11071105 Nothing -> return Nothing
1108− Just (_, _, _, sRef, _) -> do
1106+ Just (TraverseChild (Left _hydration) _) -> pure Nothing
1107+ Just (TraverseChild (Right immediate) _) -> do
1108+ let sRef = _traverseChildImmediate_childReadyState immediate
11091109 readIORef sRef >>= \case
1110− ChildReadyStateInt_Ready -> return Nothing -- Delete this child, since it's ready
1111− ChildReadyStateInt_Unready _ -> do
1112− writeIORef sRef $ ChildReadyStateInt_Unready $ Just k
1110+ ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready
1111+ ChildReadyState_Unready _ -> do
1112+ writeIORef sRef $ ChildReadyState_Unready $ Just k
11131113 return $ Just sRef
11141114 delete _ sRef = do
1115− writeIORef sRef $ ChildReadyStateInt_Unready Nothing
1115+ writeIORef sRef $ ChildReadyState_Unready Nothing
11161116 return ()
11171117 p' <- PatchIntMap <$> IntMap.traverseWithKey new pInner
11181118 _ <- IntMap.traverseWithKey delete $ FastMutableIntMap.getDeletions p old
11191119 return $ applyAlways p' old
1120− hoistTraverseIntMapWithKeyWithAdjust traverseIntMapWithKeyWithAdjust updateChildUnreadiness $ \placeholders lastPlaceholderRef (PatchIntMap p) -> do
1120+ hoistTraverseIntMapWithKeyWithAdjust traverseIntMapWithKeyWithAdjust updateChildUnreadiness $ \placeholders lastPlaceholder (PatchIntMap p) -> do
11211121 phs <- liftIO $ readIORef placeholders
11221122 forM_ (IntMap.toList p) $ \(k, mv) -> do
1123− lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
11241123 let nextPlaceholder = maybe lastPlaceholder snd $ IntMap.lookupGT k phs
1124+ -- Delete old node
11251125 forM_ (IntMap.lookup k phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder
1126− forM_ mv $ \(_, df, _, _, _) -> df `insertBefore` nextPlaceholder
1127− liftIO $ writeIORef placeholders $! fromMaybe phs $ apply ((\(_, _, ph, _, _) -> ph) <$> PatchIntMap p) phs
1126+ -- Insert new node
1127+ forM_ mv $ \(TraverseChild e _) -> case e of
1128+ Left _hydration -> pure ()
1129+ Right immediate -> do
1130+ _traverseChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1131+ let filtered :: PatchIntMap DOM.Text
1132+ filtered = PatchIntMap $ flip IntMap.mapMaybe p $ \case
1133+ Nothing -> Just Nothing -- deletion
1134+ Just tc | Left _ <- _traverseChild_mode tc -> Nothing
1135+ Just tc | Right immediate <- _traverseChild_mode tc -> Just $ Just $ _traverseChildImmediate_placeholder immediate
1136+ liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered phs
1137+
1138+data ChildReadyState a
1139+ = ChildReadyState_Ready
1140+ | ChildReadyState_Unready !(Maybe a)
1141+ deriving (Show, Read, Eq, Ord)
11281142
1129−{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}
1130−hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
1143+insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
1144+insertAfterPreviousNode node = do
1145+ parent <- askParent
1146+ nextNode <- maybe (Node.getFirstChild parent) Node.getNextSibling =<< getPreviousNode
1147+ Node.insertBefore_ parent node nextNode
1148+ setPreviousNode $ Just $ toNode node
1149+
1150+{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
1151+hoistTraverseWithKeyWithAdjust
1152+ ::
11311153 ( Adjustable t m
11321154 , MonadHold t m
1155+ , DMap.GCompare k
1156+ , MonadIO m
11331157 , MonadJSM m
1134− , MonadFix m
11351158 , PrimMonad m
1136− , Monoid (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1137− , Functor p
1138− , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
1139− , Patch (p (HydrationRunnerT t m ()))
1159+ , MonadFix m
1160+ , Patch (p k v)
1161+ , Patch (p k (Constant Int))
1162+ , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
1163+ , Patch (p k (Compose (TraverseChild t m (Some k)) v'))
1164+ , PatchTarget (p k (Compose (TraverseChild t m (Some k)) v')) ~ DMap k (Compose (TraverseChild t m (Some k)) v')
1165+ , Monoid (p k (Compose (TraverseChild t m (Some k)) v'))
11401166 )
1141− => ( (IntMap.Key -> v -> DomRenderHookT t m (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1142− -> IntMap v
1143− -> Event t (p v)
1144− -> DomRenderHookT t m (IntMap (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'), Event t (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')))
1145− ) -- ^ The base monad's traversal
1146− -> (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IntMap (IORef ChildReadyStateInt) -> IO (IntMap (IORef ChildReadyStateInt))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1147− -> (IORef (IntMap DOM.Text) -> IORef DOM.Text -> p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> JSM ()) -- ^ Apply a patch to the DOM
1148− -> (IntMap.Key -> v -> HydrationDomBuilderT t m v')
1149− -> IntMap v
1150− -> Event t (p v)
1151− -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
1152−hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1167+ => (forall vv vv'.
1168+ (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
1169+ -> DMap k vv
1170+ -> Event t (p k vv)
1171+ -> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
1172+ -- ^ The base monad's traversal
1173+ -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv')
1174+ -- ^ A way of mapping over the patch type
1175+ -> (p k (Compose (TraverseChild t m (Some k)) v') -> DMap k (Constant (IORef (ChildReadyState (Some k)))) -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
1176+ -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1177+ -> (IORef (Map.Map (Some k) DOM.Text) -> DOM.Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
1178+ -- ^ Apply a patch to the DOM
1179+ -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))
1180+ -> DMap k v
1181+ -> Event t (p k v)
1182+ -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))
1183+hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1184+ doc <- askDocument
11531185 initialEnv <- HydrationDomBuilderT ask
11541186 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1155− pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
1187+ pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState (Some k)))), p k (Compose (TraverseChild t m (Some k)) v')) <- liftIO $ newIORef mempty
11561188 haveEverBeenReady <- liftIO $ newIORef False
1157− placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"
1158− lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"
1189+ placeholders <- liftIO $ newIORef Map.empty
1190+ lastPlaceholder <- createTextNode doc ("" :: Text)
11591191 let applyDomUpdate p = do
1160− applyDomUpdate_ placeholders lastPlaceholderRef p
1192+ applyDomUpdate_ placeholders lastPlaceholder p
11611193 markSelfReady
11621194 liftIO $ writeIORef pendingChange $! mempty
11631195 markSelfReady = do
@@ -1169,127 +1201,100 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
11691201 let new = pred old
11701202 liftIO $ writeIORef parentUnreadyChildren $! new
11711203 when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
1172− markChildReady :: IORef ChildReadyStateInt -> JSM ()
1204+ markChildReady :: IORef (ChildReadyState (Some k)) -> JSM ()
11731205 markChildReady childReadyState = do
11741206 liftIO (readIORef childReadyState) >>= \case
1175− ChildReadyStateInt_Ready -> return ()
1176− ChildReadyStateInt_Unready countedAt -> do
1177− liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready
1207+ ChildReadyState_Ready -> return ()
1208+ ChildReadyState_Unready countedAt -> do
1209+ liftIO $ writeIORef childReadyState ChildReadyState_Ready
11781210 case countedAt of
11791211 Nothing -> return ()
1180− Just k -> do -- This child has been counted as unready, so we need to remove it from the unready set
1212+ Just (This k) -> do -- This child has been counted as unready, so we need to remove it from the unready set
11811213 (oldUnready, p) <- liftIO $ readIORef pendingChange
1182− when (not $ IntMap.null oldUnready) $ do -- This shouldn't actually ever be null
1183− let newUnready = IntMap.delete k oldUnready
1214+ when (not $ DMap.null oldUnready) $ do -- This shouldn't actually ever be null
1215+ let newUnready = DMap.delete k oldUnready
11841216 liftIO $ writeIORef pendingChange (newUnready, p)
1185− when (IntMap.null newUnready) $ do
1217+ when (DMap.null newUnready) $ do
11861218 applyDomUpdate p
1187− (children0, children') <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdateInt initialEnv markChildReady $ f k v) dm0 dm'
1188− let processChild k (_, _, _, sRef, _) = do
1189− readIORef sRef >>= \case
1190− ChildReadyStateInt_Ready -> return Nothing
1191− ChildReadyStateInt_Unready _ -> do
1192− writeIORef sRef $ ChildReadyStateInt_Unready $ Just k
1193− return $ Just sRef
1194− initialUnready <- liftIO $ IntMap.mapMaybe id <$> IntMap.traverseWithKey processChild children0
1195− liftIO $ if IntMap.null initialUnready
1219+ (children0 :: DMap k (Compose (TraverseChild t m (Some k)) v'), children' :: Event t (p k (Compose (TraverseChild t m (Some k)) v')))
1220+ <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'
1221+ let processChild k (Compose (TraverseChild e _)) = case e of
1222+ Left _ -> pure $ ComposeMaybe Nothing
1223+ Right immediate -> ComposeMaybe <$> do
1224+ readIORef (_traverseChildImmediate_childReadyState immediate) >>= \case
1225+ ChildReadyState_Ready -> return Nothing
1226+ ChildReadyState_Unready _ -> do
1227+ writeIORef (_traverseChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ This k
1228+ return $ Just $ Constant (_traverseChildImmediate_childReadyState immediate)
1229+ initialUnready <- liftIO $ DMap.mapMaybeWithKey (\_ -> getComposeMaybe) <$> DMap.traverseWithKey processChild children0
1230+ liftIO $ if DMap.null initialUnready
11961231 then writeIORef haveEverBeenReady True
11971232 else do
11981233 modifyIORef' parentUnreadyChildren succ
11991234 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
1200− let result0 = IntMap.map (\(_, _, _, _, v) -> v) children0
1201− placeholders0 = fmap (\(_, _, ph, _, _) -> ph) children0
1202− delayed0 :: IntMap (HydrationRunnerT t m ())
1203− delayed0 = IntMap.map (\(delayed, _, _, _, _) -> delayed) children0
1204− delayed' :: Event t (p (HydrationRunnerT t m ()))
1205− delayed' = ffor children' $ fmap $ \(delayed, _, _, _, _) -> delayed
1206− result' = ffor children' $ fmap $ \(_, _, _, _, r) -> r
1207− doc <- askDocument
1208− let setFinalPlaceholder = do
1209− ph <- createTextNode doc ("" :: Text)
1210− insertAfterPreviousNode ph
1211− liftIO $ writeIORef lastPlaceholderRef ph
1212− addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do
1213− _ <- join $ sample (sequence . IntMap.elems <$> delayed)
1214− setFinalPlaceholder
1215− liftIO $ writeIORef placeholders $! placeholders0
12161235 getHydrationMode >>= \case
1217− HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0
1218− _ -> pure ()
1236+ HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do
1237+ dm :: DMap k (Compose (TraverseChild t m (Some k)) v') <- sample $ currentIncremental children
1238+ phs <- traverse id $ weakenDMapWith (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode . getCompose) dm
1239+ liftIO $ writeIORef placeholders $! phs
1240+ insertAfterPreviousNode lastPlaceholder
1241+ HydrationMode_Immediate -> do
1242+ let activate i = do
1243+ append $ toNode $ _traverseChildImmediate_fragment i
1244+ pure $ _traverseChildImmediate_placeholder i
1245+ phs <- traverse id $ weakenDMapWith ((either (error "delayed") activate) . _traverseChild_mode . getCompose) children0
1246+ liftIO $ writeIORef placeholders $! phs
1247+ append $ toNode lastPlaceholder
12191248 requestDomAction_ $ ffor children' $ \p -> do
12201249 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
12211250 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
12221251 let !newP = p <> oldP
12231252 liftIO $ writeIORef pendingChange (newUnready, newP)
1224− when (IntMap.null newUnready) $ do
1253+ when (DMap.null newUnready) $ do
12251254 applyDomUpdate newP
1255+ let result0 = DMap.map (_traverseChild_result . getCompose) children0
1256+ result' = ffor children' $ mapPatch $ _traverseChild_result . getCompose
12261257 return (result0, result')
12271258
1228−insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
1229−insertAfterPreviousNode node = do
1230− parent <- askParent
1231− nextNode <- maybe (Node.getFirstChild parent) Node.getNextSibling =<< getPreviousNode
1232− Node.insertBefore_ parent node nextNode
1233− setPreviousNode $ Just $ toNode node
1234−
1235−data TraverseDMapChildImmediate k = TraverseDMapChildImmediate
1236− { _traverseDMapChildImmediate_fragment :: DOM.DocumentFragment
1237− -- ^ Child is appended to this fragment
1238− , _traverseDMapChildImmediate_placeholder :: DOM.Text
1239− -- ^ Placeholder reference
1240− , _traverseDMapChildImmediate_childReadyState :: IORef (ChildReadyState k)
1241− }
1242−
1243−newtype TraverseDMapChildHydration t m = TraverseDMapChildHydration
1244− { _traverseDMapChildHydration_delayed :: HydrationRunnerT t m DOM.Text
1245− -- ^ Action to run at switchover, returns the placeholder
1246− }
1247−
1248−data TraverseDMapChild t m k a = TraverseDMapChild
1249− { _traverseDMapChild_mode :: Either (TraverseDMapChildHydration t m) (TraverseDMapChildImmediate k)
1250− , _traverseDMapChild_result :: a
1251− }
1252−
1253−{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
1254−hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
1259+{-# INLINABLE hoistTraverseIntMapWithKeyWithAdjust #-}
1260+hoistTraverseIntMapWithKeyWithAdjust ::
12551261 ( Adjustable t m
12561262 , MonadHold t m
1257− , DMap.GCompare k
1258− , MonadIO m
12591263 , MonadJSM m
1260− , PrimMonad m
12611264 , MonadFix m
1262− , Patch (p k v)
1263− , Patch (p k (Constant Int))
1264− , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
1265− , Patch (p k (Compose (TraverseDMapChild t m k) v'))
1266− , PatchTarget (p k (Compose (TraverseDMapChild t m k) v')) ~ DMap k (Compose (TraverseDMapChild t m k) v')
1267− , Monoid (p k (Compose (TraverseDMapChild t m k) v'))
1265+ , PrimMonad m
1266+ , Monoid (p (TraverseChild t m Int v'))
1267+ , Functor p
1268+ , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
1269+ , PatchTarget (p (TraverseChild t m Int v')) ~ IntMap (TraverseChild t m Int v')
1270+ , Patch (p (HydrationRunnerT t m ()))
1271+ , Patch (p (TraverseChild t m Int v'))
12681272 )
1269− => (forall vv vv'.
1270− (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
1271− -> DMap k vv
1272− -> Event t (p k vv)
1273− -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
1274− )
1273+ => ((IntMap.Key -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
1274+ -> IntMap v
1275+ -> Event t (p v)
1276+ -> DomRenderHookT t m (IntMap (TraverseChild t m Int v'), Event t (p (TraverseChild t m Int v'))))
12751277 -- ^ The base monad's traversal
1276− -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv')
1277− -- ^ A way of mapping over the patch type
1278− -> (p k (Compose (TraverseDMapChild t m k) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k)))))
1278+ -> (p (TraverseChild t m Int v')
1279+ -> IntMap (IORef (ChildReadyState Int))
1280+ -> IO (IntMap (IORef (ChildReadyState Int))))
12791281 -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1280− -> (IORef (Map.Map (Some.Some k) DOM.Text) -> DOM.Text -> p k (Compose (TraverseDMapChild t m k) v') -> JSM ())
1282+ -> (IORef (IntMap DOM.Text)
1283+ -> DOM.Text
1284+ -> p (TraverseChild t m Int v')
1285+ -> JSM ())
12811286 -- ^ Apply a patch to the DOM
1282− -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))
1283− -> DMap k v
1284− -> Event t (p k v)
1285− -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))
1286−hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ (f :: forall a. k a -> v a -> HydrationDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do
1287+ -> (IntMap.Key -> v -> HydrationDomBuilderT t m v')
1288+ -> IntMap v
1289+ -> Event t (p v)
1290+ -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
1291+hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
12871292 doc <- askDocument
12881293 initialEnv <- HydrationDomBuilderT ask
12891294 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1290− pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose (TraverseDMapChild t m k) v')) <- liftIO $ newIORef mempty
1295+ pendingChange :: IORef (IntMap (IORef (ChildReadyState Int)), p (TraverseChild t m Int v')) <- liftIO $ newIORef mempty
12911296 haveEverBeenReady <- liftIO $ newIORef False
1292− placeholders <- liftIO $ newIORef Map.empty
1297+ placeholders <- liftIO $ newIORef IntMap.empty
12931298 lastPlaceholder <- createTextNode doc ("" :: Text)
12941299 let applyDomUpdate p = do
12951300 applyDomUpdate_ placeholders lastPlaceholder p
@@ -1304,7 +1309,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
13041309 let new = pred old
13051310 liftIO $ writeIORef parentUnreadyChildren $! new
13061311 when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
1307− markChildReady :: IORef (ChildReadyState k) -> JSM ()
1312+ markChildReady :: IORef (ChildReadyState Int) -> JSM ()
13081313 markChildReady childReadyState = do
13091314 liftIO (readIORef childReadyState) >>= \case
13101315 ChildReadyState_Ready -> return ()
@@ -1312,135 +1317,123 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
13121317 liftIO $ writeIORef childReadyState ChildReadyState_Ready
13131318 case countedAt of
13141319 Nothing -> return ()
1315− Just (Some.This k) -> do -- This child has been counted as unready, so we need to remove it from the unready set
1320+ Just k -> do -- This child has been counted as unready, so we need to remove it from the unready set
13161321 (oldUnready, p) <- liftIO $ readIORef pendingChange
1317− when (not $ DMap.null oldUnready) $ do -- This shouldn't actually ever be null
1318− let newUnready = DMap.delete k oldUnready
1322+ when (not $ IntMap.null oldUnready) $ do -- This shouldn't actually ever be null
1323+ let newUnready = IntMap.delete k oldUnready
13191324 liftIO $ writeIORef pendingChange (newUnready, p)
1320− when (DMap.null newUnready) $ do
1325+ when (IntMap.null newUnready) $ do
13211326 applyDomUpdate p
1322− (children0 :: DMap k (Compose (TraverseDMapChild t m k) v'), children' :: Event t (p k (Compose (TraverseDMapChild t m k) v')))
1323− <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'
1324− let processChild k (Compose (TraverseDMapChild e _)) = case e of
1325− Left _ -> pure $ ComposeMaybe Nothing
1326− Right immediate -> ComposeMaybe <$> do
1327− readIORef (_traverseDMapChildImmediate_childReadyState immediate) >>= \case
1327+ (children0 :: IntMap (TraverseChild t m Int v'), children' :: Event t (p (TraverseChild t m Int v')))
1328+ <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdateInt initialEnv markChildReady $ f k v) dm0 dm'
1329+ let processChild k (TraverseChild e _) = case e of
1330+ Left _ -> pure Nothing
1331+ Right immediate -> do
1332+ readIORef (_traverseChildImmediate_childReadyState immediate) >>= \case
13281333 ChildReadyState_Ready -> return Nothing
13291334 ChildReadyState_Unready _ -> do
1330− writeIORef (_traverseDMapChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ Some.This k
1331− return $ Just $ Constant (_traverseDMapChildImmediate_childReadyState immediate)
1332− initialUnready <- liftIO $ DMap.mapMaybeWithKey (\_ -> getComposeMaybe) <$> DMap.traverseWithKey processChild children0
1333− liftIO $ if DMap.null initialUnready
1335+ writeIORef (_traverseChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just k
1336+ return $ Just (_traverseChildImmediate_childReadyState immediate)
1337+ initialUnready <- liftIO $ IntMap.mapMaybe id <$> IntMap.traverseWithKey processChild children0
1338+ liftIO $ if IntMap.null initialUnready
13341339 then writeIORef haveEverBeenReady True
13351340 else do
13361341 modifyIORef' parentUnreadyChildren succ
13371342 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
13381343 getHydrationMode >>= \case
13391344 HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do
1340− dm :: DMap k (Compose (TraverseDMapChild t m k) v') <- sample $ currentIncremental children
1341− phs <- traverse id $ weakenDMapWith (either _traverseDMapChildHydration_delayed (pure . _traverseDMapChildImmediate_placeholder) . _traverseDMapChild_mode . getCompose) dm
1345+ dm :: IntMap (TraverseChild t m Int v') <- sample $ currentIncremental children
1346+ phs <- traverse (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode) dm
13421347 liftIO $ writeIORef placeholders $! phs
13431348 insertAfterPreviousNode lastPlaceholder
13441349 HydrationMode_Immediate -> do
13451350 let activate i = do
1346− append $ toNode $ _traverseDMapChildImmediate_fragment i
1347− pure $ _traverseDMapChildImmediate_placeholder i
1348− phs <- traverse id $ weakenDMapWith ((either (error "delayed") activate) . _traverseDMapChild_mode . getCompose) children0
1351+ append $ toNode $ _traverseChildImmediate_fragment i
1352+ pure $ _traverseChildImmediate_placeholder i
1353+ phs <- traverse ((either (error "delayed") activate) . _traverseChild_mode) children0
13491354 liftIO $ writeIORef placeholders $! phs
13501355 append $ toNode lastPlaceholder
1351−
13521356 requestDomAction_ $ ffor children' $ \p -> do
13531357 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
13541358 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
13551359 let !newP = p <> oldP
13561360 liftIO $ writeIORef pendingChange (newUnready, newP)
1357− when (DMap.null newUnready) $ do
1361+ when (IntMap.null newUnready) $ do
13581362 applyDomUpdate newP
1359− let result0 = DMap.map (_traverseDMapChild_result . getCompose) children0
1360− result' = ffor children' $ mapPatch $ _traverseDMapChild_result . getCompose
1363+ let result0 = IntMap.map (_traverseChild_result) children0
1364+ result' = ffor children' $ fmap $ _traverseChild_result
13611365 return (result0, result')
13621366
1367+data TraverseChildImmediate k = TraverseChildImmediate
1368+ { _traverseChildImmediate_fragment :: DOM.DocumentFragment
1369+ -- ^ Child is appended to this fragment
1370+ , _traverseChildImmediate_placeholder :: DOM.Text
1371+ -- ^ Placeholder reference
1372+ , _traverseChildImmediate_childReadyState :: IORef (ChildReadyState k)
1373+ }
1374+
1375+newtype TraverseChildHydration t m = TraverseChildHydration
1376+ { _traverseChildHydration_delayed :: HydrationRunnerT t m DOM.Text
1377+ -- ^ Action to run at switchover, returns the placeholder
1378+ }
1379+
1380+data TraverseChild t m k a = TraverseChild
1381+ { _traverseChild_mode :: Either (TraverseChildHydration t m) (TraverseChildImmediate k)
1382+ , _traverseChild_result :: a
1383+ } deriving Functor
1384+
13631385{-# INLINABLE drawChildUpdate #-}
13641386drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)
13651387 => HydrationDomBuilderEnv t
13661388 -> (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
1367− -> HydrationDomBuilderT t m (v' a)
1368− -> DomRenderHookT t m (Compose (TraverseDMapChild t m k) v' a)
1369−drawChildUpdate initialEnv markReady child = liftIO (readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv) >>= \case
1370− HydrationMode_Hydrating -> do
1371− let doc = _hydrationDomBuilderEnv_document initialEnv
1372− unreadyChildren <- liftIO $ newIORef 0
1373− (result, childDelayed) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1374− { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1375− }
1376− let delayed = do
1377− placeholder <- createTextNode doc ("" :: Text)
1378− insertAfterPreviousNode placeholder
1379− pure placeholder
1380− return $ Compose $ TraverseDMapChild
1381− { _traverseDMapChild_result = result
1382− , _traverseDMapChild_mode = Left TraverseDMapChildHydration
1383− { _traverseDMapChildHydration_delayed = delayed <* childDelayed
1389+ -> HydrationDomBuilderT t m (f a)
1390+ -> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
1391+drawChildUpdate initialEnv markReady child = do
1392+ let doc = _hydrationDomBuilderEnv_document initialEnv
1393+ unreadyChildren <- liftIO $ newIORef 0
1394+ liftIO (readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv) >>= \case
1395+ HydrationMode_Hydrating -> do
1396+ (result, childDelayed) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1397+ { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
13841398 }
1385− }
1386− HydrationMode_Immediate -> do
1387− childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
1388− let doc = _hydrationDomBuilderEnv_document initialEnv
1389− unreadyChildren <- liftIO $ newIORef 0
1390− df <- createDocumentFragment doc
1391− placeholder <- createTextNode doc ("" :: Text)
1392− Node.appendChild_ df placeholder
1393− parentRef <- liftIO . newIORef $ toNode df
1394− (result, _s) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1395− { _hydrationDomBuilderEnv_parent = parentRef
1396− , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1397− , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1399+ return $ Compose $ TraverseChild
1400+ { _traverseChild_result = result
1401+ , _traverseChild_mode = Left TraverseChildHydration
1402+ { _traverseChildHydration_delayed = do
1403+ placeholder <- createTextNode doc ("" :: Text)
1404+ insertAfterPreviousNode placeholder
1405+ childDelayed
1406+ pure placeholder
13981407 }
1399− u <- liftIO $ readIORef unreadyChildren
1400− when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
1401− return $ Compose $ TraverseDMapChild
1402− { _traverseDMapChild_result = result
1403− , _traverseDMapChild_mode = Right TraverseDMapChildImmediate
1404− { _traverseDMapChildImmediate_fragment = df
1405− , _traverseDMapChildImmediate_placeholder = placeholder
1406− , _traverseDMapChildImmediate_childReadyState = childReadyState
14071408 }
1408− }
1409−
1410−{-# INLINABLE drawChildUpdateInt #-}
1411−drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)
1412− => HydrationDomBuilderEnv t
1413− -> (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
1414− -> HydrationDomBuilderT t m v'
1415− -> DomRenderHookT t m (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')
1416−drawChildUpdateInt initialEnv markReady child = do
1417− childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing
1418− let doc = _hydrationDomBuilderEnv_document initialEnv
1419− unreadyChildren <- liftIO $ newIORef 0
1420− hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv
1421− placeholder <- createTextNode doc ("" :: Text)
1422− (p, delayed) <- case hydrationMode of
1423− HydrationMode_Hydrating -> pure
1424− ( Left $ _hydrationDomBuilderEnv_parent initialEnv
1425− , insertAfterPreviousNode placeholder
1426− )
14271409 HydrationMode_Immediate -> do
1410+ childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
14281411 df <- createDocumentFragment doc
1412+ placeholder <- createTextNode doc ("" :: Text)
14291413 Node.appendChild_ df placeholder
1430− pure (Right df, pure ())
1431− p' <- either pure (liftIO . newIORef . toNode) p
1432− (result, finalState) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1433− { _hydrationDomBuilderEnv_parent = p'
1414+ parentRef <- liftIO . newIORef $ toNode df
1415+ (result, _s) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1416+ { _hydrationDomBuilderEnv_parent = parentRef
14341417 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
14351418 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
14361419 }
1437− u <- liftIO $ readIORef unreadyChildren
1438− when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready
1439− return
1440− ( delayed >> finalState
1441− , either (const $ error "drawChildUpdateInt: Tried to use document fragment in hydration mode") id p
1442− , placeholder, childReadyState, result
1443− )
1420+ u <- liftIO $ readIORef unreadyChildren
1421+ when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
1422+ return $ Compose $ TraverseChild
1423+ { _traverseChild_result = result
1424+ , _traverseChild_mode = Right TraverseChildImmediate
1425+ { _traverseChildImmediate_fragment = df
1426+ , _traverseChildImmediate_placeholder = placeholder
1427+ , _traverseChildImmediate_childReadyState = childReadyState
1428+ }
1429+ }
1430+
1431+drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)
1432+ => HydrationDomBuilderEnv t
1433+ -> (IORef (ChildReadyState k) -> JSM ())
1434+ -> HydrationDomBuilderT t m v
1435+ -> DomRenderHookT t m (TraverseChild t m k v)
1436+drawChildUpdateInt env mark m = fmap runIdentity . getCompose <$> drawChildUpdate env mark (Identity <$> m)
14441437
14451438instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where
14461439 type Performable (HydrationDomBuilderT t m) = Performable m