42d55e3 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Fixes for Adjustable

42d55e3Tom Smalley8 years ago

reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+147−102

compare with develop

unifiedsplit

@@ -189,11 +189,11 @@ addHydrationStepWithSetup setup f = getHydrationMode >>= \case

189 HydrationDomBuilderT $ modify' (>> f s)

190

191-- | Add a hydration step

192+addHydrationStep

192−addHydrationStep :: (MonadIO m, Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m)) => HydrationRunnerT t m () -> HydrationDomBuilderT t m ()

193+ :: (MonadIO m, Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))

194+ => HydrationRunnerT t m () -> HydrationDomBuilderT t m ()

193addHydrationStep m = getHydrationMode >>= \case

195addHydrationStep m = getHydrationMode >>= \case

194− HydrationMode_Immediate -> do

195− events <- askEvents

196− lift $ runHydrationRunnerT m Nothing undefined events

196+ HydrationMode_Immediate -> lift . runHydrationRunnerT m Nothing undefined =<< askEvents

197 HydrationMode_Hydrating -> HydrationDomBuilderT $ modify' (>> m)

198

199-- | A monad for DomBuilder which just gets the results of children and pushes

@@ -893,7 +893,7 @@ instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjus

893 traverseDMapWithKeyWithAdjust f m = DomRenderHookT . traverseDMapWithKeyWithAdjust (\k -> unDomRenderHookT . f k) m

894 traverseDMapWithKeyWithAdjustWithMove f m = DomRenderHookT . traverseDMapWithKeyWithAdjustWithMove (\k -> unDomRenderHookT . f k) m

895

896−instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, Ref m ~ IORef, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadRef m) => Adjustable t (HydrationDomBuilderT t m) where

896+instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m) => Adjustable t (HydrationDomBuilderT t m) where

897 {-# INLINABLE runWithReplace #-}

898 runWithReplace a0 a' = do

899 initialEnv <- HydrationDomBuilderT ask

@@ -983,15 +983,15 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

983 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'

984 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}

985 traverseDMapWithKeyWithAdjustWithMove = do

986− let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do

986+ let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose (TraverseDMapChild t m k) v')) old = do

987− let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState k))) a)

987+ let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseDMapChild t m k) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState k))) a)

988 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case

989− PatchDMapWithMove.From_Insert (Compose (_, _, _, sRef, _)) -> do

989+ PatchDMapWithMove.From_Insert (Compose (TraverseDMapChild (Right myTypeImmediate) _)) -> do

990− readIORef sRef >>= \case

990+ readIORef (_traverseDMapChildImmediate_childReadyState myTypeImmediate) >>= \case

991 ChildReadyState_Ready -> return PatchDMapWithMove.From_Delete

992 ChildReadyState_Unready _ -> do

993− writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k

993+ writeIORef (_traverseDMapChildImmediate_childReadyState myTypeImmediate) $ ChildReadyState_Unready $ Just $ Some.This k

994− return $ PatchDMapWithMove.From_Insert $ Constant sRef

994+ return $ PatchDMapWithMove.From_Insert $ Constant (_traverseDMapChildImmediate_childReadyState myTypeImmediate)

995 PatchDMapWithMove.From_Delete -> return PatchDMapWithMove.From_Delete

996 PatchDMapWithMove.From_Move fromKey -> return $ PatchDMapWithMove.From_Move fromKey

997 deleteOrMove :: forall a. k a -> Product (Constant (IORef (ChildReadyState k))) (ComposeMaybe k) a -> IO (Constant () a)

@@ -1001,11 +1001,10 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

1001 p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p

1002 _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old

1003 return $ applyAlways p' old

1004− hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholderRef (p_ :: PatchDMapWithMove k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) -> do

1004+ hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholder (p_ :: PatchDMapWithMove k (Compose (TraverseDMapChild t m k) v')) -> do

1005 let p = unPatchDMapWithMove p_

1006 phsBefore <- liftIO $ readIORef placeholders

1007− lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef

1008− let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)

1007+ let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseDMapChild t m k) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)

