@@ -83,6 +83,8 @@ data ImmediateDomBuilderEnv t
8383 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document
8484 , _immediateDomBuilderEnv_parent :: Node
8585 , _immediateDomBuilderEnv_events :: Chan [DSum (TriggerRef t) TriggerInvocation]
86+ , _immediateDomBuilderEnv_unreadyChildren :: IORef Word -- Number of children who still aren't fully rendered
87+ , _immediateDomBuilderEnv_commitAction :: IO () -- Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
8688 }
8789
8890newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilderT :: ReaderT (ImmediateDomBuilderEnv t) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)
@@ -198,9 +200,9 @@ newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IOR
198200wrap :: forall m er t. SupportsImmediateDomBuilder t m => RawElement GhcjsDomSpace -> RawElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m (Element er GhcjsDomSpace t)
199201wrap e cfg = do
200202 events <- askEvents
201− mapM_ (performEvent_ . fmap (imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of
203+ forM_ (_rawElementConfig_modifyAttributes cfg) $ \modifyAttrs -> performEvent $ ffor modifyAttrs $ imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of
202204 Nothing -> maybe (removeAttribute e n) (setAttribute e n) mv
203− Just ns -> maybe (removeAttributeNS e (Just ns) n) (setAttributeNS e (Just ns) n) mv)) (_rawElementConfig_modifyAttributes cfg)
205+ Just ns -> maybe (removeAttributeNS e (Just ns) n) (setAttributeNS e (Just ns) n) mv
204206 eventTriggerRefs :: DMap EventName (EventFilterTriggerRef t er) <- liftIO $ fmap DMap.fromList $ forM (DMap.toList $ _ghcjsEventSpec_filters $ _rawElementConfig_eventSpec cfg) $ \(en :=> GhcjsEventFilter f) -> do
205207 triggerRef <- newIORef Nothing
206208 _ <- elementOnEventName en e $ do
@@ -230,23 +232,24 @@ wrap e cfg = do
230232 --TODO: I don't think this is quite right: if a new trigger is created between when this is enqueued and when it fires, this may not work quite right
231233 ref <- newIORef $ Just t
232234 writeChan events [TriggerRef ref :=> TriggerInvocation v (return ())]
233− return $ Element es e
235+ return $ Element
236+ { _element_events = es
237+ , _element_raw = e
238+ }
234239
235240{-# INLINABLE makeElement #-}
236241makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.Element)
237242makeElement elementTag cfg child = do
238− doc <- askDocument
239− events <- askEvents
243+ env <- ImmediateDomBuilderT ask
244+ let doc = _immediateDomBuilderEnv_document env
240245 Just e <- ImmediateDomBuilderT $ fmap DOM.castToElement <$> case cfg ^. namespace of
241246 Nothing -> createElement doc (Just elementTag)
242247 Just ens -> createElementNS doc (Just ens) (Just elementTag)
243248 ImmediateDomBuilderT $ iforM_ (cfg ^. initialAttributes) $ \(AttributeName mAttrNamespace n) v -> case mAttrNamespace of
244249 Nothing -> setAttribute e n v
245250 Just ans -> setAttributeNS e (Just ans) n v
246− result <- lift $ runImmediateDomBuilderT child $ ImmediateDomBuilderEnv
251+ result <- lift $ runImmediateDomBuilderT child $ env
247252 { _immediateDomBuilderEnv_parent = toNode e
248− , _immediateDomBuilderEnv_document = doc
249− , _immediateDomBuilderEnv_events = events
250253 }
251254 append e
252255 wrapped <- wrap e $ extractRawElementConfig cfg
@@ -414,6 +417,21 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
414417 return (wrapped, result)
415418 placeRawElement = append
416419 wrapRawElement = wrap
420+ notReadyUntil e = do
421+ eOnce <- headE e
422+ env <- ImmediateDomBuilderT ask
423+ let unreadyChildren = _immediateDomBuilderEnv_unreadyChildren env
424+ liftIO $ modifyIORef' unreadyChildren succ
425+ let ready = liftIO $ do
426+ old <- readIORef unreadyChildren
427+ let new = pred old
428+ writeIORef unreadyChildren $! new
429+ when (new == 0) $ _immediateDomBuilderEnv_commitAction env
430+ performEvent_ $ ready <$ eOnce
431+ notReady = do
432+ env <- ImmediateDomBuilderT ask
433+ let unreadyChildren = _immediateDomBuilderEnv_unreadyChildren env
434+ liftIO $ modifyIORef' unreadyChildren succ
417435
418436data FragmentState
419437 = FragmentState_Unmounted
@@ -474,19 +492,48 @@ instance (Reflex t, MonadAdjust t m, MonadIO m, MonadHold t m, PerformEvent t m,
474492 runWithReplace a0 a' = do
475493 initialEnv <- ImmediateDomBuilderT ask
476494 before <- textNodeInternal ("" :: Text)
495+ let parentUnreadyChildren = _immediateDomBuilderEnv_unreadyChildren initialEnv
496+ haveEverBeenReady <- liftIO $ newIORef False
497+ let myCommitAction = liftIO $ do --TODO: When we change out a child, we need to cancel it's ability to declare us ready
498+ readIORef haveEverBeenReady >>= \case
499+ True -> return ()
500+ False -> do
501+ writeIORef haveEverBeenReady True
502+ old <- readIORef parentUnreadyChildren
503+ let new = pred old
504+ writeIORef parentUnreadyChildren $! new
505+ when (new == 0) $ _immediateDomBuilderEnv_commitAction initialEnv
477506 -- We draw 'after' in this roundabout way to avoid using MonadFix
478507 Just after <- createTextNode (_immediateDomBuilderEnv_document initialEnv) ("" :: Text)
479508 let drawInitialChild = do
480− result <- a0
481− append after
509+ unreadyChildren <- liftIO $ newIORef 0
510+ let f = do
511+ result <- a0
512+ append after
513+ return result
514+ result <- runImmediateDomBuilderT f $ initialEnv
515+ { _immediateDomBuilderEnv_unreadyChildren = unreadyChildren
516+ , _immediateDomBuilderEnv_commitAction = myCommitAction
517+ }
518+ liftIO $ readIORef unreadyChildren >>= \case
519+ 0 -> writeIORef haveEverBeenReady True
520+ _ -> modifyIORef' parentUnreadyChildren succ
482521 return result
483− (result0, result') <- lift $ runWithReplace (runImmediateDomBuilderT drawInitialChild initialEnv) $ ffor a' $ \child -> do
522+ (result0, result') <- lift $ runWithReplace drawInitialChild $ ffor a' $ \child -> do
484523 Just df <- createDocumentFragment $ _immediateDomBuilderEnv_document initialEnv
524+ unreadyChildren <- liftIO $ newIORef 0
525+ let commitAction = do
526+ deleteBetweenExclusive before after
527+ insertBefore df after
528+ myCommitAction
485529 result <- runImmediateDomBuilderT child $ initialEnv
486530 { _immediateDomBuilderEnv_parent = toNode df
531+ , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren
532+ , _immediateDomBuilderEnv_commitAction = commitAction
487533 }
488− deleteBetweenExclusive before after
489− insertBefore df after
534+ liftIO $ readIORef unreadyChildren >>= \case
535+ 0 -> commitAction
536+ _ -> return () -- Whoever decrements it to 0 will handle it
490537 return result
491538 return (result0, result')
492539 traverseDMapWithKeyWithAdjust (f :: forall a. k a -> v a -> ImmediateDomBuilderT t m (v' a)) (dm0 :: DMap k v) dm' = do
@@ -567,14 +614,13 @@ mkHasFocus e = do
567614{-# INLINABLE insertImmediateAbove #-}
568615insertImmediateAbove :: (IsNode placeholder, PerformEvent t m, MonadIO (Performable m)) => placeholder -> Event t (ImmediateDomBuilderT t (Performable m) a) -> ImmediateDomBuilderT t m (Event t a)
569616insertImmediateAbove n toInsertAbove = do
570− events <- askEvents
617+ env <- ImmediateDomBuilderT ask
571618 lift $ performEvent $ ffor toInsertAbove $ \new -> do
572619 Just doc <- getOwnerDocument n
573620 Just df <- createDocumentFragment doc
574− result <- runImmediateDomBuilderT new $ ImmediateDomBuilderEnv
621+ result <- runImmediateDomBuilderT new $ env
575622 { _immediateDomBuilderEnv_parent = toNode df
576623 , _immediateDomBuilderEnv_document = doc
577− , _immediateDomBuilderEnv_events = events
578624 }
579625 df `insertBefore` n
580626 return result