001ae25 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Minor cleanup

001ae25Tom Smalley8 years ago

reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+25−32

compare with develop

unifiedsplit

@@ -34,7 +34,6 @@ module Reflex.Dom.Builder.Hydration

34 ( EventTriggerRef (..)

35 , HydrationDomBuilderEnv (..)

36 , HydrationDomBuilderT (..)

37− , HydrationDomBuilderState (..)

38 , HydrationMode (..)

37 , HydrationMode (..)

39 , HydrationRunnerT (..)

38 , HydrationRunnerT (..)

40 , runHydrationRunnerT

39 , runHydrationRunnerT

@@ -237,7 +236,8 @@ data DOM t m

237 | DOM_Node (HydrationRunnerT t m ())

236 | DOM_Node (HydrationRunnerT t m ())

238 -- ^ Nodes without children

237 -- ^ Nodes without children

239 | DOM_Replace (HydrationRunnerT t m ()) (HydrationRunnerT t m ()) (Behavior t [DOM t m])

238 | DOM_Replace (HydrationRunnerT t m ()) (HydrationRunnerT t m ()) (Behavior t [DOM t m])

239+ -- ^ First and second fields setup the start and end markers respectively, the

240− -- ^ runWithReplace content changes over time

240+ -- third contains the actual content which changes over time

241

242runDOMForest

243 :: (Ref m ~ IORef, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, DOM.MonadJSM m, DOM.MonadJSM (Performable m), MonadRef m, MonadSample t m)

@@ -256,10 +256,6 @@ runDOMTree = \case

256 runDOMForest =<< lift (sample b)

257 end

258

259−data HydrationDomBuilderState t m = HydrationDomBuilderState

260− { _hydrationDomBuilderState_delayed :: [DOM t m]

261− }

262−

263-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events

259-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events

264-- State contains reference to the previous node sibling, if any.

260-- State contains reference to the previous node sibling, if any.

265-- TODO: This probably doesn't need to be a full transformer of `m`, seems like we only need (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m)

261-- TODO: This probably doesn't need to be a full transformer of `m`, seems like we only need (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m)

@@ -281,8 +277,10 @@ runHydrationRunnerT (HydrationRunnerT m) prev parent = runDomRenderHookT (runRea

281instance MonadTrans (HydrationRunnerT t) where

277instance MonadTrans (HydrationRunnerT t) where

282 lift = HydrationRunnerT . lift . lift . lift

278 lift = HydrationRunnerT . lift . lift . lift

283

279

284−addAction :: Monad m => DOM t m -> HydrationDomBuilderT t m ()

280+hydrateDOM :: MonadIO m => DOM t m -> HydrationDomBuilderT t m ()

285−addAction a = HydrationDomBuilderT $ modify $ \(HydrationDomBuilderState as) -> HydrationDomBuilderState (a : as)

281+hydrateDOM dom = getHydrationMode >>= \case

282+ HydrationMode_Hydrating -> HydrationDomBuilderT $ modify (dom :)

283+ HydrationMode_Immediate -> pure ()

286

284

287-- TODO probably can separate these two monads entirely, they have grown apart

285-- TODO probably can separate these two monads entirely, they have grown apart

288-- over the course of refactoring

286-- over the course of refactoring

@@ -292,7 +290,7 @@ addAction a = HydrationDomBuilderT $ modify $ \(HydrationDomBuilderState as) ->

292-- static builder). The action runs in 'HydrationRunnerT', which performs the

290-- static builder). The action runs in 'HydrationRunnerT', which performs the

293-- DOM takeover and sets up the events, after which point this monad will

291-- DOM takeover and sets up the events, after which point this monad will

294-- continue in the vein of 'ImmediateDomBuilderT'.

292-- continue in the vein of 'ImmediateDomBuilderT'.

295−newtype HydrationDomBuilderT t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT HydrationDomBuilderEnv (StateT (HydrationDomBuilderState t m) (DomRenderHookT t m)) a }

293+newtype HydrationDomBuilderT t m a = HydrationDomBuilderT { unHydrationDomBuilderT :: ReaderT HydrationDomBuilderEnv (StateT [DOM t m] (DomRenderHookT t m)) a }

296 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException

294 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException

297#if MIN_VERSION_base(4,9,1)