1009 collectIfMoved k e = do

1008 collectIfMoved k e = do

1010 let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before

1009 let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before

1011 nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore

1010 nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore

@@ -1016,13 +1015,14 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

1016 True -> do

1015 True -> do

1017 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder

1016 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder

1018 collected <- DMap.traverseWithKey collectIfMoved p

1017 collected <- DMap.traverseWithKey collectIfMoved p

1019− let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (\(Compose (_, _, ph, _, _)) -> ph) p_) phsBefore --TODO: Don't recompute this

1018+ let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (_traverseDMapChildImmediate_placeholder . error "FIXME" . _traverseDMapChild_mode . getCompose) p_) phsBefore --TODO: Don't recompute this

1020− let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> JSM (Constant () a)

1019+ let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseDMapChild t m k) v') a -> JSM (Constant () a)

1021 placeFragment k e = do

1020 placeFragment k e = do

1022 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter

1021 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter

1023 case PatchDMapWithMove._nodeInfo_from e of

1022 case PatchDMapWithMove._nodeInfo_from e of

1024− PatchDMapWithMove.From_Insert (Compose (_, df, _, _, _)) -> do

1023+ PatchDMapWithMove.From_Insert (Compose (TraverseDMapChild x _)) -> case x of

1024+ Left _ -> pure ()

1025− df `insertBefore` nextPlaceholder

1025+ Right immediate -> _traverseDMapChildImmediate_fragment immediate `insertBefore` nextPlaceholder

1026 PatchDMapWithMove.From_Delete -> do

1027 return ()

1028 PatchDMapWithMove.From_Move fromKey -> do

@@ -1034,40 +1034,54 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

1034

1035{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}

1036traverseDMapWithKeyWithAdjust'

1037− :: forall t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadIO m, MonadJSM m, PrimMonad m, DMap.GCompare k)

1037+ :: forall t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, PrimMonad m, DMap.GCompare k)

1038 => (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))

1039 -> DMap k v

1040 -> Event t (PatchDMap k v)

1041 -> HydrationDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))

1042traverseDMapWithKeyWithAdjust' = do

1043− let updateChildUnreadiness (p :: PatchDMap k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do

1043+ let updateChildUnreadiness (p :: PatchDMap k (Compose (TraverseDMapChild t m k) v')) old = do

1044− let new :: forall a. k a -> ComposeMaybe (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState k))) a)

1044+ let new :: forall a. k a -> ComposeMaybe (Compose (TraverseDMapChild t m k) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState k))) a)

1045 new k (ComposeMaybe m) = ComposeMaybe <$> case m of

1046 Nothing -> return Nothing

1047− Just (Compose (_, _, _, sRef, _)) -> do

1047+ Just (Compose (TraverseDMapChild (Left hydration) _)) -> pure Nothing

1048− readIORef sRef >>= \case

1048+ Just (Compose (TraverseDMapChild (Right immediate) _)) -> do

1049+ readIORef (_traverseDMapChildImmediate_childReadyState immediate) >>= \case

1049 ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready

1050 ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready

1050 ChildReadyState_Unready _ -> do

1051 ChildReadyState_Unready _ -> do

1051− writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k

