@@ -5,6 +5,7 @@
5{-# LANGUAGE EmptyDataDecls #-}
5{-# LANGUAGE EmptyDataDecls #-}
6{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE LambdaCase #-}
10{-# LANGUAGE MultiParamTypeClasses #-}
11{-# LANGUAGE MultiParamTypeClasses #-}
@@ -24,6 +25,7 @@ import Reflex.Class as Reflex
24import Reflex.Dom.Builder.Class
25import Reflex.Dom.Builder.Class
25import Reflex.Dynamic
26import Reflex.Dynamic
26import Reflex.Host.Class
27import Reflex.Host.Class
28+import qualified Reflex.Patch.DMap as PatchDMap
27import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
29import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
28import Reflex.PerformEvent.Class
30import Reflex.PerformEvent.Class
29import Reflex.PostBuild.Class
31import Reflex.PostBuild.Class
@@ -45,10 +47,12 @@ import Data.Dependent.Sum
45import Data.Functor.Compose
47import Data.Functor.Compose
46import Data.Functor.Constant
48import Data.Functor.Constant
47import Data.Functor.Misc
49import Data.Functor.Misc
50+import Data.Functor.Product
48import Data.IORef
51import Data.IORef
49import qualified Data.Map as Map
52import qualified Data.Map as Map
50import Data.Maybe
53import Data.Maybe
51−import Data.Monoid
54+import Data.Monoid hiding (Product)
55+import Data.Some (Some)
52import qualified Data.Some as Some
56import qualified Data.Some as Some
53import Data.Text (Text)
57import Data.Text (Text)
54import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode)
58import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode)
@@ -543,14 +547,23 @@ instance (Reflex t, MonadAdjust t m, MonadIO m, MonadHold t m, MonadFix m, Perfo
543 return result
547 return result
544 return (result0, result')
548 return (result0, result')
545 traverseDMapWithKeyWithAdjust = do
549 traverseDMapWithKeyWithAdjust = do
550+ let updateChildUnreadiness (p :: PatchDMap k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do
546− let updatedChildToUnreadiness :: forall x v'. Int -> ComposeMaybe (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v') x -> ComposeMaybe (Constant Int) x
551+ let new :: forall a. k a -> ComposeMaybe (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState k))) a)
547− updatedChildToUnreadiness cohortId = \case
552+ new k (ComposeMaybe m) = ComposeMaybe <$> case m of
548− ComposeMaybe Nothing -> ComposeMaybe Nothing -- The child is being deleted, so it's ready
553+ Nothing -> return Nothing
549− ComposeMaybe (Just (Compose (_, _, alreadyReady, _)))
554+ Just (Compose (_, _, sRef, _)) -> do
550− | alreadyReady -> ComposeMaybe Nothing -- The child is being added and is already ready
555+ readIORef sRef >>= \case
551− | otherwise -> ComposeMaybe $ Just $ Constant cohortId -- The child is being added and is not ready
556+ ChildReadyState_Ready -> return Nothing -- Delete this child, since it's ready
552− childrenPatchToUnreadyPatch cohortId (PatchDMap m) = PatchDMap $ DMap.map (updatedChildToUnreadiness cohortId) m
557+ ChildReadyState_Unready _ -> do
558+ writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k
559+ return $ Just $ Constant sRef
560+ delete _ (Constant sRef) = do
561+ writeIORef sRef $ ChildReadyState_Unready Nothing
562+ return $ Constant ()
563+ p' <- fmap PatchDMap $ DMap.traverseWithKey new $ unPatchDMap p
564+ _ <- DMap.traverseWithKey delete $ PatchDMap.getDeletions p old
565+ return $ applyAlways p' old
553− hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap childrenPatchToUnreadyPatch $ \placeholders lastPlaceholderRef (PatchDMap p) -> do
566+ hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap updateChildUnreadiness $ \placeholders lastPlaceholderRef (PatchDMap p) -> do
554 phs <- readIORef placeholders
567 phs <- readIORef placeholders
555 forM_ (DMap.toList p) $ \(k :=> ComposeMaybe mv) -> do
568 forM_ (DMap.toList p) $ \(k :=> ComposeMaybe mv) -> do
556 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
569 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
@@ -559,19 +572,29 @@ instance (Reflex t, MonadAdjust t m, MonadIO m, MonadHold t m, MonadFix m, Perfo
559 forM_ mv $ \(Compose (df, _, _, _)) -> df `insertBefore` nextPlaceholder
572 forM_ mv $ \(Compose (df, _, _, _)) -> df `insertBefore` nextPlaceholder
560 writeIORef placeholders $! fromMaybe phs $ apply (weakenPatchDMapWith (\(Compose (_, ph, _, _)) -> ph) $ PatchDMap p) phs
573 writeIORef placeholders $! fromMaybe phs $ apply (weakenPatchDMapWith (\(Compose (_, ph, _, _)) -> ph) $ PatchDMap p) phs
561 traverseDMapWithKeyWithAdjustWithMove = do
574 traverseDMapWithKeyWithAdjustWithMove = do
575+ let updateChildUnreadiness (p :: PatchDMapWithMove k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) old = do
562− let updatedChildToUnreadiness :: forall x k v'. Int -> PatchDMapWithMove.NodeInfo k (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v') x -> PatchDMapWithMove.NodeInfo k (Constant Int) x
576+ 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)
563− updatedChildToUnreadiness cohortId = PatchDMapWithMove.nodeInfoMapFrom $ \case
577+ new k = PatchDMapWithMove.nodeInfoMapFromM $ \case
564− PatchDMapWithMove.From_Insert (Compose (_, _, alreadyReady, _))
578+ PatchDMapWithMove.From_Insert (Compose (_, _, sRef, _)) -> do
579+ readIORef sRef >>= \case
565− | alreadyReady -> PatchDMapWithMove.From_Delete -- The child is being added and is already ready
580+ ChildReadyState_Ready -> return PatchDMapWithMove.From_Delete
581+ ChildReadyState_Unready _ -> do
582+ writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k
566− | otherwise -> PatchDMapWithMove.From_Insert $ Constant cohortId -- The child is being added and is not ready
583+ return $ PatchDMapWithMove.From_Insert $ Constant sRef
567− PatchDMapWithMove.From_Delete -> PatchDMapWithMove.From_Delete -- The child is being deleted, so it's ready
584+ PatchDMapWithMove.From_Delete -> return PatchDMapWithMove.From_Delete
568− PatchDMapWithMove.From_Move k -> PatchDMapWithMove.From_Move k -- The child is being moved, so its ready status should be moved
585+ PatchDMapWithMove.From_Move fromKey -> return $ PatchDMapWithMove.From_Move fromKey
586+ deleteOrMove :: forall a. k a -> Product (Constant (IORef (ChildReadyState k))) (ComposeMaybe k) a -> IO (Constant () a)
587+ deleteOrMove _ (Pair (Constant sRef) (ComposeMaybe mToKey)) = do
588+ writeIORef sRef $ ChildReadyState_Unready $ Some.This <$> mToKey -- This will be Nothing if deleting, and Just if moving, so it works out in both cases
589+ return $ Constant ()
569− childrenPatchToUnreadyPatch cohortId = unsafePatchDMapWithMove . DMap.map (updatedChildToUnreadiness cohortId) . unPatchDMapWithMove
590+ p' <- fmap unsafePatchDMapWithMove $ DMap.traverseWithKey new $ unPatchDMapWithMove p
591+ _ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old
592+ return $ applyAlways p' old
570− hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove childrenPatchToUnreadyPatch $ \placeholders lastPlaceholderRef (p_ :: PatchDMapWithMove k (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v')) -> do
593+ hoistTraverseWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove updateChildUnreadiness $ \placeholders lastPlaceholderRef (p_ :: PatchDMapWithMove k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) -> do
571 let p = unPatchDMapWithMove p_
594 let p = unPatchDMapWithMove p_
572 phsBefore <- readIORef placeholders
595 phsBefore <- readIORef placeholders
573 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
596 lastPlaceholder <- liftIO $ readIORef lastPlaceholderRef
574− let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v') a -> IO (Constant (Maybe DOM.DocumentFragment) a)
597+ let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (Constant (Maybe DOM.DocumentFragment) a)
575 collectIfMoved k e = do
598 collectIfMoved k e = do
576 let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before
599 let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before
577 nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore
600 nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore
@@ -583,7 +606,7 @@ instance (Reflex t, MonadAdjust t m, MonadIO m, MonadHold t m, MonadFix m, Perfo
583 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder
606 Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder
584 collected <- DMap.traverseWithKey collectIfMoved p
607 collected <- DMap.traverseWithKey collectIfMoved p
585 let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (\(Compose (_, ph, _, _)) -> ph) p_) phsBefore --TODO: Don't recompute this
608 let !phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (\(Compose (_, ph, _, _)) -> ph) p_) phsBefore --TODO: Don't recompute this
586− let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v') a -> IO (Constant () a)
609+ let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') a -> IO (Constant () a)
587 placeFragment k e = do
610 placeFragment k e = do
588 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter
611 let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter
589 case PatchDMapWithMove._nodeInfo_from e of
612 case PatchDMapWithMove._nodeInfo_from e of
@@ -598,6 +621,11 @@ instance (Reflex t, MonadAdjust t m, MonadIO m, MonadHold t m, MonadFix m, Perfo
598 mapM_ (\(k :=> v) -> void $ placeFragment k v) $ DMap.toDescList p -- We need to go in reverse order here, to make sure the placeholders are in the right spot at the right time
621 mapM_ (\(k :=> v) -> void $ placeFragment k v) $ DMap.toDescList p -- We need to go in reverse order here, to make sure the placeholders are in the right spot at the right time
599 writeIORef placeholders $! phsAfter
622 writeIORef placeholders $! phsAfter
624+data ChildReadyState k
625+ = ChildReadyState_Ready
626+ | ChildReadyState_Unready !(Maybe (Some k))
627+ deriving (Show, Read, Eq, Ord)
601hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
629hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
602 ( PerformEvent t m
630 ( PerformEvent t m
603 , MonadAdjust t m
631 , MonadAdjust t m
@@ -608,7 +636,7 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
608 , MonadFix m
636 , MonadFix m
609 , Patch (p k v)
637 , Patch (p k v)
610 , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
638 , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
611− , Monoid (p k (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v'))
639+ , Monoid (p k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v'))
612 , Patch (p k (Constant Int))
640 , Patch (p k (Constant Int))
614 => (forall vv vv'.
642 => (forall vv vv'.
@@ -618,16 +646,16 @@ hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
618 -> m (DMap k vv', Event t (p k vv'))
646 -> m (DMap k vv', Event t (p k vv'))
619 ) -- ^ The base monad's traversal
647 ) -- ^ The base monad's traversal
620 -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type
648 -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type
621− -> (Int -> p k (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v') -> p k (Constant Int)) -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
649+ -> (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
622− -> (IORef (Map.Map (Some.Some k) DOM.Text) -> IORef DOM.Text -> p k (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v') -> IO ()) -- ^ Apply a patch to the DOM
650+ -> (IORef (Map.Map (Some.Some k) DOM.Text) -> IORef DOM.Text -> p k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v') -> IO ()) -- ^ Apply a patch to the DOM
623 -> (forall a. k a -> v a -> ImmediateDomBuilderT t m (v' a))
651 -> (forall a. k a -> v a -> ImmediateDomBuilderT t m (v' a))
624 -> DMap k v
652 -> DMap k v
625 -> Event t (p k v)
653 -> Event t (p k v)
626 -> ImmediateDomBuilderT t m (DMap k v', Event t (p k v'))
654 -> ImmediateDomBuilderT t m (DMap k v', Event t (p k v'))
627−hoistTraverseWithKeyWithAdjust base mapPatch childrenPatchToUnreadyPatch applyDomUpdate_ (f :: forall a. k a -> v a -> ImmediateDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do
655+hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpdate_ (f :: forall a. k a -> v a -> ImmediateDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do
628 initialEnv <- ImmediateDomBuilderT ask
656 initialEnv <- ImmediateDomBuilderT ask
629 let parentUnreadyChildren = _immediateDomBuilderEnv_unreadyChildren initialEnv
657 let parentUnreadyChildren = _immediateDomBuilderEnv_unreadyChildren initialEnv
630− pendingChange :: IORef (DMap k (Constant Int), p k (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v')) <- liftIO $ newIORef mempty
658+ pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState k))), p k (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v')) <- liftIO $ newIORef mempty
631 haveEverBeenReady <- liftIO $ newIORef False
659 haveEverBeenReady <- liftIO $ newIORef False
632 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"
660 placeholders <- liftIO $ newIORef $ error "placeholders not yet initialized"
633 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"
661 lastPlaceholderRef <- liftIO $ newIORef $ error "lastPlaceholderRef not yet initialized"
@@ -641,24 +669,30 @@ hoistTraverseWithKeyWithAdjust base mapPatch childrenPatchToUnreadyPatch applyDo
641 let new = pred old
669 let new = pred old
642 writeIORef parentUnreadyChildren $! new
670 writeIORef parentUnreadyChildren $! new
643 when (new == 0) $ _immediateDomBuilderEnv_commitAction initialEnv
671 when (new == 0) $ _immediateDomBuilderEnv_commitAction initialEnv
644− markChildReady :: forall a. Int -> k a -> IO ()
672+ markChildReady :: IORef (ChildReadyState k) -> IO ()
645− markChildReady markingCohortId k = do
673+ markChildReady childReadyState = do
646− (oldUnready, p) <- readIORef pendingChange
674+ readIORef childReadyState >>= \case
647− when (not (DMap.null oldUnready)) $ do
675+ ChildReadyState_Ready -> return ()
648− let clearUnreadiness = \case
676+ ChildReadyState_Unready countedAt -> do
649− Nothing -> Nothing
677+ writeIORef childReadyState ChildReadyState_Ready
650− old@(Just (Constant pendingCohortId)) -> case pendingCohortId `compare` markingCohortId of
678+ case countedAt of
651− LT -> trace "Warning: marking a child as ready before it is in pendingChange" Nothing -- Should never happen; we're trying to mark something as done before it's been added to pendingChange
679+ Nothing -> return ()
652− EQ -> Nothing -- We're marking the currently pending child as done
680+ Just (Some.This k) -> do -- This child has been counted as unready, so we need to remove it from the unready set
653− GT -> old -- We're marking a child as done that has already been superceded
681+ (oldUnready, p) <- readIORef pendingChange
682+ when (not $ DMap.null oldUnready) $ do -- This shouldn't actually ever be null
654− newUnready = DMap.alter clearUnreadiness k oldUnready
683+ let newUnready = DMap.delete k oldUnready
655− writeIORef pendingChange $! (newUnready, p)
684+ writeIORef pendingChange $! (newUnready, p)
656− when (DMap.null newUnready) $ do
685+ when (DMap.null newUnready) $ do
657− applyDomUpdate p
686+ applyDomUpdate p
658− markSelfReady
687+ markSelfReady
659− dm'' <- zipListWithEvent (\cohortId -> mapPatch (\v -> Compose (cohortId, v))) [1 :: Int ..] dm'
660− (children0, children') <- lift $ base (\k (Compose (cohortId, v)) -> drawChildUpdate initialEnv (markChildReady cohortId k) $ f k v) (DMap.map (\v -> Compose (0, v)) dm0) dm''
688+ (children0, children') <- lift $ base (\k v -> drawChildUpdate initialEnv markChildReady $ f k v) dm0 dm'
689+ let processChild k (Compose (_, _, sRef, _)) = ComposeMaybe <$> do
690+ readIORef sRef >>= \case
691+ ChildReadyState_Ready -> return Nothing
692+ ChildReadyState_Unready _ -> do
693+ writeIORef sRef $ ChildReadyState_Unready $ Just $ Some.This k
694+ return $ Just $ Constant sRef
661− let !initialUnready = DMap.mapMaybeWithKey (\_ (Compose (_, _, alreadyReady, _)) -> if alreadyReady then Nothing else Just $ Constant 0) children0
695+ initialUnready <- liftIO $ DMap.mapMaybeWithKey (\_ -> getComposeMaybe) <$> DMap.traverseWithKey processChild children0
662 liftIO $ if DMap.null initialUnready
696 liftIO $ if DMap.null initialUnready
663 then writeIORef haveEverBeenReady True
697 then writeIORef haveEverBeenReady True
@@ -671,76 +705,34 @@ hoistTraverseWithKeyWithAdjust base mapPatch childrenPatchToUnreadyPatch applyDo
671 _ <- DMap.traverseWithKey (\_ (Compose (df, _, _, _)) -> Constant () <$ append df) children0
705 _ <- DMap.traverseWithKey (\_ (Compose (df, _, _, _)) -> Constant () <$ append df) children0
672 liftIO . writeIORef lastPlaceholderRef =<< textNodeInternal ("" :: Text)
706 liftIO . writeIORef lastPlaceholderRef =<< textNodeInternal ("" :: Text)
673 -- Note: the numbering here must match the numbering of dm''
707 -- Note: the numbering here must match the numbering of dm''
674− children'' <- zipListWithEvent (,) [1 :: Int ..] children'
675− performEvent_ $ ffor children'' $ \(cohortId, p) -> liftIO $ do
708+ performEvent_ $ ffor children' $ \p -> liftIO $ do
676 (oldUnready, oldP) <- readIORef pendingChange
709 (oldUnready, oldP) <- readIORef pendingChange
677− let !newUnready = fromMaybe oldUnready $ apply (childrenPatchToUnreadyPatch cohortId p) oldUnready
710+ newUnready <- updateChildUnreadiness p oldUnready
678− !newP = p <> oldP
711+ let !newP = p <> oldP
679 writeIORef pendingChange $! (newUnready, newP)
712 writeIORef pendingChange $! (newUnready, newP)
680 when (DMap.null newUnready) $ do
713 when (DMap.null newUnready) $ do
681 applyDomUpdate newP
714 applyDomUpdate newP
682 markSelfReady
715 markSelfReady
683 writeIORef pendingChange $! mempty
716 writeIORef pendingChange $! mempty
684 return (result0, result')
717 return (result0, result')
686− traverseDMapWithKeyWithAdjustWithMove (f :: forall a. k a -> v a -> ImmediateDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do
687− initialEnv <- ImmediateDomBuilderT ask
688− (children0, children') <- lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> drawChildUpdate initialEnv $ f k v) dm0 dm'
689− let result0 = DMap.map (\(Compose (_, _, v)) -> v) children0
690− placeholders0 = weakenDMapWith (\(Compose (_, ph, _)) -> ph) children0
691− result' = ffor children' $ mapPatchDMapWithMove $ \(Compose (_, _, r)) -> r
692− placeholders' = fforCheap children' $ weakenPatchDMapWithMoveWith $ \(Compose (_, ph, _)) -> ph
693− placeholders <- current . incrementalToDynamic <$> holdIncremental placeholders0 placeholders'
694− _ <- DMap.traverseWithKey (\_ (Compose (df, _, _)) -> Constant () <$ append df) children0
695− lastPlaceholder <- textNodeInternal ("" :: Text)
696− performEvent_ $ flip push children' $ \p_ -> do
697− let p = unPatchDMapWithMove p_
698− phsBefore <- sample placeholders
699− if DMap.null p then return Nothing else return $ Just $ do
700− let collectIfMoved :: forall a. k a -> DMapEdit k (Compose ((,,) DOM.DocumentFragment DOM.Text) v') a -> Performable m (Constant (Maybe DOM.DocumentFragment) a)
701− collectIfMoved k e = do
702− let mThisPlaceholder = Map.lookup (Some.This k) phsBefore -- Will be Nothing if this element wasn't present before
703− nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsBefore
704− case dmapEditMoved e of
706− mapM_ (`deleteUpTo` nextPlaceholder) mThisPlaceholder
707− return $ Constant Nothing
709− Constant <$> mapM (`collectUpTo` nextPlaceholder) mThisPlaceholder
710− collected <- DMap.traverseWithKey collectIfMoved p
711− let phsAfter = fromMaybe phsBefore $ apply (weakenPatchDMapWithMoveWith (\(Compose (_, ph, _)) -> ph) p_) phsBefore --TODO: Don't recompute this
712− let placeFragment :: forall a. k a -> DMapEdit k (Compose ((,,) DOM.DocumentFragment DOM.Text) v') a -> Performable m (Constant () a)
713− placeFragment k e = do
714− let nextPlaceholder = maybe lastPlaceholder snd $ Map.lookupGT (Some.This k) phsAfter
716− PatchDMapWithMove.From_Insert _ (Compose (df, _, _)) -> do
717− df `insertBefore` nextPlaceholder
718− PatchDMapWithMove.From_Delete _ -> do
720− PatchDMapWithMove.From_Move _ fromKey -> do
721− Just (Constant mdf) <- return $ DMap.lookup fromKey collected
722− mapM_ (`insertBefore` nextPlaceholder) mdf
723− return $ Constant ()
724− mapM_ (\(k :=> v) -> void $ placeFragment k v) $ DMap.toDescList p -- We need to go in reverse order here, to make sure the placeholders are in the right spot at the right time
726− return (result0, result')
729drawChildUpdate :: MonadIO m
719drawChildUpdate :: MonadIO m
730 => ImmediateDomBuilderEnv t
720 => ImmediateDomBuilderEnv t
731− -> IO () -- This will NOT be called if the child is ready at initialization time; instead, a True will be returned for that item
721+ -> (IORef (ChildReadyState k) -> IO ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready
732 -> ImmediateDomBuilderT t m (v' a)
722 -> ImmediateDomBuilderT t m (v' a)
733− -> m (Compose ((,,,) DOM.DocumentFragment DOM.Text Bool) v' a)
723+ -> m (Compose ((,,,) DOM.DocumentFragment DOM.Text (IORef (ChildReadyState k))) v' a)
734drawChildUpdate initialEnv markReady child = do
724drawChildUpdate initialEnv markReady child = do
725+ childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing
735 unreadyChildren <- liftIO $ newIORef 0
726 unreadyChildren <- liftIO $ newIORef 0
736 Just df <- createDocumentFragment $ _immediateDomBuilderEnv_document initialEnv
727 Just df <- createDocumentFragment $ _immediateDomBuilderEnv_document initialEnv
737 (placeholder, result) <- runImmediateDomBuilderT ((,) <$> textNodeInternal ("" :: Text) <*> child) $ initialEnv
728 (placeholder, result) <- runImmediateDomBuilderT ((,) <$> textNodeInternal ("" :: Text) <*> child) $ initialEnv
738 { _immediateDomBuilderEnv_parent = toNode df
729 { _immediateDomBuilderEnv_parent = toNode df
739 , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren
730 , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren
740− , _immediateDomBuilderEnv_commitAction = markReady
731+ , _immediateDomBuilderEnv_commitAction = markReady childReadyState
742 u <- liftIO $ readIORef unreadyChildren
733 u <- liftIO $ readIORef unreadyChildren
734+ when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
743− return $ Compose (df, placeholder, u == 0, result)
735+ return $ Compose (df, placeholder, childReadyState, result)
745mkHasFocus :: (MonadHold t m, Reflex t) => Element er d t -> m (Dynamic t Bool)
737mkHasFocus :: (MonadHold t m, Reflex t) => Element er d t -> m (Dynamic t Bool)
746mkHasFocus e = do
738mkHasFocus e = do