ded3a9e · reflex-dom · git.iko.soy

724 pure (toNode t)

725 let drawInitialChild = do

726 liftIO $ putStrLn "drawInitialChild"

727+ p <- liftIO (readIORef hydrating) >>= \case

728+ HydrationMode_Hydrating -> pure parent

727− df <- createDocumentFragment doc

729+ HydrationMode_Immediate -> toNode <$> createDocumentFragment doc

728 unreadyChildren <- liftIO $ newIORef 0

730 unreadyChildren <- liftIO $ newIORef 0

729 hydrationNode <- liftIO $ newIORef Nothing

731 hydrationNode <- liftIO $ newIORef Nothing

730− hydrationResult <- liftIO $ newIORef []

732+ r <- liftIO $ newIORef []

731− localHydrationMode <- liftIO $ newIORef HydrationMode_Immediate

732 result <- runReaderT (unHydrationDomBuilderT a0) initialEnv

733 result <- runReaderT (unHydrationDomBuilderT a0) initialEnv

733 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

734 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

734 , _hydrationDomBuilderEnv_commitAction = myCommitAction

735 , _hydrationDomBuilderEnv_commitAction = myCommitAction

735 , _hydrationDomBuilderEnv_hydrationNode = hydrationNode

736 , _hydrationDomBuilderEnv_hydrationNode = hydrationNode

736− , _hydrationDomBuilderEnv_parent = toNode df

737+ , _hydrationDomBuilderEnv_parent = p

737− , _hydrationDomBuilderEnv_hydrationMode = localHydrationMode

738+ , _hydrationDomBuilderEnv_hydrationResult = r

738 }

739 }

740+ h' <- liftIO $ readIORef r

739 liftIO $ readIORef unreadyChildren >>= \case

741 liftIO $ readIORef unreadyChildren >>= \case

740 0 -> writeIORef haveEverBeenReady True

742 0 -> writeIORef haveEverBeenReady True

741 _ -> modifyIORef' parentUnreadyChildren succ

743 _ -> modifyIORef' parentUnreadyChildren succ

742 liftIO $ putStrLn "drawInitialChild: end"

744 liftIO $ putStrLn "drawInitialChild: end"

743− return result