1052+ writeIORef (_traverseDMapChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ Some.This k

1052− return $ Just $ Constant sRef

1053+ return $ Just $ Constant (_traverseDMapChildImmediate_childReadyState immediate)

1053 delete _ (Constant sRef) = do

1054 delete _ (Constant sRef) = do

1054 writeIORef sRef $ ChildReadyState_Unready Nothing

1055 writeIORef sRef $ ChildReadyState_Unready Nothing

1055 return $ Constant ()

1056 return $ Constant ()

1056 p' <- fmap PatchDMap $ DMap.traverseWithKey new $ unPatchDMap p

1057 p' <- fmap PatchDMap $ DMap.traverseWithKey new $ unPatchDMap p

1057 _ <- DMap.traverseWithKey delete $ PatchDMap.getDeletions p old

1058 _ <- DMap.traverseWithKey delete $ PatchDMap.getDeletions p old

1058 return $ applyAlways p' old

1059 return $ applyAlways p' old

1059− hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap updateChildUnreadiness $ \placeholders lastPlaceholderRef (PatchDMap p) -> do

1060+ hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap updateChildUnreadiness $ \placeholders lastPlaceholder (PatchDMap patch) -> do

1060 phs <- liftIO $ readIORef placeholders

1061 phs <- liftIO $ readIORef placeholders

1061− forM_ (DMap.toList p) $ \(k :=> ComposeMaybe mv) -> do

1062+ forM_ (DMap.toList patch) $ \(k :=> ComposeMaybe mv) -> do

1062− lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef

1063 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phs

1064+ -- Delete old node

1064− forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder

1065+ forM_ (Map.lookup (Some.This k) phs) $ \thisPlaceholder -> do

1066+ thisPlaceholder `deleteUpTo` nextPlaceholder

1067+ -- Insert new node

1068+ forM_ mv $ \(Compose (TraverseDMapChild e _)) -> case e of

1069+ Left _hydration -> pure ()

1070+ Right immediate -> do

1065− forM_ mv $ \(Compose (_, df, _, _, _)) -> df `insertBefore` nextPlaceholder

1071+ _traverseDMapChildImmediate_fragment immediate `insertBefore` nextPlaceholder

1072+ let weakened :: PatchMap (Some.Some k) (Either (TraverseDMapChildHydration t m) (TraverseDMapChildImmediate k))

1073+ weakened = weakenPatchDMapWith (_traverseDMapChild_mode . getCompose) $ PatchDMap patch

1074+ filtered :: PatchMap (Some.Some k) DOM.Text

1075+ filtered = PatchMap $ flip Map.mapMaybe (unPatchMap weakened) $ \case

1076+ Nothing -> Just Nothing -- deletion

1077+ Just (Left _) -> Nothing

1078+ Just (Right immediate) -> Just $ Just $ _traverseDMapChildImmediate_placeholder immediate

1079+ a = apply filtered phs

1066− liftIO $ writeIORef placeholders $! fromMaybe phs $ apply (weakenPatchDMapWith (\(Compose (_, _, ph, _, _)) -> ph) $ PatchDMap p) phs

1080+ liftIO $ writeIORef placeholders $! fromMaybe phs a

1067

1081

1068{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}

1082{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}

1069traverseIntMapWithKeyWithAdjust'

1083traverseIntMapWithKeyWithAdjust'

1070− :: forall t m v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadIO m, MonadJSM m, PrimMonad m)

1084+ :: forall t m v v'. (Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m, MonadHold t m)

1071 => (IntMap.Key -> v -> HydrationDomBuilderT t m v')

1085 => (IntMap.Key -> v -> HydrationDomBuilderT t m v')

1072 -> IntMap v

1086 -> IntMap v

1073 -> Event t (PatchIntMap v)

1087 -> Event t (PatchIntMap v)

@@ -1101,14 +1115,13 @@ traverseIntMapWithKeyWithAdjust' = do

1101{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}

1115{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}

1102hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.

1116hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.

1103 ( Adjustable t m

1117 ( Adjustable t m

1104− , MonadIO m

1118+ , MonadHold t m

1105 , MonadJSM m

1119 , MonadJSM m

1106 , MonadFix m

1120 , MonadFix m

1107 , PrimMonad m

1121 , PrimMonad m

1108 , Monoid (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))

1122 , Monoid (p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))

1109 , Functor p

1123 , Functor p

1110 , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())

1124 , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())

1111− , MonadHold t m

1112 , Patch (p (HydrationRunnerT t m ()))

1125 , Patch (p (HydrationRunnerT t m ()))

1113 )

1126 )

