3a854c3 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Rest of Adjustable, barring existing bugs

3a854c3Tom Smalley8 years ago

reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+80−62

compare with develop

unifiedsplit

@@ -112,6 +112,7 @@ import Control.Monad.Primitive

112import Control.Monad.Reader

113import Control.Monad.Ref

114import Control.Monad.State.Strict

115+import Control.Monad.Trans.Maybe

115#ifndef USE_TEMPLATE_HASKELL

116#ifndef USE_TEMPLATE_HASKELL

116import Data.Functor.Contravariant (phantom)

117import Data.Functor.Contravariant (phantom)

117#endif

118#endif

@@ -1077,11 +1078,11 @@ traverseIntMapWithKeyWithAdjust'

1077 -> Event t (PatchIntMap v)

1078 -> Event t (PatchIntMap v)

1078 -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))

1079 -> HydrationDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))

1079traverseIntMapWithKeyWithAdjust' = do

1080traverseIntMapWithKeyWithAdjust' = do

1080− let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do

1081+ let updateChildUnreadiness (p@(PatchIntMap pInner) :: PatchIntMap (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) old = do

1081− let new :: IntMap.Key -> Maybe (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))

1082+ let new :: IntMap.Key -> Maybe (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> IO (Maybe (IORef ChildReadyStateInt))

1082 new k m = case m of

1083 new k m = case m of

1083 Nothing -> return Nothing

1084 Nothing -> return Nothing

1084− Just (_, _, sRef, _) -> do

1085+ Just (_, _, _, sRef, _) -> do

1085 readIORef sRef >>= \case

1086 readIORef sRef >>= \case

1086 ChildReadyStateInt_Ready -> return Nothing -- Delete this child, since it's ready

1087 ChildReadyStateInt_Ready -> return Nothing -- Delete this child, since it's ready

1087 ChildReadyStateInt_Unready _ -> do

1088 ChildReadyStateInt_Unready _ -> do

@@ -1099,8 +1100,8 @@ traverseIntMapWithKeyWithAdjust' = do

1099 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef

1100 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef

1100 let nextPlaceholder = maybe lastPlaceholder snd $ IntMap.lookupGT k phs

1101 let nextPlaceholder = maybe lastPlaceholder snd $ IntMap.lookupGT k phs

1101 forM_ (IntMap.lookup k phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder

1102 forM_ (IntMap.lookup k phs) $ \thisPlaceholder -> thisPlaceholder `deleteUpTo` nextPlaceholder

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

1103+ forM_ mv $ \(_, df, _, _, _) -> df `insertBefore` nextPlaceholder

1103− liftIO $ writeIORef placeholders $! fromMaybe phs $ apply ((\(_, ph, _, _) -> ph) <$> PatchIntMap p) phs

1104+ liftIO $ writeIORef placeholders $! fromMaybe phs $ apply ((\(_, _, ph, _, _) -> ph) <$> PatchIntMap p) phs

1104

1105

1105{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}

1106{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}

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

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

@@ -1109,16 +1110,19 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.

1109 , MonadJSM m

1110 , MonadJSM m

1110 , MonadFix m

1111 , MonadFix m

1111 , PrimMonad m

1112 , PrimMonad m

1112− , Monoid (p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))

1113+ , Monoid (p (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'))

1113 , Functor p

1114 , Functor p

1115+ , PatchTarget (p (DOM t m)) ~ IntMap (DOM t m)

1116+ , MonadHold t m

1117+ , Patch (p (DOM t m))

1114 )

1118 )

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

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

1116 -> IntMap v

1120 -> IntMap v

1117 -> Event t (p v)

1121 -> Event t (p v)

1118− -> DomRenderHookT t m (IntMap (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'), Event t (p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')))

1122+ -> DomRenderHookT t m (IntMap (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v'), Event t (p (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')))

1119 ) -- ^ The base monad's traversal

