@@ -49,7 +49,6 @@ module Reflex.Dom.Builder.Hydration
49 , traverseDMapWithKeyWithAdjust'
49 , traverseDMapWithKeyWithAdjust'
50 , hoistTraverseWithKeyWithAdjust
50 , hoistTraverseWithKeyWithAdjust
51 , traverseIntMapWithKeyWithAdjust'
51 , traverseIntMapWithKeyWithAdjust'
52− , hoistTraverseIntMapWithKeyWithAdjust
55import Control.Concurrent
54import Control.Concurrent
@@ -71,6 +70,7 @@ import Data.Functor.Product
71import Data.IORef
70import Data.IORef
72import Data.IntMap.Strict (IntMap)
71import Data.IntMap.Strict (IntMap)
73import Data.Maybe
72import Data.Maybe
73+import Data.Some (Some(..))
74import Data.Text (Text)
74import Data.Text (Text)
75import Data.Typeable (Typeable)
75import Data.Typeable (Typeable)
76import Foreign.JavaScript.Internal.Utils
76import Foreign.JavaScript.Internal.Utils
@@ -83,7 +83,7 @@ import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, IsNode, Node, To
83import Reflex.Adjustable.Class
83import Reflex.Adjustable.Class
84import Reflex.Class as Reflex
84import Reflex.Class as Reflex
85import Reflex.Dom.Builder.Class
85import 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(..))
87import Reflex.Dynamic
87import Reflex.Dynamic
88import Reflex.Host.Class
88import Reflex.Host.Class
89import Reflex.PerformEvent.Class
89import Reflex.PerformEvent.Class
@@ -97,7 +97,6 @@ import qualified Data.Dependent.Map as DMap
97import qualified Data.FastMutableIntMap as FastMutableIntMap
97import qualified Data.FastMutableIntMap as FastMutableIntMap
98import qualified Data.IntMap.Strict as IntMap
98import qualified Data.IntMap.Strict as IntMap
99import qualified Data.Map as Map
99import qualified Data.Map as Map
100−import qualified Data.Some as Some
101import qualified Data.Text as T
100import qualified Data.Text as T
102import qualified GHCJS.DOM as DOM
101import qualified GHCJS.DOM as DOM
103import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
102import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
@@ -997,31 +996,31 @@ instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m) =>
997 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'
996 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'
998 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
997 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
999 traverseDMapWithKeyWithAdjustWithMove = do
998 traverseDMapWithKeyWithAdjustWithMove = do
1000− let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose (TraverseDMapChild t m k) v')) old = do
999+ let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose (TraverseChild t m (Some 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)
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)
1002 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case
1001 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case
1003− PatchDMapWithMove.From_Insert (Compose (TraverseDMapChild (Right myTypeImmediate) _)) -> do
1002+ PatchDMapWithMove.From_Insert (Compose (TraverseChild (Right myTypeImmediate) _)) -> do
1004− readIORef (_traverseDMapChildImmediate_childReadyState myTypeImmediate) >>= \case
1003+ readIORef (_traverseChildImmediate_childReadyState myTypeImmediate) >>= \case
1005 ChildReadyState_Ready -> return PatchDMapWithMove.From_Delete
1004 ChildReadyState_Ready -> return PatchDMapWithMove.From_Delete
1006 ChildReadyState_Unready _ -> do
1005 ChildReadyState_Unready _ -> do
1007− writeIORef (_traverseDMapChildImmediate_childReadyState myTypeImmediate) $ ChildReadyState_Unready $ Just $ Some.This k
1006+ writeIORef (_traverseChildImmediate_childReadyState myTypeImmediate) $ ChildReadyState_Unready $ Just $ This k
1008− return $ PatchDMapWithMove.From_Insert $ Constant (_traverseDMapChildImmediate_childReadyState myTypeImmediate)
1007+ return $ PatchDMapWithMove.From_Insert $ Constant (_traverseChildImmediate_childReadyState myTypeImmediate)
1009 PatchDMapWithMove.From_Delete -> return PatchDMapWithMove.From_Delete
1008 PatchDMapWithMove.From_Delete -> return PatchDMapWithMove.From_Delete
1010 PatchDMapWithMove.From_Move fromKey -> return $ PatchDMapWithMove.From_Move fromKey
1009 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)
1012 deleteOrMove _ (Pair (Constant sRef) (ComposeMaybe mToKey)) = do
1011 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
1014 return $ Constant ()
1013 return $ Constant ()
1015 p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p
1014 p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p
1016 _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old
1015 _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old
1017 return $ applyAlways p' old
1016 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
1019 let p = unPatchDMapWithMove p_
1018 let p = unPatchDMapWithMove p_
1020 phsBefore <- liftIO $ readIORef placeholders
1019 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)
1022 collectIfMoved k e = do
1021 collectIfMoved k e = do
1023− let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before
1022+ let mThisPlaceholder = Map.lookup (This k) phsBefore -- Will be Nothing if this element wasn't present before
1024− nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore
1023+ nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (This k) phsBefore
1025 case isJust $ getComposeMaybe $ PatchDMapWithMove._nodeInfo_to e of
1024 case isJust $ getComposeMaybe $ PatchDMapWithMove._nodeInfo_to e of
1026 False -> do
1025 False -> do
1027 mapM_ (`deleteUpTo` nextPlaceholder) mThisPlaceholder
1026 mapM_ (`deleteUpTo` nextPlaceholder) mThisPlaceholder
@@ -1029,14 +1028,14 @@ instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m) =>
1029 True -> do
1028 True -> do
1030 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder
1029 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder
1031 collected <- DMap.traverseWithKey collectIfMoved p
1030 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
1031+ let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (_traverseChildImmediate_placeholder . error "FIXME" . _traverseChild_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)
1032+ let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant () a)
1034 placeFragment k e = do
1033 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
1036 case PatchDMapWithMove._nodeInfo_from e of
1035 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
1038 Left _ -> pure ()
1037 Left _ -> pure ()
1039− Right immediate -> _traverseDMapChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1038+ Right immediate -> _traverseChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1040 PatchDMapWithMove.From_Delete -> do
1039 PatchDMapWithMove.From_Delete -> do
1041 return ()
1040 return ()
1042 PatchDMapWithMove.From_Move fromKey -> do
1041 PatchDMapWithMove.From_Move fromKey -> do
@@ -1054,17 +1053,17 @@ traverseDMapWithKeyWithAdjust'
1054 -> Event t (PatchDMap k v)
1053 -> Event t (PatchDMap k v)
1055 -> HydrationDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))
1054 -> HydrationDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))
1056traverseDMapWithKeyWithAdjust' = do
1055traverseDMapWithKeyWithAdjust' = do
1057− let updateChildUnreadiness (p :: PatchDMap k (Compose (TraverseDMapChild t m k) v')) old = do
1056+ let updateChildUnreadiness (p :: PatchDMap k (Compose (TraverseChild t m (Some 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)
1057+ let new :: forall a. k a -> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
1059 new k (ComposeMaybe m) = ComposeMaybe <$> case m of
1058 new k (ComposeMaybe m) = ComposeMaybe <$> case m of
1060 Nothing -> return Nothing
1059 Nothing -> return Nothing
1061− Just (Compose (TraverseDMapChild (Left hydration) _)) -> pure Nothing
1060+ Just (Compose (TraverseChild (Left hydration) _)) -> pure Nothing
1062− Just (Compose (TraverseDMapChild (Right immediate) _)) -> do
1061+ Just (Compose (TraverseChild (Right immediate) _)) -> do
1063− readIORef (_traverseDMapChildImmediate_childReadyState immediate) >>= \case
1062+ readIORef (_traverseChildImmediate_childReadyState immediate) >>= \case
1064 ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready
1063 ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready
1065 ChildReadyState_Unready _ -> do
1064 ChildReadyState_Unready _ -> do
1066− writeIORef (_traverseDMapChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ Some.This k
1065+ writeIORef (_traverseChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ This k
1067− return $ Just $ Constant (_traverseDMapChildImmediate_childReadyState immediate)
1066+ return $ Just $ Constant (_traverseChildImmediate_childReadyState immediate)
1068 delete _ (Constant sRef) = do
1067 delete _ (Constant sRef) = do
1069 writeIORef sRef $ ChildReadyState_Unready Nothing
1068 writeIORef sRef $ ChildReadyState_Unready Nothing
1070 return $ Constant ()
1069 return $ Constant ()
@@ -1074,24 +1073,23 @@ traverseDMapWithKeyWithAdjust' = do
1074 hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap updateChildUnreadiness $ \placeholders lastPlaceholder (PatchDMap patch) -> do
1073 hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap updateChildUnreadiness $ \placeholders lastPlaceholder (PatchDMap patch) -> do
1075 phs <- liftIO $ readIORef placeholders
1074 phs <- liftIO $ readIORef placeholders
1076 forM_ (DMap.toList patch) $ \(k :=> ComposeMaybe mv) -> do
1075 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
1078 -- Delete old node
1077 -- Delete old node
1079− forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> do
1078+ forM_ (Map.lookup (This k) phs) $ \thisPlaceholder -> do
1080 thisPlaceholder `deleteUpTo` nextPlaceholder
1079 thisPlaceholder `deleteUpTo` nextPlaceholder
1081 -- Insert new node
1080 -- Insert new node
1082− forM_ mv $ \(Compose (TraverseDMapChild e _)) -> case e of
1081+ forM_ mv $ \(Compose (TraverseChild e _)) -> case e of
1083 Left _hydration -> pure ()
1082 Left _hydration -> pure ()
1084 Right immediate -> do
1083 Right immediate -> do
1085− _traverseDMapChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1084+ _traverseChildImmediate_fragment immediate `insertBefore` nextPlaceholder
1086− let weakened :: PatchMap (Some.Some k) (Either (TraverseDMapChildHydration t m) (TraverseDMapChildImmediate k))
1085+ let weakened :: PatchMap (Some k) (Either (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
1087− weakened = weakenPatchDMapWith (_traverseDMapChild_mode . getCompose) $ PatchDMap patch
1086+ weakened = weakenPatchDMapWith (_traverseChild_mode . getCompose) $ PatchDMap patch
1088− filtered :: PatchMap (Some.Some k) DOM.Text
1087+ filtered :: PatchMap (Some k) DOM.Text
1089 filtered = PatchMap $ flip Map.mapMaybe (unPatchMap weakened) $ \case
1088 filtered = PatchMap $ flip Map.mapMaybe (unPatchMap weakened) $ \case
1090 Nothing -> Just Nothing -- deletion
1089 Nothing -> Just Nothing -- deletion
1091 Just (Left _) -> Nothing
1090 Just (Left _) -> Nothing
1092− Just (Right immediate) -> Just $ Just $ _traverseDMapChildImmediate_placeholder immediate
1091+ Just (Right immediate) -> Just $ Just $ _traverseChildImmediate_placeholder immediate
1093− a = apply filtered phs
1094− liftIO $ writeIORef placeholders $! fromMaybe phs a
1092+ liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered phs
1096{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
1094{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
1097traverseIntMapWithKeyWithAdjust'
1095traverseIntMapWithKeyWithAdjust'
@@ -1101,63 +1099,97 @@ traverseIntMapWithKeyWithAdjust'
1101 -> Event t (PatchIntMap v)
1099 -> Event t (PatchIntMap v)
1102 -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))
1100 -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))
1103traverseIntMapWithKeyWithAdjust' = do
1101traverseIntMapWithKeyWithAdjust' = do
1104− let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do
1102+ let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (TraverseChild t m Int v')) old = do
1105− let new :: IntMap.Key -> Maybe (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))
1103+ let new :: IntMap.Key -> Maybe (TraverseChild t m Int v') -> IO (Maybe (IORef (ChildReadyState Int)))
1106 new k m = case m of
1104 new k m = case m of
1107 Nothing -> return Nothing
1105 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
1109 readIORef sRef >>= \case
1109 readIORef sRef >>= \case
1110− ChildReadyStateInt_Ready -> return Nothing -- Delete this child, since it's ready
1110+ ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready
1111− ChildReadyStateInt_Unready _ -> do
1111+ ChildReadyState_Unready _ -> do
1112− writeIORef sRef $ ChildReadyStateInt_Unready $ Just k
1112+ writeIORef sRef $ ChildReadyState_Unready $ Just k
1113 return $ Just sRef
1113 return $ Just sRef
1114 delete _ sRef = do
1114 delete _ sRef = do
1115− writeIORef sRef $ ChildReadyStateInt_Unready Nothing
1115+ writeIORef sRef $ ChildReadyState_Unready Nothing
1116 return ()
1116 return ()
1117 p' <- PatchIntMap <$> IntMap.traverseWithKey new pInner
1117 p' <- PatchIntMap <$> IntMap.traverseWithKey new pInner
1118 _ <- IntMap.traverseWithKey delete $ FastMutableIntMap.getDeletions p old
1118 _ <- IntMap.traverseWithKey delete $ FastMutableIntMap.getDeletions p old
1119 return $ applyAlways p' old
1119 return $ applyAlways p' old
1120− hoistTraverseIntMapWithKeyWithAdjust traverseIntMapWithKeyWithAdjust updateChildUnreadiness $ \placeholders lastPlaceholderRef (PatchIntMap p) -> do
1120+ hoistTraverseIntMapWithKeyWithAdjust traverseIntMapWithKeyWithAdjust updateChildUnreadiness $ \placeholders lastPlaceholder (PatchIntMap p) -> do
1121 phs <- liftIO $ readIORef placeholders
1121 phs <- liftIO $ readIORef placeholders
1122 forM_ (IntMap.toList p) $ \(k, mv) -> do
1122 forM_ (IntMap.toList p) $ \(k, mv) -> do
1123− lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
1124 let nextPlaceholder = maybe lastPlaceholder snd $ IntMap.lookupGT k phs
1123 let nextPlaceholder = maybe lastPlaceholder snd $ IntMap.lookupGT k phs
1125 forM_ (IntMap.lookup k phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder
1125 forM_ (IntMap.lookup k phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder
1127+ forM_ mv $ \(TraverseChild e _) -> case e of
1128+ Left _hydration -> pure ()
1129+ Right immediate -> do
1126− forM_ mv $ \(_, df, _, _, _) -> df `insertBefore` nextPlaceholder
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
1127− liftIO $ writeIORef placeholders $! fromMaybe phs $ apply ((\(_, _, ph, _, _) -> ph) <$> PatchIntMap p) phs
1136+ liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered phs
1138+data ChildReadyState a
1139+ = ChildReadyState_Ready
1140+ | ChildReadyState_Unready !(Maybe a)
1141+ deriving (Show, Read, Eq, Ord)
1129−{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}
1143+insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
1130−hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
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
1150+{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
1151+hoistTraverseWithKeyWithAdjust
1131 ( Adjustable t m
1153 ( Adjustable t m
1132 , MonadHold t m
1154 , MonadHold t m
1133 , MonadJSM m
1157 , MonadJSM m
1135 , PrimMonad m
1158 , PrimMonad m
1136− , Monoid (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1159+ , MonadFix m
1137− , Functor p
1160+ , Patch (p k v)
1138− , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
1161+ , Patch (p k (Constant Int))
1139− , Patch (p (HydrationRunnerT t m ()))
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'))
1141− => ( (IntMap.Key -> v -> DomRenderHookT t m (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))
1167+ => (forall vv vv'.
1142− -> IntMap v
1168+ (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
1143− -> Event t (p v)
1170+ -> Event t (p k vv)
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')))
1171+ -> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
1145− ) -- ^ The base monad's traversal
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))))))
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
1176+ -- ^ 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
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
1148− -> (IntMap.Key -> v -> HydrationDomBuilderT t m v')
1179+ -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))
1149− -> IntMap v
1180+ -> DMap k v
1150− -> Event t (p v)
1181+ -> Event t (p k v)
1151− -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
1182+ -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))
1152−hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1183+hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1153 initialEnv <- HydrationDomBuilderT ask
1185 initialEnv <- HydrationDomBuilderT ask
1154 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1186 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
1156 haveEverBeenReady <- liftIO $ newIORef False
1188 haveEverBeenReady <- liftIO $ newIORef False
1157− placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"
1189+ placeholders <- liftIO $ newIORef Map.empty
1158− lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"
1190+ lastPlaceholder <- createTextNode doc ("" :: Text)
1159 let applyDomUpdate p = do
1191 let applyDomUpdate p = do
1160− applyDomUpdate_ placeholders lastPlaceholderRef p
1192+ applyDomUpdate_ placeholders lastPlaceholder p
1161 markSelfReady
1193 markSelfReady
1162 liftIO $ writeIORef pendingChange $! mempty
1194 liftIO $ writeIORef pendingChange $! mempty
1163 markSelfReady = do
1195 markSelfReady = do
@@ -1169,127 +1201,100 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
1169 let new = pred old
1201 let new = pred old
1170 liftIO $ writeIORef parentUnreadyChildren $! new
1202 liftIO $ writeIORef parentUnreadyChildren $! new
1171 when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
1203 when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
1172− markChildReady :: IORef ChildReadyStateInt -> JSM ()
1204+ markChildReady :: IORef (ChildReadyState (Some k)) -> JSM ()
1173 markChildReady childReadyState = do
1205 markChildReady childReadyState = do
1174 liftIO (readIORef childReadyState) >>= \case
1206 liftIO (readIORef childReadyState) >>= \case
1175− ChildReadyStateInt_Ready -> return ()
1207+ ChildReadyState_Ready -> return ()
1176− ChildReadyStateInt_Unready countedAt -> do
1208+ ChildReadyState_Unready countedAt -> do
1177− liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready
1209+ liftIO $ writeIORef childReadyState ChildReadyState_Ready
1178 case countedAt of
1210 case countedAt of
1179 Nothing -> return ()
1211 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
1181 (oldUnready, p) <- liftIO $ readIORef pendingChange
1213 (oldUnready, p) <- liftIO $ readIORef pendingChange
1182− when (not $ IntMap.null oldUnready) $ do -- This shouldn't actually ever be null
1214+ when (not $ DMap.null oldUnready) $ do -- This shouldn't actually ever be null
1183− let newUnready = IntMap.delete k oldUnready
1215+ let newUnready = DMap.delete k oldUnready
1184 liftIO $ writeIORef pendingChange (newUnready, p)
1216 liftIO $ writeIORef pendingChange (newUnready, p)
1185− when (IntMap.null newUnready) $ do
1217+ when (DMap.null newUnready) $ do
1186 applyDomUpdate p
1218 applyDomUpdate p
1219+ (children0 :: DMap k (Compose (TraverseChild t m (Some k)) v'), children' :: Event t (p k (Compose (TraverseChild t m (Some k)) v')))
1187− (children0, children') <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdateInt initialEnv markChildReady $ f k v) dm0 dm'
1220+ <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'
1188− let processChild k (_, _, _, sRef, _) = do
1221+ let processChild k (Compose (TraverseChild e _)) = case e of
1189− readIORef sRef >>= \case
1222+ Left _ -> pure $ ComposeMaybe Nothing
1190− ChildReadyStateInt_Ready -> return Nothing
1223+ Right immediate -> ComposeMaybe <$> do
1191− ChildReadyStateInt_Unready _ -> do
1224+ readIORef (_traverseChildImmediate_childReadyState immediate) >>= \case
1192− writeIORef sRef $ ChildReadyStateInt_Unready $ Just k
1225+ ChildReadyState_Ready -> return Nothing
1193− return $ Just sRef
1226+ ChildReadyState_Unready _ -> do
1227+ writeIORef (_traverseChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ This k
1228+ return $ Just $ Constant (_traverseChildImmediate_childReadyState immediate)
1194− initialUnready <- liftIO $ IntMap.mapMaybe id <$> IntMap.traverseWithKey processChild children0
1229+ initialUnready <- liftIO $ DMap.mapMaybeWithKey (\_ -> getComposeMaybe) <$> DMap.traverseWithKey processChild children0
1195− liftIO $ if IntMap.null initialUnready
1230+ liftIO $ if DMap.null initialUnready
1196 then writeIORef haveEverBeenReady True
1231 then writeIORef haveEverBeenReady True
1198 modifyIORef' parentUnreadyChildren succ
1233 modifyIORef' parentUnreadyChildren succ
1199 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
1234 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
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
1216 getHydrationMode >>= \case
1235 getHydrationMode >>= \case
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
1217− HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0
1241+ HydrationMode_Immediate -> do
1218− _ -> pure ()
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
1219 requestDomAction_ $ ffor children' $ \p -> do
1248 requestDomAction_ $ ffor children' $ \p -> do
1220 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1249 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1221 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
1250 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
1222 let !newP = p <> oldP
1251 let !newP = p <> oldP
1223 liftIO $ writeIORef pendingChange (newUnready, newP)
1252 liftIO $ writeIORef pendingChange (newUnready, newP)
1224− when (IntMap.null newUnready) $ do
1253+ when (DMap.null newUnready) $ do
1225 applyDomUpdate newP
1254 applyDomUpdate newP
1255+ let result0 = DMap.map (_traverseChild_result . getCompose) children0
1256+ result' = ffor children' $ mapPatch $ _traverseChild_result . getCompose
1226 return (result0, result')
1257 return (result0, result')
1228−insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
1259+{-# INLINABLE hoistTraverseIntMapWithKeyWithAdjust #-}
1229−insertAfterPreviousNode node = do
1260+hoistTraverseIntMapWithKeyWithAdjust ::
1230− parent <- askParent
1231− nextNode <- maybe (Node.getFirstChild parent) Node.getNextSibling =<< getPreviousNode
1232− Node.insertBefore_ parent node nextNode
1233− setPreviousNode $ Just $ toNode node
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)
1243−newtype TraverseDMapChildHydration t m = TraverseDMapChildHydration
1244− { _traverseDMapChildHydration_delayed :: HydrationRunnerT t m DOM.Text
1245− -- ^ Action to run at switchover, returns the placeholder
1248−data TraverseDMapChild t m k a = TraverseDMapChild
1249− { _traverseDMapChild_mode :: Either (TraverseDMapChildHydration t m) (TraverseDMapChildImmediate k)
1250− , _traverseDMapChild_result :: a
1253−{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
1254−hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
1255 ( Adjustable t m
1261 ( Adjustable t m
1256 , MonadHold t m
1262 , MonadHold t m
1259 , MonadJSM m
1263 , MonadJSM m
1261 , MonadFix m
1264 , MonadFix m
1262− , Patch (p k v)
1265+ , PrimMonad m
1263− , Patch (p k (Constant Int))
1266+ , Monoid (p (TraverseChild t m Int v'))
1264− , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
1267+ , Functor p
1265− , Patch (p k (Compose (TraverseDMapChild t m k) v'))
1268+ , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
1266− , PatchTarget (p k (Compose (TraverseDMapChild t m k) v')) ~ DMap k (Compose (TraverseDMapChild t m k) v')
1269+ , PatchTarget (p (TraverseChild t m Int v')) ~ IntMap (TraverseChild t m Int v')
1267− , Monoid (p k (Compose (TraverseDMapChild t m k) v'))
1270+ , Patch (p (HydrationRunnerT t m ()))
1271+ , Patch (p (TraverseChild t m Int v'))
1269− => (forall vv vv'.
1273+ => ((IntMap.Key -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
1270− (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
1274+ -> IntMap v
1272− -> Event t (p k vv)
1275+ -> Event t (p v)
1273− -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
1276+ -> DomRenderHookT t m (IntMap (TraverseChild t m Int v'), Event t (p (TraverseChild t m Int v'))))
1275 -- ^ The base monad's traversal
1277 -- ^ The base monad's traversal
1276− -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv')
1278+ -> (p (TraverseChild t m Int v')
1277− -- ^ A way of mapping over the patch type
1279+ -> IntMap (IORef (ChildReadyState Int))
1278− -> (p k (Compose (TraverseDMapChild t m k) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k)))))
1280+ -> IO (IntMap (IORef (ChildReadyState Int))))
1279 -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
1281 -- ^ 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)
1284+ -> p (TraverseChild t m Int v')
1281 -- ^ Apply a patch to the DOM
1286 -- ^ Apply a patch to the DOM
1282− -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))
1287+ -> (IntMap.Key -> v -> HydrationDomBuilderT t m v')
1283− -> DMap k v
1288+ -> IntMap v
1284− -> Event t (p k v)
1289+ -> Event t (p v)
1285− -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))
1290+ -> HydrationDomBuilderT t m (IntMap v', Event t (p 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
1291+hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1287 doc <- askDocument
1292 doc <- askDocument
1288 initialEnv <- HydrationDomBuilderT ask
1293 initialEnv <- HydrationDomBuilderT ask
1289 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
1294 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
1291 haveEverBeenReady <- liftIO $ newIORef False
1296 haveEverBeenReady <- liftIO $ newIORef False
1292− placeholders <- liftIO $ newIORef Map.empty
1297+ placeholders <- liftIO $ newIORef IntMap.empty
1293 lastPlaceholder <- createTextNode doc ("" :: Text)
1298 lastPlaceholder <- createTextNode doc ("" :: Text)
1294 let applyDomUpdate p = do
1299 let applyDomUpdate p = do
1295 applyDomUpdate_ placeholders lastPlaceholder p
1300 applyDomUpdate_ placeholders lastPlaceholder p
@@ -1304,7 +1309,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
1304 let new = pred old
1309 let new = pred old
1305 liftIO $ writeIORef parentUnreadyChildren $! new
1310 liftIO $ writeIORef parentUnreadyChildren $! new
1306 when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
1311 when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
1307− markChildReady :: IORef (ChildReadyState k) -> JSM ()
1312+ markChildReady :: IORef (ChildReadyState Int) -> JSM ()
1308 markChildReady childReadyState = do
1313 markChildReady childReadyState = do
1309 liftIO (readIORef childReadyState) >>= \case
1314 liftIO (readIORef childReadyState) >>= \case
1310 ChildReadyState_Ready -> return ()
1315 ChildReadyState_Ready -> return ()
@@ -1312,135 +1317,123 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
1312 liftIO $ writeIORef childReadyState ChildReadyState_Ready
1317 liftIO $ writeIORef childReadyState ChildReadyState_Ready
1313 case countedAt of
1318 case countedAt of
1314 Nothing -> return ()
1319 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
1316 (oldUnready, p) <- liftIO $ readIORef pendingChange
1321 (oldUnready, p) <- liftIO $ readIORef pendingChange
1317− when (not $ DMap.null oldUnready) $ do -- This shouldn't actually ever be null
1322+ when (not $ IntMap.null oldUnready) $ do -- This shouldn't actually ever be null
1318− let newUnready = DMap.delete k oldUnready
1323+ let newUnready = IntMap.delete k oldUnready
1319 liftIO $ writeIORef pendingChange (newUnready, p)
1324 liftIO $ writeIORef pendingChange (newUnready, p)
1320− when (DMap.null newUnready) $ do
1325+ when (IntMap.null newUnready) $ do
1321 applyDomUpdate p
1326 applyDomUpdate p
1322− (children0 :: DMap k (Compose (TraverseDMapChild t m k) v'), children' :: Event t (p k (Compose (TraverseDMapChild t m k) v')))
1327+ (children0 :: IntMap (TraverseChild t m Int v'), children' :: Event t (p (TraverseChild t m Int v')))
1323− <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'
1328+ <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdateInt initialEnv markChildReady $ f k v) dm0 dm'
1324− let processChild k (Compose (TraverseDMapChild e _)) = case e of
1329+ let processChild k (TraverseChild e _) = case e of
1325− Left _ -> pure $ ComposeMaybe Nothing
1330+ Left _ -> pure Nothing
1326− Right immediate -> ComposeMaybe <$> do
1331+ Right immediate -> do
1327− readIORef (_traverseDMapChildImmediate_childReadyState immediate) >>= \case
1332+ readIORef (_traverseChildImmediate_childReadyState immediate) >>= \case
1328 ChildReadyState_Ready -> return Nothing
1333 ChildReadyState_Ready -> return Nothing
1329 ChildReadyState_Unready _ -> do
1334 ChildReadyState_Unready _ -> do
1330− writeIORef (_traverseDMapChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ Some.This k
1335+ writeIORef (_traverseChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just k
1331− return $ Just $ Constant (_traverseDMapChildImmediate_childReadyState immediate)
1336+ return $ Just (_traverseChildImmediate_childReadyState immediate)
1332− initialUnready <- liftIO $ DMap.mapMaybeWithKey (\_ -> getComposeMaybe) <$> DMap.traverseWithKey processChild children0
1337+ initialUnready <- liftIO $ IntMap.mapMaybe id <$> IntMap.traverseWithKey processChild children0
1333− liftIO $ if DMap.null initialUnready
1338+ liftIO $ if IntMap.null initialUnready
1334 then writeIORef haveEverBeenReady True
1339 then writeIORef haveEverBeenReady True
1336 modifyIORef' parentUnreadyChildren succ
1341 modifyIORef' parentUnreadyChildren succ
1337 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
1342 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
1338 getHydrationMode >>= \case
1343 getHydrationMode >>= \case
1339 HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do
1344 HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do
1340− dm :: DMap k (Compose (TraverseDMapChild t m k) v') <- sample $ currentIncremental children
1345+ dm :: IntMap (TraverseChild t m Int v') <- sample $ currentIncremental children
1341− phs <- traverse id $ weakenDMapWith (either _traverseDMapChildHydration_delayed (pure . _traverseDMapChildImmediate_placeholder) . _traverseDMapChild_mode . getCompose) dm
1346+ phs <- traverse (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode) dm
1342 liftIO $ writeIORef placeholders $! phs
1347 liftIO $ writeIORef placeholders $! phs
1343 insertAfterPreviousNode lastPlaceholder
1348 insertAfterPreviousNode lastPlaceholder
1344 HydrationMode_Immediate -> do
1349 HydrationMode_Immediate -> do
1345 let activate i = do
1350 let activate i = do
1346− append $ toNode $ _traverseDMapChildImmediate_fragment i
1351+ append $ toNode $ _traverseChildImmediate_fragment i
1347− pure $ _traverseDMapChildImmediate_placeholder i
1352+ pure $ _traverseChildImmediate_placeholder i
1348− phs <- traverse id $ weakenDMapWith ((either (error "delayed") activate) . _traverseDMapChild_mode . getCompose) children0
1353+ phs <- traverse ((either (error "delayed") activate) . _traverseChild_mode) children0
1349 liftIO $ writeIORef placeholders $! phs
1354 liftIO $ writeIORef placeholders $! phs
1350 append $ toNode lastPlaceholder
1355 append $ toNode lastPlaceholder
1352 requestDomAction_ $ ffor children' $ \p -> do
1356 requestDomAction_ $ ffor children' $ \p -> do
1353 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1357 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
1354 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
1358 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
1355 let !newP = p <> oldP
1359 let !newP = p <> oldP
1356 liftIO $ writeIORef pendingChange (newUnready, newP)
1360 liftIO $ writeIORef pendingChange (newUnready, newP)
1357− when (DMap.null newUnready) $ do
1361+ when (IntMap.null newUnready) $ do
1358 applyDomUpdate newP
1362 applyDomUpdate newP
1359− let result0 = DMap.map (_traverseDMapChild_result . getCompose) children0
1363+ let result0 = IntMap.map (_traverseChild_result) children0
1360− result' = ffor children' $ mapPatch $ _traverseDMapChild_result . getCompose
1364+ result' = ffor children' $ fmap $ _traverseChild_result
1361 return (result0, result')
1365 return (result0, result')
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)
1375+newtype TraverseChildHydration t m = TraverseChildHydration
1376+ { _traverseChildHydration_delayed :: HydrationRunnerT t m DOM.Text
1377+ -- ^ Action to run at switchover, returns the placeholder
1380+data TraverseChild t m k a = TraverseChild
1381+ { _traverseChild_mode :: Either (TraverseChildHydration t m) (TraverseChildImmediate k)
1382+ , _traverseChild_result :: a
1363{-# INLINABLE drawChildUpdate #-}
1385{-# INLINABLE drawChildUpdate #-}
1364drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)
1386drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)
1365 => HydrationDomBuilderEnv t
1387 => HydrationDomBuilderEnv t
1366 -> (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
1388 -> (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)
1389+ -> HydrationDomBuilderT t m (f a)
1368− -> DomRenderHookT t m (Compose (TraverseDMapChild t m k) v' 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
1369−drawChildUpdate initialEnv markReady child = liftIO (readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv) >>= \case
1394+ liftIO (readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv) >>= \case
1370− HydrationMode_Hydrating -> do
1395+ HydrationMode_Hydrating -> do
1371− let doc = _hydrationDomBuilderEnv_document initialEnv
1372− unreadyChildren <- liftIO $ newIORef 0
1373− (result, childDelayed) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1396+ (result, childDelayed) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1374− { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1397+ { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1377− placeholder <- createTextNode doc ("" :: Text)
1378− insertAfterPreviousNode placeholder
1380− return $ Compose $ TraverseDMapChild
1381− { _traverseDMapChild_result = result
1382− , _traverseDMapChild_mode = Left TraverseDMapChildHydration
1383− { _traverseDMapChildHydration_delayed = delayed <* childDelayed
1385− }
1399+ return $ Compose $ TraverseChild
1386− HydrationMode_Immediate -> do
1400+ { _traverseChild_result = result
1387− childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
1401+ , _traverseChild_mode = Left TraverseChildHydration
1388− let doc = _hydrationDomBuilderEnv_document initialEnv
1402+ { _traverseChildHydration_delayed = do
1389− unreadyChildren <- liftIO $ newIORef 0
1390− df <- createDocumentFragment doc
1391− placeholder <- createTextNode doc ("" :: Text)
1403+ placeholder <- createTextNode doc ("" :: Text)
1392− Node.appendChild_ df placeholder
1404+ insertAfterPreviousNode placeholder
1393− parentRef <- liftIO . newIORef $ toNode df
1405+ childDelayed
1394− (result, _s) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1406+ pure placeholder
1395− { _hydrationDomBuilderEnv_parent = parentRef
1396− , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1397− , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
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
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
1427 HydrationMode_Immediate -> do
1409 HydrationMode_Immediate -> do
1410+ childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
1428 df <- createDocumentFragment doc
1411 df <- createDocumentFragment doc
1412+ placeholder <- createTextNode doc ("" :: Text)
1429 Node.appendChild_ df placeholder
1413 Node.appendChild_ df placeholder
1430− pure (Right df, pure ())
1431− p' <- either pure (liftIO . newIORef . toNode) p
1414+ parentRef <- liftIO . newIORef $ toNode df
1432− (result, finalState) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1415+ (result, _s) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv
1433− { _hydrationDomBuilderEnv_parent = p'
1416+ { _hydrationDomBuilderEnv_parent = parentRef
1434 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1417 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
1435 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1418 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
1437− u <- liftIO $ readIORef unreadyChildren
1420+ u <- liftIO $ readIORef unreadyChildren
1438− when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready
1421+ when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
1439− return
1422+ return $ Compose $ TraverseChild
1440− ( delayed >> finalState
1423+ { _traverseChild_result = result
1441− , either (const $ error "drawChildUpdateInt: Tried to use document fragment in hydration mode") id p
1424+ , _traverseChild_mode = Right TraverseChildImmediate
1442− , placeholder, childReadyState, result
1425+ { _traverseChildImmediate_fragment = df
1443− )
1426+ , _traverseChildImmediate_placeholder = placeholder
1427+ , _traverseChildImmediate_childReadyState = childReadyState
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)
1445instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where
1438instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where
1446 type Performable (HydrationDomBuilderT t m) = Performable m
1439 type Performable (HydrationDomBuilderT t m) = Performable m