1114 => ( (IntMap.Key -> v -> DomRenderHookT t m (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))

1127 => ( (IntMap.Key -> v -> DomRenderHookT t m (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))

@@ -1123,7 +1136,6 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.

1123 -> Event t (p v)

1136 -> Event t (p v)

1124 -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))

1137 -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))

1125hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do

1138hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do

1126− (_hydrateStart, _, key) <- skipToReplaceStart

1127 initialEnv <- HydrationDomBuilderT ask

1139 initialEnv <- HydrationDomBuilderT ask

1128 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1140 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1129 pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty

1141 pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty

@@ -1190,7 +1202,6 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

1190 getHydrationMode >>= \case

1202 getHydrationMode >>= \case

1191 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0

1203 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0

1192 _ -> pure ()

1204 _ -> pure ()

1193− (_hydrateEnd, _lastPlaceholderRef) <- skipToReplaceEnd key

1194 requestDomAction_ $ ffor children' $ \p -> do

1205 requestDomAction_ $ ffor children' $ \p -> do

1195 (oldUnready, oldP) <- liftIO $ readIORef pendingChange

1206 (oldUnready, oldP) <- liftIO $ readIORef pendingChange

1196 newUnready <- liftIO $ updateChildUnreadiness p oldUnready

1207 newUnready <- liftIO $ updateChildUnreadiness p oldUnready

@@ -1207,6 +1218,24 @@ insertAfterPreviousNode node = do

1207 Node.insertBefore_ parent node nextNode

1218 Node.insertBefore_ parent node nextNode

1208 setPreviousNode $ Just $ toNode node

1219 setPreviousNode $ Just $ toNode node

1209

1220

1221+data TraverseDMapChildImmediate k = TraverseDMapChildImmediate

1222+ { _traverseDMapChildImmediate_fragment :: DOM.DocumentFragment

1223+ -- ^ Child is appended to this fragment

1224+ , _traverseDMapChildImmediate_placeholder :: DOM.Text

1225+ -- ^ Placeholder reference

1226+ , _traverseDMapChildImmediate_childReadyState :: IORef (ChildReadyState k)

1227+ }

1228+

1229+newtype TraverseDMapChildHydration t m = TraverseDMapChildHydration

1230+ { _traverseDMapChildHydration_delayed :: HydrationRunnerT t m DOM.Text

1231+ -- ^ Action to run at switchover, returns the placeholder

1232+ }

1233+

1234+data TraverseDMapChild t m k a = TraverseDMapChild

1235+ { _traverseDMapChild_mode :: Either (TraverseDMapChildHydration t m) (TraverseDMapChildImmediate k)

1236+ , _traverseDMapChild_result :: a

1237+ }

1238+

1210{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}

1239{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}

1211hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

1240hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

1212 ( Adjustable t m

1241 ( Adjustable t m

@@ -1217,35 +1246,39 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

1217 , PrimMonad m

1246 , PrimMonad m

1218 , MonadFix m

1247 , MonadFix m

1219 , Patch (p k v)

1248 , Patch (p k v)

1220− , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)

1221− , Patch (p k (Const (HydrationRunnerT t m ())))

1222− , PatchTarget (p k (Const (HydrationRunnerT t m ()))) ~ DMap k (Const (HydrationRunnerT t m ()))

1223− , Monoid (p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))

1224 , Patch (p k (Constant Int))

1249 , Patch (p k (Constant Int))

1250+ , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)

1251+ , Patch (p k (Compose (TraverseDMapChild t m k) v'))

1252+ , PatchTarget (p k (Compose (TraverseDMapChild t m k) v')) ~ DMap k (Compose (TraverseDMapChild t m k) v')

1253+ , Monoid (p k (Compose (TraverseDMapChild t m k) v'))

1225 )

1254 )

1226 => (forall vv vv'.

1255 => (forall vv vv'.

1227 (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))

1256 (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))

1228 -> DMap k vv

1257 -> DMap k vv

1229 -> Event t (p k vv)

1258 -> Event t (p k vv)

1230 -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))

1259 -> DomRenderHookT t m (DMap k vv', Event t (p k vv'))