1123 ) -- ^ The base monad's traversal

1120− -> (p (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

1124+ -> (p (DOM 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

1121− -> (IORef (IntMap DOM.Text) -> IORef DOM.Text -> p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> JSM ()) -- ^ Apply a patch to the DOM

1125+ -> (IORef (IntMap DOM.Text) -> IORef DOM.Text -> p (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v') -> JSM ()) -- ^ Apply a patch to the DOM

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

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

1123 -> IntMap v

1127 -> IntMap v

1124 -> Event t (p v)

1128 -> Event t (p v)

@@ -1127,7 +1131,7 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

1127 (hydrateStart, _, key) <- skipToReplaceStart

1131 (hydrateStart, _, key) <- skipToReplaceStart

1128 initialEnv <- HydrationDomBuilderT ask

1132 initialEnv <- HydrationDomBuilderT ask

1129 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1133 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1130− pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty

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

1131 haveEverBeenReady <- liftIO $ newIORef False

1135 haveEverBeenReady <- liftIO $ newIORef False

1132 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"

1136 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"

1133 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"

1137 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"

@@ -1159,10 +1163,8 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

1159 liftIO $ writeIORef pendingChange (newUnready, p)

1163 liftIO $ writeIORef pendingChange (newUnready, p)

1160 when (IntMap.null newUnready) $ do

1164 when (IntMap.null newUnready) $ do

1161 applyDomUpdate p

1165 applyDomUpdate p

1162− stateRef <- liftIO . newIORef =<< HydrationDomBuilderT get

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

1166+ (children0, children') <- HydrationDomBuilderT $ lift $ lift $ base (\k v -> drawChildUpdateInt initialEnv markChildReady $ f k v) dm0 dm'

1164− HydrationDomBuilderT . put =<< liftIO (readIORef stateRef)

1165− let processChild k (_, _, sRef, _) = do

1167+ let processChild k (_, _, _, sRef, _) = do

1166 readIORef sRef >>= \case

1168 readIORef sRef >>= \case

1167 ChildReadyStateInt_Ready -> return Nothing

1169 ChildReadyStateInt_Ready -> return Nothing

1168 ChildReadyStateInt_Unready _ -> do

1170 ChildReadyStateInt_Unready _ -> do

@@ -1174,12 +1176,27 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

1174 else do

1176 else do

1175 modifyIORef' parentUnreadyChildren succ

1177 modifyIORef' parentUnreadyChildren succ

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

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

1177− let result0 = IntMap.map (\(_, _, _, v) -> v) children0

1179+ let result0 = IntMap.map (\(_, _, _, _, v) -> v) children0

1178− placeholders0 = fmap (\(_, ph, _, _) -> ph) children0

1180+ placeholders0 = fmap (\(_, _, ph, _, _) -> ph) children0

1181+ delayed0 :: IntMap (DOM t m)

1182+ delayed0 = IntMap.map (\(delayed, _, _, _, _) -> delayed) children0

1183+ delayed' :: Event t (p (DOM t m))

1184+ delayed' = ffor children' $ fmap $ \(delayed, _, _, _, _) -> delayed

1179− result' = ffor children' $ fmap $ \(_, _, _, r) -> r

1185+ result' = ffor children' $ fmap $ \(_, _, _, _, r) -> r

1186+ delayed <- accumMaybeB (flip apply) delayed0 delayed'

1187+ doc <- askDocument

1188+ let setFinalPlaceholder = do

1189+ ph <- createTextNode doc ("" :: Text)

1190+ parent <- askParent

1191+ pn <- runMaybeT $ MaybeT . Node.getNextSibling =<< MaybeT getPreviousNode

1192+ Node.insertBefore_ parent ph pn

1193+ liftIO $ writeIORef lastPlaceholderRef ph

1194+ setPreviousNode $ Just $ toNode ph

1195+ hydrateDOM $ DOM_Replace (pure ()) setFinalPlaceholder

1196+ (reverse . IntMap.elems <$> delayed)

1180 liftIO $ writeIORef placeholders $! placeholders0

1197 liftIO $ writeIORef placeholders $! placeholders0

1181 getHydrationMode >>= \case

1198 getHydrationMode >>= \case

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

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

1183 _ -> pure ()

1200 _ -> pure ()

1184 (hydrateEnd, lastPlaceholderRef) <- skipToReplaceEnd key

1201 (hydrateEnd, lastPlaceholderRef) <- skipToReplaceEnd key

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

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

@@ -1191,13 +1208,6 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_

1191 applyDomUpdate newP

1208 applyDomUpdate newP

1192 return (result0, result')

1209 return (result0, result')

1193

1210

1194−-- traverseDMapWithKeyWithAdjust

1195−-- :: GCompare k

1196−-- => (forall a. k a -> v a -> m (v' a))

1197−-- -> DMap k v

1198−-- -> Event t (PatchDMap k v)

1199−-- -> m (DMap k v', Event t (PatchDMap k v'))

1200−

1201{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}

1211{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}

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

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

1203 ( Adjustable t m

1213 ( Adjustable t m

@@ -1228,7 +1238,7 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.

1228 -> Event t (p k v)

1238 -> Event t (p k v)

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

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

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

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

1231− (hydrateStart, _, key) <- skipToReplaceStart

1241+-- (hydrateStart, _, key) <- skipToReplaceStart -- TODO

1232 initialEnv <- HydrationDomBuilderT ask

1242 initialEnv <- HydrationDomBuilderT ask

1233 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1243 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

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

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

@@ -1264,7 +1274,6 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

1264 when (DMap.null newUnready) $ do

1274 when (DMap.null newUnready) $ do

1265 applyDomUpdate p

1275 applyDomUpdate p

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

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

1267−-- HydrationDomBuilderT . put =<< liftIO (readIORef stateRef)

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

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

1269 readIORef sRef >>= \case

1278 readIORef sRef >>= \case

1270 ChildReadyState_Ready -> return Nothing

1279 ChildReadyState_Ready -> return Nothing

@@ -1285,13 +1294,20 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

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

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

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

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

1287 delayed <- accumMaybeB (flip apply) delayed0 delayed'

1296 delayed <- accumMaybeB (flip apply) delayed0 delayed'

1297+ doc <- askDocument

1298+ let setFinalPlaceholder = do

1299+ ph <- createTextNode doc ("" :: Text)

1300+ parent <- askParent

1301+ pn <- runMaybeT $ MaybeT . Node.getNextSibling =<< MaybeT getPreviousNode

1302+ Node.insertBefore_ parent ph pn

1303+ liftIO $ writeIORef lastPlaceholderRef ph

1304+ setPreviousNode $ Just $ toNode ph

1288− hydrateDOM $ DOM_Replace (liftIO $ putStr "one") (liftIO $ putStr "two")

1305+ hydrateDOM $ DOM_Replace (pure ()) setFinalPlaceholder

1289− (fmap (\(_ :=> Const d) -> d) . DMap.toList <$> delayed)

1306+ (fmap (\(_ :=> Const d) -> d) . reverse . DMap.toList <$> delayed)

1290 liftIO $ writeIORef placeholders $! placeholders0

1307 liftIO $ writeIORef placeholders $! placeholders0

1291 getHydrationMode >>= \case

1308 getHydrationMode >>= \case

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

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

1293 _ -> pure ()

1310 _ -> pure ()

1294− (hydrateEnd, lastPlaceholderRef) <- skipToReplaceEnd key

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

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

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

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

1297 newUnready <- liftIO $ updateChildUnreadiness p oldUnready

1313 newUnready <- liftIO $ updateChildUnreadiness p oldUnready

@@ -1313,18 +1329,20 @@ drawChildUpdate initialEnv markReady child = do

1313 unreadyChildren <- liftIO $ newIORef 0

1329 unreadyChildren <- liftIO $ newIORef 0

1314 hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv

1330 hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv

1315 placeholder <- createTextNode doc ("" :: Text)

1331 placeholder <- createTextNode doc ("" :: Text)

1316− p <- case hydrationMode of

1332+ (p, delayed) <- case hydrationMode of

1317− HydrationMode_Hydrating -> do

1333+ HydrationMode_Hydrating -> pure

1318− let p = _hydrationDomBuilderEnv_parent initialEnv

1334+ ( Left $ _hydrationDomBuilderEnv_parent initialEnv

1319− p' <- liftIO $ readIORef p

1335+ , do

1320−-- case _hydrationState_previousNode initialState of

1336+ parent <- askParent

1337+ getPreviousNode >>= \case

1321−-- Nothing -> Node.appendChild_ p' placeholder

1338+ Nothing -> Node.getFirstChild parent >>= Node.insertBefore_ parent placeholder

1322−-- Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ p' placeholder

1339+ Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ parent placeholder

1323− pure (Left p)

1340+ setPreviousNode $ Just $ toNode placeholder

1341+ )

1324 HydrationMode_Immediate -> do

1342 HydrationMode_Immediate -> do

1325 df <- createDocumentFragment doc

1343 df <- createDocumentFragment doc

1326 Node.appendChild_ df placeholder

1344 Node.appendChild_ df placeholder

1327− pure (Right df)

1345+ pure (Right df, pure ())

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

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

1329 (result, finalState) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT child) initialEnv

1347 (result, finalState) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT child) initialEnv

1330 { _hydrationDomBuilderEnv_parent = p'

1348 { _hydrationDomBuilderEnv_parent = p'

@@ -1334,48 +1352,50 @@ drawChildUpdate initialEnv markReady child = do

1334 u <- liftIO $ readIORef unreadyChildren

1352 u <- liftIO $ readIORef unreadyChildren

1335 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready

1353 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready

1336 return $ Compose

1354 return $ Compose

1337− ( DOM_Replace (liftIO $ putStrLn "before") (liftIO $ putStrLn "after") $ pure finalState

1355+ ( DOM_Replace delayed (pure ()) (pure finalState)

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

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

1339 , placeholder, childReadyState, result

1357 , placeholder, childReadyState, result

1340 )

1358 )

1341

1359

1342{-# INLINABLE drawChildUpdateInt #-}

1360{-# INLINABLE drawChildUpdateInt #-}

1343−drawChildUpdateInt :: (MonadIO m, MonadJSM m)

1361+drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)

1344− => IORef [DOM t m]

1345− -> HydrationDomBuilderEnv

1362+ => HydrationDomBuilderEnv

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

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

1347 -> HydrationDomBuilderT t m v'

1364 -> HydrationDomBuilderT t m v'

1348− -> DomRenderHookT t m (DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')

1365+ -> DomRenderHookT t m (DOM t m, DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')

1349−drawChildUpdateInt stateRef initialEnv markReady child = do

1366+drawChildUpdateInt initialEnv markReady child = do

1350 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing

1367 childReadyState <- liftIO $ newIORef $ ChildReadyStateInt_Unready Nothing

1351 let doc = _hydrationDomBuilderEnv_document initialEnv

1368 let doc = _hydrationDomBuilderEnv_document initialEnv

1352 unreadyChildren <- liftIO $ newIORef 0

1369 unreadyChildren <- liftIO $ newIORef 0

1353 hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv

1370 hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv

1354− initialState <- liftIO $ readIORef stateRef

1355 placeholder <- createTextNode doc ("" :: Text)

1371 placeholder <- createTextNode doc ("" :: Text)

1356− p <- case hydrationMode of

1372+ (p, delayed) <- case hydrationMode of

1357− HydrationMode_Hydrating -> do

1373+ HydrationMode_Hydrating -> pure

1358− let p = _hydrationDomBuilderEnv_parent initialEnv

1374+ ( Left $ _hydrationDomBuilderEnv_parent initialEnv

1359− p' <- liftIO $ readIORef p

1375+ , do

1360−-- case _hydrationState_previousNode initialState of

1376+ parent <- askParent

1377+ getPreviousNode >>= \case

1361−-- Nothing -> Node.appendChild_ p' placeholder

1378+ Nothing -> Node.getFirstChild parent >>= Node.insertBefore_ parent placeholder

1362−-- Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ p' placeholder

1379+ Just pn -> Node.getNextSibling pn >>= Node.insertBefore_ parent placeholder

1363− pure (Left p)

1380+ setPreviousNode $ Just $ toNode placeholder

1381+ )

1364 HydrationMode_Immediate -> do

1382 HydrationMode_Immediate -> do

1365 df <- createDocumentFragment doc

1383 df <- createDocumentFragment doc

1366 Node.appendChild_ df placeholder

1384 Node.appendChild_ df placeholder

1367− pure (Right df)

1385+ pure (Right df, pure ())

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

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

1369− let env = initialEnv

1387+ (result, finalState) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT child) initialEnv

1370 { _hydrationDomBuilderEnv_parent = p'

1388 { _hydrationDomBuilderEnv_parent = p'

1371 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1389 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1372 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

1390 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

1373 }

1391 }

1374− (result, finalState) <- runStateT (runReaderT (unHydrationDomBuilderT child) env) initialState --{ _hydrationState_previousNode = Just $ toNode placeholder })

1375− liftIO $ writeIORef stateRef finalState

1376 u <- liftIO $ readIORef unreadyChildren

1392 u <- liftIO $ readIORef unreadyChildren

1377 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready

1393 when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyStateInt_Ready

1394+ return

1395+ ( DOM_Replace delayed (pure ()) (pure finalState)

1378− return (either (const $ error "drawChildUpdateInt: Tried to use document fragment in hydration mode") id p, placeholder, childReadyState, result)

1396+ , either (const $ error "drawChildUpdateInt: Tried to use document fragment in hydration mode") id p

1397+ , placeholder, childReadyState, result

1398+ )

1379

1399

1380mkHasFocus :: (MonadHold t m, Reflex t) => Element er d t -> m (Dynamic t Bool)

1400mkHasFocus :: (MonadHold t m, Reflex t) => Element er d t -> m (Dynamic t Bool)

1381mkHasFocus e = do

1401mkHasFocus e = do

@@ -1393,9 +1413,7 @@ insertAfter new existing = do

1393

1413

1394insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()

1414insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()

1395insertBefore new existing = do

1415insertBefore new existing = do

1396− liftIO $ putStrLn "insertBefore"

1397 p <- getParentNodeUnchecked existing

1416 p <- getParentNodeUnchecked existing

1398− liftIO $ putStrLn "insertBefore2"

1399 DOM.insertBefore_ p new (Just existing) -- If there's no parent, that means we've been removed from the DOM; this should not happen if the we're removing ourselves from the performEvent properly

1417 DOM.insertBefore_ p new (Just existing) -- If there's no parent, that means we've been removed from the DOM; this should not happen if the we're removing ourselves from the performEvent properly

1400

1418

1401instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where

1419instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT t m) where

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

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

235 -> Event t (p k v)

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

237hoistDMapWithKeyWithAdjust base mapPatch f dm0 dm' = do

238− key <- replaceStart

238+-- key <- replaceStart

239 e <- StaticDomBuilderT ask

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

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

@@ -249,7 +249,7 @@ hoistDMapWithKeyWithAdjust base mapPatch f dm0 dm' = do

249 os <- sample $ currentIncremental outputs

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

251 sample o

252− replaceEnd key

252+-- replaceEnd key

253 return (result0, result')

254

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