a52d315 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Minor runWithReplace fixes

a52d315Tom Smalley8 years ago

reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+11−19

compare with develop

unifiedsplit

@@ -671,7 +671,11 @@ commentNodeInternal !t mSetContents = getHydrationMode >>= \case

671

672-- | We leave markers in the static builder as comments, and rip these comments

673-- out at hydration time, replacing them with empty text nodes.

674+skipToAndReplaceComment

675+ :: (MonadJSM m, Reflex t, MonadFix m)

676+ => Text

677+ -> IORef Text

674−skipToAndReplaceComment :: (MonadJSM m, Reflex t, MonadFix m) => Text -> IORef Text -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)

678+ -> HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)

675skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case

679skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case

676 HydrationMode_Immediate -> do

680 HydrationMode_Immediate -> do

677 -- If we're in immediate mode, we don't try to replace an existing comment,

681 -- If we're in immediate mode, we don't try to replace an existing comment,

@@ -691,8 +695,6 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case

691 DOM.castTo DOM.Comment node >>= \case

695 DOM.castTo DOM.Comment node >>= \case

692 Just comment -> do

696 Just comment -> do

693 commentText <- Node.getTextContentUnchecked comment

697 commentText <- Node.getTextContentUnchecked comment

694− liftIO $ putStr $ T.unpack $ "[" <> prefix <> "]"

695− liftIO $ putStr $ T.unpack $ "{" <> commentText <> "}"

696 case T.stripPrefix (prefix <> key0) commentText of

698 case T.stripPrefix (prefix <> key0) commentText of

697 Just key -> do

699 Just key -> do

698 -- Replace the comment with an (invisible) text node

700 -- Replace the comment with an (invisible) text node

@@ -708,17 +710,13 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case

708 go key0 (Just node)

710 go key0 (Just node)

709 switchComment = do

711 switchComment = do

710 key0 <- liftIO $ readIORef key0Ref

712 key0 <- liftIO $ readIORef key0Ref

711− liftIO $ putStrLn $ "///////////////////////////////// switchComment " <> T.unpack key0

712 (textNode, key) <- go key0 =<< getPreviousNode

713 (textNode, key) <- go key0 =<< getPreviousNode

713− liftIO $ putStrLn $ T.unpack key

714 setPreviousNode $ Just $ toNode textNode

715 liftIO $ do

716 writeIORef textNodeRef textNode

717 writeIORef keyRef key

718−-- hydrateDOM $ DOM_Node switchComment

719 pure (switchComment, textNodeRef, keyRef)

718 pure (switchComment, textNodeRef, keyRef)

720

719

721−

722skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m) => HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)

720skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m) => HydrationDomBuilderT t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)

723skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")

721skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")

724

722

@@ -913,10 +911,8 @@ instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjus

913instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, Ref m ~ IORef, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadRef m) => Adjustable t (HydrationDomBuilderT t m) where

911instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, Ref m ~ IORef, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadRef m) => Adjustable t (HydrationDomBuilderT t m) where

914 {-# INLINABLE runWithReplace #-}

912 {-# INLINABLE runWithReplace #-}

915 runWithReplace a0 a' = do

913 runWithReplace a0 a' = do

916− liftIO $ putStrLn "In runWithReplace"

917 initialEnv <- HydrationDomBuilderT ask

914 initialEnv <- HydrationDomBuilderT ask

918 let hydrating = _hydrationDomBuilderEnv_hydrationMode initialEnv

915 let hydrating = _hydrationDomBuilderEnv_hydrationMode initialEnv

919− initialHydrationMode <- liftIO $ readIORef hydrating

920 (hydrateStart, before, beforeKey) <- skipToReplaceStart

916 (hydrateStart, before, beforeKey) <- skipToReplaceStart

921 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

917 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv

922 haveEverBeenReady <- liftIO $ newIORef False

918 haveEverBeenReady <- liftIO $ newIORef False

@@ -935,7 +931,6 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

935 parent <- getParent

931 parent <- getParent

936 (hydrateEnd, after) <- skipToReplaceEnd beforeKey

932 (hydrateEnd, after) <- skipToReplaceEnd beforeKey

937 let drawInitialChild = do

933 let drawInitialChild = do

938− liftIO $ putStrLn "drawInitialChild"

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

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

940 HydrationMode_Hydrating -> liftIO $ newIORef parent

935 HydrationMode_Hydrating -> liftIO $ newIORef parent

941 HydrationMode_Immediate -> liftIO . newIORef . toNode =<< createDocumentFragment doc

936 HydrationMode_Immediate -> liftIO . newIORef . toNode =<< createDocumentFragment doc

@@ -948,10 +943,9 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

948 liftIO $ readIORef unreadyChildren >>= \case

943 liftIO $ readIORef unreadyChildren >>= \case

949 0 -> writeIORef haveEverBeenReady True

944 0 -> writeIORef haveEverBeenReady True

950 _ -> modifyIORef' parentUnreadyChildren succ

945 _ -> modifyIORef' parentUnreadyChildren succ

951− liftIO $ putStrLn "drawInitialChild: end"

952 return (dom, result)

946 return (dom, result)

953 a'' <- numberOccurrences a'

947 a'' <- numberOccurrences a'

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

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

955 h <- liftIO $ readIORef hydrating

949 h <- liftIO $ readIORef hydrating

956 p' <- case h of

950 p' <- case h of

957 HydrationMode_Hydrating -> pure parent

951 HydrationMode_Hydrating -> pure parent

@@ -959,11 +953,10 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

959 p <- liftIO $ newIORef p'

953 p <- liftIO $ newIORef p'

960 unreadyChildren <- liftIO $ newIORef 0

954 unreadyChildren <- liftIO $ newIORef 0

961 let commitAction = do

955 let commitAction = do

962− liftIO $ putStrLn "Committing runWithReplace update"

963 c <- liftIO $ readIORef currentCohort

956 c <- liftIO $ readIORef currentCohort

964− !before' <- liftIO $ readIORef before

965− !after' <- liftIO $ readIORef after

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

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

958+ !before' <- liftIO $ readIORef before

959+ !after' <- liftIO $ readIORef after

967 deleteBetweenExclusive before' after'

960 deleteBetweenExclusive before' after'

968 insertBefore p' after'

961 insertBefore p' after'

969 liftIO $ writeIORef currentCohort cohortId

962 liftIO $ writeIORef currentCohort cohortId

@@ -983,11 +976,10 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

983 HydrationMode_Hydrating -> Left dom

976 HydrationMode_Hydrating -> Left dom

984 HydrationMode_Immediate -> Right commitActionToRunNow

977 HydrationMode_Immediate -> Right commitActionToRunNow

985 return (actions, result)

978 return (actions, result)

986− let (hydrationAction, commitAction) = fanEither $ fmap fst evt

979+ let (hydrate', commitAction) = fanEither $ fmap fst child'

987− base :: Behavior t [DOM t m] <- hold (fst result0) hydrationAction

988− hydrateDOM $ DOM_Replace hydrateStart hydrateEnd base

980+ hydrateDOM . DOM_Replace hydrateStart hydrateEnd =<< hold hydrate0 hydrate'

989 requestDomAction_ $ fmapMaybe id commitAction

981 requestDomAction_ $ fmapMaybe id commitAction

990− return (snd result0, fmap snd evt)

982+ return (result0, snd <$> child')

991

983

992 {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}

984 {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}

993 traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjust'

985 traverseIntMapWithKeyWithAdjust = traverseIntMapWithKeyWithAdjust'