1260+ )

1231− ) -- ^ The base monad's traversal

1261+ -- ^ The base monad's traversal

1232− -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type

1262+ -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv')

1263+ -- ^ A way of mapping over the patch type

1264+ -> (p k (Compose (TraverseDMapChild t m k) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k)))))

1233− -> (p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> DMap k (Constant (IORef (ChildReadyState k))) -> IO (DMap k (Constant (IORef (ChildReadyState k))))) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state

1265+ -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state

1234− -> (IORef (Map.Map (Some.Some k) DOM.Text) -> IORef DOM.Text -> p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> JSM ()) -- ^ Apply a patch to the DOM

1266+ -> (IORef (Map.Map (Some.Some k) DOM.Text) -> DOM.Text -> p k (Compose (TraverseDMapChild t m k) v') -> JSM ())

1267+ -- ^ Apply a patch to the DOM

1235 -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))

1268 -> (forall a. k a -> v a -> HydrationDomBuilderT t m (v' a))

1236 -> DMap k v

1269 -> DMap k v

1237 -> Event t (p k v)

1270 -> Event t (p k v)

1238 -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))

1271 -> HydrationDomBuilderT t m (DMap k v', Event t (p k v'))

1239hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ (f :: forall a. k a -> v a -> HydrationDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do

1272hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ (f :: forall a. k a -> v a -> HydrationDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do

1240−-- (hydrateStart, _, key) <- skipToReplaceStart -- TODO

1273+ doc <- askDocument

1241 initialEnv <- HydrationDomBuilderT ask

1274 initialEnv <- HydrationDomBuilderT ask

1242 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1275 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1243− pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) <- liftIO $ newIORef mempty

1276+ pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose (TraverseDMapChild t m k) v')) <- liftIO $ newIORef mempty

1244 haveEverBeenReady <- liftIO $ newIORef False

1277 haveEverBeenReady <- liftIO $ newIORef False

1245− placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"

1278+ placeholders <- liftIO $ newIORef Map.empty

1246− lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"

1279+ lastPlaceholder <- createTextNode doc ("" :: Text)

1247 let applyDomUpdate p = do

1280 let applyDomUpdate p = do

1248− applyDomUpdate_ placeholders lastPlaceholderRef p

1281+ applyDomUpdate_ placeholders lastPlaceholder p

1249 markSelfReady

1282 markSelfReady

1250 liftIO $ writeIORef pendingChange $! mempty

1283 liftIO $ writeIORef pendingChange $! mempty

1251 markSelfReady = do

1284 markSelfReady = do

@@ -1272,38 +1305,36 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

1272 liftIO $ writeIORef pendingChange (newUnready, p)

1305 liftIO $ writeIORef pendingChange (newUnready, p)

1273 when (DMap.null newUnready) $ do

1306 when (DMap.null newUnready) $ do

1274 applyDomUpdate p

1307 applyDomUpdate p

1308+ (children0 :: DMap k (Compose (TraverseDMapChild t m k) v'), children' :: Event t (p k (Compose (TraverseDMapChild t m k) v')))

1275− (children0, children') <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'

1309+ <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'

1276− let processChild k (Compose (_, _, _, sRef, _)) = ComposeMaybe <$> do

1310+ let processChild k (Compose (TraverseDMapChild e _)) = case e of

1277− readIORef sRef >>= \case

1311+ Left _ -> pure $ ComposeMaybe Nothing

1312+ Right immediate -> ComposeMaybe <$> do

1313+ readIORef (_traverseDMapChildImmediate_childReadyState immediate) >>= \case

1278− ChildReadyState_Ready -> return Nothing

1314+ ChildReadyState_Ready -> return Nothing

1279− ChildReadyState_Unready _ -> do

1315+ ChildReadyState_Unready _ -> do

1280− writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k

1316+ writeIORef (_traverseDMapChildImmediate_childReadyState immediate) $ ChildReadyState_Unready $ Just $ Some.This k

1281− return $ Just $ Constant sRef

1317+ return $ Just $ Constant (_traverseDMapChildImmediate_childReadyState immediate)

1282 initialUnready <- liftIO $ DMap.mapMaybeWithKey (\_ -> getComposeMaybe) <$> DMap.traverseWithKey processChild children0

1318 initialUnready <- liftIO $ DMap.mapMaybeWithKey (\_ -> getComposeMaybe) <$> DMap.traverseWithKey processChild children0

1283 liftIO $ if DMap.null initialUnready

1319 liftIO $ if DMap.null initialUnready

1284 then writeIORef haveEverBeenReady True

1320 then writeIORef haveEverBeenReady True

1285 else do

1321 else do

1286 modifyIORef' parentUnreadyChildren succ

1322 modifyIORef' parentUnreadyChildren succ

1287 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time

1323 writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time

1288− let result0 = DMap.map (\(Compose (_, _, _, _, v)) -> v) children0

1289− placeholders0 = weakenDMapWith (\(Compose (_, _, ph, _, _)) -> ph) children0

1290− delayed0 :: DMap k (Const (HydrationRunnerT t m ()))

1291− delayed0 = DMap.map (\(Compose (delayed, _, _, _, _)) -> Const delayed) children0

1292− delayed' :: Event t (p k (Const (HydrationRunnerT t m ())))

1293− delayed' = ffor children' $ mapPatch $ \(Compose (d, _, _, _, _)) -> Const d

1294− result' = ffor children' $ mapPatch $ \(Compose (_, _, _, _, r)) -> r

1295− doc <- askDocument

1296− let setFinalPlaceholder = do

1297− ph <- createTextNode doc ("" :: Text)

1298− insertAfterPreviousNode ph

1299− liftIO $ writeIORef lastPlaceholderRef ph

1300− addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do

1301− _ <- join $ sample (traverse (\(_ :=> Const d) -> d) . DMap.toList <$> delayed)

1302− setFinalPlaceholder

1303− liftIO $ writeIORef placeholders $! placeholders0

1304 getHydrationMode >>= \case

1324 getHydrationMode >>= \case

1305− HydrationMode_Immediate -> void $ DMap.traverseWithKey (\_ (Compose (_, df, _, _, _)) -> Constant () <$ append (toNode df)) children0

1325+ HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do

1306− _ -> pure ()

1326+ dm :: DMap k (Compose (TraverseDMapChild t m k) v') <- sample $ currentIncremental children

1327+ phs <- traverse id $ weakenDMapWith (either _traverseDMapChildHydration_delayed (pure . _traverseDMapChildImmediate_placeholder) . _traverseDMapChild_mode . getCompose) dm

1328+ liftIO $ writeIORef placeholders $! phs

1329+ insertAfterPreviousNode lastPlaceholder

1330+ HydrationMode_Immediate -> do

1331+ let activate i = do

1332+ append $ toNode $ _traverseDMapChildImmediate_fragment i

1333+ pure $ _traverseDMapChildImmediate_placeholder i

1334+ phs <- traverse id $ weakenDMapWith ((either (error "delayed") activate) . _traverseDMapChild_mode . getCompose) children0

1335+ liftIO $ writeIORef placeholders $! phs

1336+ append $ toNode lastPlaceholder

1337+

1307 requestDomAction_ $ ffor children' $ \p -> do

1338 requestDomAction_ $ ffor children' $ \p -> do

1308 (oldUnready, oldP) <- liftIO $ readIORef pendingChange

1339 (oldUnready, oldP) <- liftIO $ readIORef pendingChange

1309 newUnready <- liftIO $ updateChildUnreadiness p oldUnready

1340 newUnready <- liftIO $ updateChildUnreadiness p oldUnready

@@ -1311,6 +1342,8 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

1311 liftIO $ writeIORef pendingChange (newUnready, newP)

1342 liftIO $ writeIORef pendingChange (newUnready, newP)

1312 when (DMap.null newUnready) $ do

1343 when (DMap.null newUnready) $ do

1313 applyDomUpdate newP

1344 applyDomUpdate newP

1345+ let result0 = DMap.map (_traverseDMapChild_result . getCompose) children0

1346+ result' = ffor children' $ mapPatch $ _traverseDMapChild_result . getCompose

1314 return (result0, result')

1347 return (result0, result')

1315

1348

1316{-# INLINABLE drawChildUpdate #-}

1349{-# INLINABLE drawChildUpdate #-}

@@ -1318,35 +1351,47 @@ drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)

1318 => HydrationDomBuilderEnv t

1351 => HydrationDomBuilderEnv t

1319 -> (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

1352 -> (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

1320 -> HydrationDomBuilderT t m (v' a)

1353 -> HydrationDomBuilderT t m (v' a)

1321− -> DomRenderHookT t m (Compose ((,,,,) (HydrationRunnerT t m ()) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)

1354+ -> DomRenderHookT t m (Compose (TraverseDMapChild t m k) v' a)

1322−drawChildUpdate initialEnv markReady child = do

1323− childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

1324− let doc = _hydrationDomBuilderEnv_document initialEnv

1325− unreadyChildren <- liftIO $ newIORef 0

1326− hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv

1355+drawChildUpdate initialEnv markReady child = liftIO (readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv) >>= \case

1327− placeholder <- createTextNode doc ("" :: Text)

1328− (p, delayed) <- case hydrationMode of

1329− HydrationMode_Hydrating -> pure

1356+ HydrationMode_Hydrating -> do

1330− ( Left $ _hydrationDomBuilderEnv_parent initialEnv

1357+ let doc = _hydrationDomBuilderEnv_document initialEnv

1331− , insertAfterPreviousNode placeholder

1332− )

1333− HydrationMode_Immediate -> do

1334− df <- createDocumentFragment doc

1335− Node.appendChild_ df placeholder

1336− pure (Right df, pure ())

1337− p' <- either pure (liftIO . newIORef . toNode) p

1358+ unreadyChildren <- liftIO $ newIORef 0

1338− (result, finalState) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv

1359+ (result, childDelayed) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv

1339− { _hydrationDomBuilderEnv_parent = p'

1340− , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1360+ { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1341− , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

1361+ }

1362+ let delayed = do

1363+ placeholder <- createTextNode doc ("" :: Text)

1364+ insertAfterPreviousNode placeholder

1365+ pure placeholder

1366+ return $ Compose $ TraverseDMapChild

1367+ { _traverseDMapChild_result = result

1368+ , _traverseDMapChild_mode = Left TraverseDMapChildHydration

1369+ { _traverseDMapChildHydration_delayed = delayed <* childDelayed

1342 }

1370 }

1371+ }

1372+ HydrationMode_Immediate -> do

1373+ childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

1374+ let doc = _hydrationDomBuilderEnv_document initialEnv

1375+ unreadyChildren <- liftIO $ newIORef 0

1376+ df <- createDocumentFragment doc

1377+ placeholder <- createTextNode doc ("" :: Text)

1378+ Node.appendChild_ df placeholder

1379+ parentRef <- liftIO . newIORef $ toNode df

1380+ (result, _s) <- flip runStateT (pure ()) $ runReaderT (unHydrationDomBuilderT child) initialEnv

1381+ { _hydrationDomBuilderEnv_parent = parentRef

1382+ , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1383+ , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

1384+ }

1343− u <- liftIO $ readIORef unreadyChildren

1385+ u <- liftIO $ readIORef unreadyChildren

1344− when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready

1386+ when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready

1345− return $ Compose

1387+ return $ Compose $ TraverseDMapChild

1346− ( delayed >> finalState

1388+ { _traverseDMapChild_result = result

1347− , either (const $ error "drawChildUpdate: Tried to use document fragment in hydration mode") id p

1389+ , _traverseDMapChild_mode = Right TraverseDMapChildImmediate

1348− , placeholder, childReadyState, result

1390+ { _traverseDMapChildImmediate_fragment = df

1349− )

1391+ , _traverseDMapChildImmediate_placeholder = placeholder

1392+ , _traverseDMapChildImmediate_childReadyState = childReadyState

1393+ }

1394+ }

1350

1395

1351{-# INLINABLE drawChildUpdateInt #-}

1396{-# INLINABLE drawChildUpdateInt #-}

1352drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)

1397drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)

reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+1−4

@@ -174,6 +174,7 @@ instance (Reflex t, Adjustable t m, MonadHold t m, SupportsStaticDomBuilder t m)

174 traverseDMapWithKeyWithAdjust = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap

175 traverseDMapWithKeyWithAdjustWithMove = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove

176

177+-- TODO remove this?

177replaceStart :: (DomBuilder t m, MonadIO m) => m Text

178replaceStart :: (DomBuilder t m, MonadIO m) => m Text

178replaceStart = do

179replaceStart = do

179 str <- liftIO $ replicateM 8 $ randomRIO ('a', 'z')

180 str <- liftIO $ replicateM 8 $ randomRIO ('a', 'z')

@@ -203,7 +204,6 @@ hoistIntMapWithKeyWithAdjust :: forall t m p a b.

203 -> Event t (p a)

204 -> Event t (p a)

204 -> StaticDomBuilderT t m (IntMap b, Event t (p b))

205 -> StaticDomBuilderT t m (IntMap b, Event t (p b))

205hoistIntMapWithKeyWithAdjust base f im0 im' = do

206hoistIntMapWithKeyWithAdjust base f im0 im' = do

206− key <- replaceStart

207 e <- StaticDomBuilderT ask

208 (children0, children') <- lift $ base (\k v -> runStaticDomBuilderT (f k v) e) im0 im'

209 let result0 = IntMap.map fst children0

@@ -217,7 +217,6 @@ hoistIntMapWithKeyWithAdjust base f im0 im' = do

217 os <- sample $ currentIncremental outputs

218 fmap mconcat $ forM (IntMap.toList os) $ \(_, o) -> do

219 sample o

220− replaceEnd key

221 return (result0, result')

220 return (result0, result')

222

221

223hoistDMapWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

222hoistDMapWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

@@ -239,7 +238,6 @@ hoistDMapWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

239 -> Event t (p k v)

238 -> Event t (p k v)

240 -> StaticDomBuilderT t m (DMap k v', Event t (p k v'))

239 -> StaticDomBuilderT t m (DMap k v', Event t (p k v'))

241hoistDMapWithKeyWithAdjust base mapPatch f dm0 dm' = do

240hoistDMapWithKeyWithAdjust base mapPatch f dm0 dm' = do

242−-- key <- replaceStart

243 e <- StaticDomBuilderT ask

241 e <- StaticDomBuilderT ask

244 (children0, children') <- lift $ base (\k v -> fmap (Compose . swap) (runStaticDomBuilderT (f k v) e)) dm0 dm'

242 (children0, children') <- lift $ base (\k v -> fmap (Compose . swap) (runStaticDomBuilderT (f k v) e)) dm0 dm'

245 let result0 = DMap.map (snd . getCompose) children0

243 let result0 = DMap.map (snd . getCompose) children0

@@ -253,7 +251,6 @@ hoistDMapWithKeyWithAdjust base mapPatch f dm0 dm' = do

253 os <- sample $ currentIncremental outputs

251 os <- sample $ currentIncremental outputs

254 fmap mconcat $ forM (DMap.toList os) $ \(_ :=> Constant o) -> do

252 fmap mconcat $ forM (DMap.toList os) $ \(_ :=> Constant o) -> do

255 sample o

253 sample o

256−-- replaceEnd key

257 return (result0, result')

254 return (result0, result')

258

255

259instance SupportsStaticDomBuilder t m => NotReady t (StaticDomBuilderT t m) where

256instance SupportsStaticDomBuilder t m => NotReady t (StaticDomBuilderT t m) where