745+ return (h', result)

744 a'' <- numberOccurrences a'

746 a'' <- numberOccurrences a'

745 (result0, child') <- HydrationDomBuilderT $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(cohortId, child) -> do

747 (result0, child') <- HydrationDomBuilderT $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(cohortId, child) -> do

748+ p <- liftIO (readIORef hydrating) >>= \case

749+ HydrationMode_Hydrating -> pure parent

746− df <- createDocumentFragment doc

750+ HydrationMode_Immediate -> toNode <$> createDocumentFragment doc

747 unreadyChildren <- liftIO $ newIORef 0

751 unreadyChildren <- liftIO $ newIORef 0

748 let commitAction = do

752 let commitAction = do

749 liftIO $ putStrLn "Committing runWithReplace update"

753 liftIO $ putStrLn "Committing runWithReplace update"

750 c <- liftIO $ readIORef currentCohort

754 c <- liftIO $ readIORef currentCohort

751 when (c <= cohortId) $ do -- If a newer cohort has already been committed, just ignore this

755 when (c <= cohortId) $ do -- If a newer cohort has already been committed, just ignore this

752 deleteBetweenExclusive before after

756 deleteBetweenExclusive before after

753− insertBefore df after

757+ insertBefore p after

754 liftIO $ writeIORef currentCohort cohortId

758 liftIO $ writeIORef currentCohort cohortId

755 myCommitAction

759 myCommitAction

756 hydrationNode <- liftIO $ newIORef (Just $ toNode before)

760 hydrationNode <- liftIO $ newIORef (Just $ toNode before)

757− h <- liftIO $ readIORef hydrating

761+ r <- liftIO $ newIORef []

758− let child' = runReaderT (unHydrationDomBuilderT child) $ initialEnv

762+ result <- runReaderT (unHydrationDomBuilderT child) $ initialEnv

759 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

763 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

760 , _hydrationDomBuilderEnv_commitAction = commitAction

764 , _hydrationDomBuilderEnv_commitAction = commitAction

761 , _hydrationDomBuilderEnv_hydrationNode = hydrationNode

765 , _hydrationDomBuilderEnv_hydrationNode = hydrationNode

762− , _hydrationDomBuilderEnv_parent = toNode df

766+ , _hydrationDomBuilderEnv_parent = p

767+ , _hydrationDomBuilderEnv_hydrationResult = r

763 }

768 }

764 uc <- liftIO $ readIORef unreadyChildren

769 uc <- liftIO $ readIORef unreadyChildren

765− result <- case h of

770+ h <- liftIO $ readIORef hydrating

766− HydrationMode_Hydrating -> pure Nothing

771+ h' <- liftIO $ readIORef r

767− HydrationMode_Immediate -> do

768− liftIO $ putStrLn "Running child in immediate mode"

769− Just <$> child'

770 let commitActionToRunNow = if uc == 0

772 let commitActionToRunNow = if uc == 0

771 then Just $ commitAction

773 then Just $ commitAction

772 else Nothing -- A child will run it when unreadyChildren is decremented to 0

774 else Nothing -- A child will run it when unreadyChildren is decremented to 0

773 commitActionToRunNow' = if h == HydrationMode_Hydrating then Nothing else commitActionToRunNow

775 commitActionToRunNow' = if h == HydrationMode_Hydrating then Nothing else commitActionToRunNow

774− hydrationAction = if h == HydrationMode_Hydrating then Just child' else Nothing

776+ hydrationAction = if h == HydrationMode_Hydrating then Just h' else Nothing

775 return (hydrationAction, commitActionToRunNow', result)

777 return (hydrationAction, commitActionToRunNow', result)

776− let drawInitialChild' = do

777− unreadyChildren <- liftIO $ newIORef 0

778− hydrationNode <- liftIO $ newIORef (Just $ toNode before)

779− result <- runReaderT (unHydrationDomBuilderT a0) initialEnv

780− { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

781− , _hydrationDomBuilderEnv_commitAction = myCommitAction

782− , _hydrationDomBuilderEnv_hydrationNode = hydrationNode

783− }

784− return result

785 env <- HydrationDomBuilderT ask

778 env <- HydrationDomBuilderT ask

786 let f :: RequesterT t JSM Identity (TriggerEventT t m) x -> m ()

779 let f :: RequesterT t JSM Identity (TriggerEventT t m) x -> m ()

787 f = void . flip runHydrationDomBuilderT env . HydrationDomBuilderT . lift

780 f = void . flip runHydrationDomBuilderT env . HydrationDomBuilderT . lift

781+ g :: [Behavior t (m ())] -> Behavior t (m ())

782+ g = fmap (void . sequence) . sequence

788− beh <- hold (f drawInitialChild') (fmapMaybe (\(h,_,_) -> f <$> h) child')

783+ beh <- hold (g $ fst result0) (fmapMaybe (\(h,_,_) -> g <$> h) child')

789 hydrationResultRef <- HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_hydrationResult

784 hydrationResultRef <- HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_hydrationResult

790− liftIO $ modifyIORef' hydrationResultRef (beh :)

785+ liftIO $ modifyIORef' hydrationResultRef (join beh :)

791 requestDomAction_ $ fmapMaybe (\(_,c,_) -> c) child'

786 requestDomAction_ $ fmapMaybe (\(_,c,_) -> c) child'

792− return (result0, fmapMaybe (\(_,_,r) -> r) child')

787+ return (snd result0, fmap (\(_,_,r) -> r) child')

793

788

794 {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}

789 {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}

795 traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjust'

790 traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjust'