54e0b3f · reflex-dom · git.iko.soy

987 traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjust'

988 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}

989 traverseDMapWithKeyWithAdjustWithMove = do

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

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

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

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

992 new k = PatchDMapWithMove.nodeInfoMapFromM $ \case

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

993+ PatchDMapWithMove.From_Insert (Compose (_, _, _, sRef, _)) -> do

994 readIORef sRef >>= \case

995 ChildReadyState_Ready -> return PatchDMapWithMove.From_Delete

996 ChildReadyState_Unready _ -> do

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

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

1007 return $ applyAlways p' old

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

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

1009 let p = unPatchDMapWithMove p_

1010 phsBefore <- liftIO $ readIORef placeholders

1011 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef

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

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

1013 collectIfMoved k e = do

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

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

1020 True -> do

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

1022 collected <- DMap.traverseWithKey collectIfMoved p

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

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

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

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

1025 placeFragment k e = do

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

1027 case PatchDMapWithMove._nodeInfo_from e of

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

1028+ PatchDMapWithMove.From_Insert (Compose (_, df, _, _, _)) -> do

1029 df `insertBefore` nextPlaceholder

1030 PatchDMapWithMove.From_Delete -> do

1031 return ()

1044 -> Event t (PatchDMap k v)

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

1046traverseDMapWithKeyWithAdjust' = do

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

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

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

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

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

1050 Nothing -> return Nothing

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

1051+ Just (Compose (_, _, _, sRef, _)) -> do

1052 readIORef sRef >>= \case

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

1054 ChildReadyState_Unready _ -> do

1066 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef

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

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

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

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

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

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

1071

1072{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}

1073traverseIntMapWithKeyWithAdjust'

1191 applyDomUpdate newP

1192 return (result0, result')

1193

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+

1194{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}

1201{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}

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

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

1196 ( Adjustable t m

1203 ( Adjustable t m

1202 , MonadFix m

1209 , MonadFix m

1203 , Patch (p k v)

1210 , Patch (p k v)

1204 , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)

1211 , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)

1212+ , Patch (p k (Const (DOM t m)))

1213+ , PatchTarget (p k (Const (DOM t m))) ~ DMap k (Const (DOM t m))

1205− , Monoid (p k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))

1214+ , Monoid (p k (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))

1206 , Patch (p k (Constant Int))

1215 , Patch (p k (Constant Int))

1207 )

1216 )

1208 => (forall vv vv'.

1217 => (forall vv vv'.

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

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

1213 ) -- ^ The base monad's traversal

1222 ) -- ^ The base monad's traversal

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

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

1215− -> (p k (Compose ((,,,) 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

1224+ -> (p k (Compose ((,,,,) (DOM 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

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

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

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

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

1218 -> DMap k v

1227 -> DMap k v

1219 -> Event t (p k v)

1228 -> Event t (p k v)

1222 (hydrateStart, _, key) <- skipToReplaceStart

1231 (hydrateStart, _, key) <- skipToReplaceStart

1223 initialEnv <- HydrationDomBuilderT ask

1232 initialEnv <- HydrationDomBuilderT ask

1224 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

1233 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

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

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

1226 haveEverBeenReady <- liftIO $ newIORef False

1235 haveEverBeenReady <- liftIO $ newIORef False

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

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

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

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

1254 liftIO $ writeIORef pendingChange (newUnready, p)

1263 liftIO $ writeIORef pendingChange (newUnready, p)

1255 when (DMap.null newUnready) $ do

1264 when (DMap.null newUnready) $ do

1256 applyDomUpdate p

1265 applyDomUpdate p

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

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

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

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

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

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

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

1261 readIORef sRef >>= \case

1269 readIORef sRef >>= \case

1262 ChildReadyState_Ready -> return Nothing

1270 ChildReadyState_Ready -> return Nothing

1263 ChildReadyState_Unready _ -> do

1271 ChildReadyState_Unready _ -> do

1269 else do

1277 else do

1270 modifyIORef' parentUnreadyChildren succ

1278 modifyIORef' parentUnreadyChildren succ

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

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

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

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

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

1281+ placeholders0 = weakenDMapWith (\(Compose (_, _, ph, _, _)) -> ph) children0

1282+ delayed0 :: DMap k (Const (DOM t m))

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

1284+ delayed' :: Event t (p k (Const (DOM t m)))

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

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

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

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

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

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

1275 liftIO $ writeIORef placeholders $! placeholders0

1290 liftIO $ writeIORef placeholders $! placeholders0

1276 getHydrationMode >>= \case

1291 getHydrationMode >>= \case

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

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

1278 _ -> pure ()

1293 _ -> pure ()

1279 (hydrateEnd, lastPlaceholderRef) <- skipToReplaceEnd key

1294 (hydrateEnd, lastPlaceholderRef) <- skipToReplaceEnd key

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

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

1287 return (result0, result')

1302 return (result0, result')

1288

1303

1289{-# INLINABLE drawChildUpdate #-}

1304{-# INLINABLE drawChildUpdate #-}

1290−drawChildUpdate :: (MonadIO m, MonadJSM m)

1305+drawChildUpdate :: (MonadIO m, MonadJSM m, Reflex t)

1291− => IORef [DOM t m]

1292− -> HydrationDomBuilderEnv

1306+ => HydrationDomBuilderEnv

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

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

1294 -> HydrationDomBuilderT t m (v' a)

1308 -> HydrationDomBuilderT t m (v' a)

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

1309+ -> DomRenderHookT t m (Compose ((,,,,) (DOM t m) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)

1296−drawChildUpdate stateRef initialEnv markReady child = do

1310+drawChildUpdate initialEnv markReady child = do

1297 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

1311 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

1298 let doc = _hydrationDomBuilderEnv_document initialEnv

1312 let doc = _hydrationDomBuilderEnv_document initialEnv

1299 unreadyChildren <- liftIO $ newIORef 0

1313 unreadyChildren <- liftIO $ newIORef 0

1300 hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv

1314 hydrationMode <- liftIO $ readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv

1301− initialState <- liftIO $ readIORef stateRef

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

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

1303 p <- case hydrationMode of

1316 p <- case hydrationMode of

1304 HydrationMode_Hydrating -> do

1317 HydrationMode_Hydrating -> do

1313 Node.appendChild_ df placeholder

1326 Node.appendChild_ df placeholder

1314 pure (Right df)

1327 pure (Right df)

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

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

1316− let env = initialEnv

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

1317 { _hydrationDomBuilderEnv_parent = p'

1330 { _hydrationDomBuilderEnv_parent = p'

1318 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1331 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

1319 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

1332 , _hydrationDomBuilderEnv_commitAction = markReady childReadyState

1320 }

1333 }

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

1322− liftIO $ writeIORef stateRef finalState

1323 u <- liftIO $ readIORef unreadyChildren

1334 u <- liftIO $ readIORef unreadyChildren

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

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

1336+ return $ Compose

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

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

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

1339+ , placeholder, childReadyState, result

1340+ )

1326

1341

1327{-# INLINABLE drawChildUpdateInt #-}

1342{-# INLINABLE drawChildUpdateInt #-}

1328drawChildUpdateInt :: (MonadIO m, MonadJSM m)

1343drawChildUpdateInt :: (MonadIO m, MonadJSM m)