295#if MIN_VERSION_base(4,9,1)

298 , MonadAsyncException

296 , MonadAsyncException

@@ -364,21 +362,17 @@ runHydrationDomBuilderT

364 )

362 )

365 => HydrationDomBuilderT t m a

363 => HydrationDomBuilderT t m a

366 -> HydrationDomBuilderEnv

364 -> HydrationDomBuilderEnv

367− -> HydrationDomBuilderState t m

368 -> Chan [DSum (EventTriggerRef t) TriggerInvocation]

365 -> Chan [DSum (EventTriggerRef t) TriggerInvocation]

369− -> m (a, HydrationDomBuilderState t m)

366+ -> m (a, [DOM t m])

370−runHydrationDomBuilderT (HydrationDomBuilderT a) env st events = runDomRenderHookT (runStateT (runReaderT a env) st) events

367+runHydrationDomBuilderT (HydrationDomBuilderT a) env events = runDomRenderHookT (runStateT (runReaderT a env) []) events

371

368

372instance Monad m => HasDocument (HydrationDomBuilderT t m) where

369instance Monad m => HasDocument (HydrationDomBuilderT t m) where

373 {-# INLINABLE askDocument #-}

370 {-# INLINABLE askDocument #-}

374 askDocument = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document

371 askDocument = HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_document

375

372

376{-# INLINABLE localEnv #-}

373{-# INLINABLE localEnv #-}

377−localEnv :: Monad m => (HydrationDomBuilderState t m -> HydrationDomBuilderState t m) -> (HydrationDomBuilderEnv -> HydrationDomBuilderEnv) -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m a

374+localEnv :: Monad m => (HydrationDomBuilderEnv -> HydrationDomBuilderEnv) -> HydrationDomBuilderT t m a -> HydrationDomBuilderT t m a

378−localEnv f g (HydrationDomBuilderT m) = HydrationDomBuilderT $ do

375+localEnv f = HydrationDomBuilderT . local f . unHydrationDomBuilderT

379− env <- ask

380− hs <- get

381− lift $ lift $ evalStateT (runReaderT m $ g env) (f hs)

382

376

383{-# INLINABLE append #-}

377{-# INLINABLE append #-}

384append :: MonadJSM m => DOM.Node -> HydrationDomBuilderT t m ()

378append :: MonadJSM m => DOM.Node -> HydrationDomBuilderT t m ()

@@ -596,7 +590,7 @@ makeElement elementTag cfg child = do

596 e <- makeNodeInternal buildElement

590 e <- makeNodeInternal buildElement

597 p <- liftIO $ newIORef $ toNode e

591 p <- liftIO $ newIORef $ toNode e

598 -- Run the child builder with updated parent and previous sibling references

592 -- Run the child builder with updated parent and previous sibling references

599− result <- localEnv (\hs -> hs) (\env -> env { _hydrationDomBuilderEnv_parent = p }) child

593+ result <- localEnv (\env -> env { _hydrationDomBuilderEnv_parent = p }) child

600 events <- askEvents

594 events <- askEvents

601 eventTriggerRefs <- wrap events e $ extractRawElementConfig cfg

595 eventTriggerRefs <- wrap events e $ extractRawElementConfig cfg

602 es <- newFanEventWithTrigger $ triggerBody eventTriggerRefs e

596 es <- newFanEventWithTrigger $ triggerBody eventTriggerRefs e

@@ -606,8 +600,7 @@ makeElement elementTag cfg child = do

606 parent <- liftIO $ newIORef $ error "Parent not yet initialized"

600 parent <- liftIO $ newIORef $ error "Parent not yet initialized"

607 env <- HydrationDomBuilderT ask

601 env <- HydrationDomBuilderT ask

608 let env' = env { _hydrationDomBuilderEnv_parent = parent}

602 let env' = env { _hydrationDomBuilderEnv_parent = parent}

609− hs = HydrationDomBuilderState { _hydrationDomBuilderState_delayed = [] }

610− (result, hs') <- HydrationDomBuilderT $ lift $ lift $ runStateT (runReaderT (unHydrationDomBuilderT child) env') hs

603+ (result, childDom) <- HydrationDomBuilderT $ lift $ lift $ runStateT (runReaderT (unHydrationDomBuilderT child) env') []

611 wrapResult <- liftIO newEmptyMVar

604 wrapResult <- liftIO newEmptyMVar

612 let activateElement = do

605 let activateElement = do

613 e <- hydrateNode hasSSRAttribute buildElement DOM.Element

606 e <- hydrateNode hasSSRAttribute buildElement DOM.Element

@@ -617,7 +610,7 @@ makeElement elementTag cfg child = do

617 refs <- wrap events e $ extractRawElementConfig cfg

610 refs <- wrap events e $ extractRawElementConfig cfg

618 liftIO $ putMVar wrapResult (e, refs)

611 liftIO $ putMVar wrapResult (e, refs)

619 pure $ toNode e

612 pure $ toNode e

620− addAction $ DOM_Element activateElement $ _hydrationDomBuilderState_delayed hs'

613+ hydrateDOM $ DOM_Element activateElement childDom

621

614

622 -- We need the EventSelector to switch to the real event handler after activation

615 -- We need the EventSelector to switch to the real event handler after activation

623 es <- newFanEventWithTrigger $ \(WrapArg en) t -> do

616 es <- newFanEventWithTrigger $ \(WrapArg en) t -> do

@@ -657,7 +650,7 @@ textNodeInternal !t mSetContents = getHydrationMode >>= \case

657 -- Nothing -> liftIO $ putStrLn "No update events for text"

650 -- Nothing -> liftIO $ putStrLn "No update events for text"

658 -- Just e -> requestDomAction_ $ setNodeValue n . Just <$> e

651 -- Just e -> requestDomAction_ $ setNodeValue n . Just <$> e

659 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents

652 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents

660− addAction $ DOM_Node activateText

653+ hydrateDOM $ DOM_Node activateText

661 pure $ error "textNodeInternal: DOM.Text"

654 pure $ error "textNodeInternal: DOM.Text"

662

655

663{-# INLINABLE commentNodeInternal #-}

656{-# INLINABLE commentNodeInternal #-}

@@ -673,7 +666,7 @@ commentNodeInternal !t mSetContents = getHydrationMode >>= \case

673 liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)

666 liftIO $ putStrLn $ "Action: Comment: " <> show (DOM.toJSString t)

674 n <- hydrateNode (const $ pure True) (createComment doc t) DOM.Comment

667 n <- hydrateNode (const $ pure True) (createComment doc t) DOM.Comment

675 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents

668 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents

676− addAction $ DOM_Node activateComment

669+ hydrateDOM $ DOM_Node activateComment

677 pure $ error "commentNodeInternal: DOM.Comment"

670 pure $ error "commentNodeInternal: DOM.Comment"

678

671

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

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

@@ -722,7 +715,7 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case

722 liftIO $ do

715 liftIO $ do

723 writeIORef textNodeRef textNode

716 writeIORef textNodeRef textNode

724 writeIORef keyRef key

717 writeIORef keyRef key

725−-- addAction $ DOM_Node switchComment

718+-- hydrateDOM $ DOM_Node switchComment

726 pure (switchComment, textNodeRef, keyRef)

719 pure (switchComment, textNodeRef, keyRef)

727

720

728

721

@@ -894,7 +887,7 @@ instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomB

894 buildDomFragment w = do

887 buildDomFragment w = do

895 df <- createDocumentFragment =<< askDocument

888 df <- createDocumentFragment =<< askDocument

896 p <- liftIO $ newIORef $ toNode df

889 p <- liftIO $ newIORef $ toNode df

897− result <- localEnv id (\env -> env { _hydrationDomBuilderEnv_parent = p }) w

890+ result <- localEnv (\env -> env { _hydrationDomBuilderEnv_parent = p }) w

898 state <- liftIO $ newIORef FragmentState_Unmounted

891 state <- liftIO $ newIORef FragmentState_Unmounted

899 return (HydrationDomFragment df state, result)

892 return (HydrationDomFragment df state, result)

900 mountDomFragment fragment setFragment = do

893 mountDomFragment fragment setFragment = do

@@ -947,7 +940,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

947 HydrationMode_Hydrating -> liftIO $ newIORef parent

940 HydrationMode_Hydrating -> liftIO $ newIORef parent

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

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

949 unreadyChildren <- liftIO $ newIORef 0

942 unreadyChildren <- liftIO $ newIORef 0

950− (result, HydrationDomBuilderState h') <- flip runStateT (HydrationDomBuilderState []) $ runReaderT (unHydrationDomBuilderT a0) initialEnv

943+ (result, dom) <- flip runStateT [] $ runReaderT (unHydrationDomBuilderT a0) initialEnv

951 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

944 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

952 , _hydrationDomBuilderEnv_commitAction = myCommitAction

945 , _hydrationDomBuilderEnv_commitAction = myCommitAction

953 , _hydrationDomBuilderEnv_parent = p

946 , _hydrationDomBuilderEnv_parent = p

@@ -956,7 +949,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

956 0 -> writeIORef haveEverBeenReady True

949 0 -> writeIORef haveEverBeenReady True

957 _ -> modifyIORef' parentUnreadyChildren succ

950 _ -> modifyIORef' parentUnreadyChildren succ

958 liftIO $ putStrLn "drawInitialChild: end"

951 liftIO $ putStrLn "drawInitialChild: end"

959− return (h', result)

952+ return (dom, result)

960 a'' <- numberOccurrences a'

953 a'' <- numberOccurrences a'

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

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

962 h <- liftIO $ readIORef hydrating

955 h <- liftIO $ readIORef hydrating

@@ -975,7 +968,7 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

975 insertBefore p' after'

968 insertBefore p' after'

976 liftIO $ writeIORef currentCohort cohortId

969 liftIO $ writeIORef currentCohort cohortId

977 myCommitAction

970 myCommitAction

978− (result, HydrationDomBuilderState h') <- flip runStateT (HydrationDomBuilderState []) $ runReaderT (unHydrationDomBuilderT child) $ initialEnv

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

979 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

972 { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren

980 , _hydrationDomBuilderEnv_commitAction = case h of

973 , _hydrationDomBuilderEnv_commitAction = case h of

981 HydrationMode_Hydrating -> myCommitAction

974 HydrationMode_Hydrating -> myCommitAction

@@ -987,12 +980,12 @@ instance (Reflex t, Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimM

987 then Just $ commitAction

980 then Just $ commitAction

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

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

989 actions = case h of

982 actions = case h of

990− HydrationMode_Hydrating -> Left h'

983+ HydrationMode_Hydrating -> Left dom

991 HydrationMode_Immediate -> Right commitActionToRunNow

984 HydrationMode_Immediate -> Right commitActionToRunNow

992 return (actions, result)

985 return (actions, result)

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

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

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

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

995− addAction $ DOM_Replace hydrateStart hydrateEnd base

988+ hydrateDOM $ DOM_Replace hydrateStart hydrateEnd base

996 requestDomAction_ $ fmapMaybe id commitAction

989 requestDomAction_ $ fmapMaybe id commitAction

997 return (snd result0, fmap snd evt)

990 return (snd result0, fmap snd evt)

998

991

@@ -1303,7 +1296,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

1303

1296

1304{-# INLINABLE drawChildUpdate #-}

1297{-# INLINABLE drawChildUpdate #-}

1305drawChildUpdate :: (MonadIO m, MonadJSM m)

1298drawChildUpdate :: (MonadIO m, MonadJSM m)

1306− => IORef (HydrationDomBuilderState t m)

1299+ => IORef [DOM t m]

1307 -> HydrationDomBuilderEnv

1300 -> HydrationDomBuilderEnv

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

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

1309 -> HydrationDomBuilderT t m (v' a)

1302 -> HydrationDomBuilderT t m (v' a)

@@ -1341,7 +1334,7 @@ drawChildUpdate stateRef initialEnv markReady child = do

1341

1334

1342{-# INLINABLE drawChildUpdateInt #-}

1335{-# INLINABLE drawChildUpdateInt #-}

1343drawChildUpdateInt :: (MonadIO m, MonadJSM m)

1336drawChildUpdateInt :: (MonadIO m, MonadJSM m)

1344− => IORef (HydrationDomBuilderState t m)

1337+ => IORef [DOM t m]

1345 -> HydrationDomBuilderEnv

1338 -> HydrationDomBuilderEnv

1346 -> (IORef ChildReadyStateInt -> JSM ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready

1339 -> (IORef ChildReadyStateInt -> JSM ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready

1347 -> HydrationDomBuilderT t m v'

1340 -> HydrationDomBuilderT t m v'