@@ -6,6 +6,7 @@
6{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE Rank2Types #-}
8{-# LANGUAGE Rank2Types #-}
9+{-# LANGUAGE RecursiveDo #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeSynonymInstances #-}
12{-# LANGUAGE TypeSynonymInstances #-}
@@ -14,7 +15,6 @@
14-- | Render the first widget on the server, and the second on the client.
15-- | Render the first widget on the server, and the second on the client.
15module Reflex.Dom.Prerender
16module Reflex.Dom.Prerender
16 ( Prerender (..)
17 ( Prerender (..)
18 , prerender_
18 , prerender_
19 , PrerenderClientConstraint
19 , PrerenderClientConstraint
20 , PrerenderBaseConstraints
20 , PrerenderBaseConstraints
@@ -23,8 +23,6 @@ module Reflex.Dom.Prerender
23import Control.Monad.Primitive (PrimMonad)
23import Control.Monad.Primitive (PrimMonad)
24import Control.Monad.Reader
24import Control.Monad.Reader
25import Control.Monad.Ref (MonadRef(..))
25import Control.Monad.Ref (MonadRef(..))
26−import Control.Monad.State.Strict
27−import Data.Foldable (traverse_)
28import Data.IORef (IORef, newIORef)
26import Data.IORef (IORef, newIORef)
29import Data.Text (Text)
27import Data.Text (Text)
30import Foreign.JavaScript.TH
28import Foreign.JavaScript.TH
@@ -67,40 +65,32 @@ type PrerenderBaseConstraints t m =
67 , Ref m ~ IORef
65 , Ref m ~ IORef
70−-- | Render the first widget on the server, and the second on the client. The
71−-- hydration builder will run *both* widgets, updating the result dynamic at
74− :: (Functor m, Prerender t m)
75− => m a -> ((PrerenderClientConstraint t (Client m)) => Client m a) -> m (Dynamic t a)
76−prerender server client = snd <$> prerenderImpl ((,) () <$> server) client
78-- | Render the first widget on the server, and the second on the client. The
68-- | Render the first widget on the server, and the second on the client. The
79-- hydration builder will run *both* widgets.
69-- hydration builder will run *both* widgets.
81 :: (Functor m, Reflex t, Prerender t m)
71 :: (Functor m, Reflex t, Prerender t m)
82 => m () -> ((PrerenderClientConstraint t (Client m)) => Client m ()) -> m ()
72 => m () -> ((PrerenderClientConstraint t (Client m)) => Client m ()) -> m ()
83−prerender_ server client = void $ prerenderImpl ((,) () <$> server) client
73+prerender_ server client = void $ prerender server client
85class Prerender t m | m -> t where
75class Prerender t m | m -> t where
86 -- | Monad in which the client widget is built
76 -- | Monad in which the client widget is built
87 type Client m :: * -> *
77 type Client m :: * -> *
88− -- | This function should be considered internal: it should only be used where
78+ -- | Render the first widget on the server, and the second on the client. The
89− -- the resultant 'Maybe' isn't used to change what is built in the DOM, or
79+ -- hydration builder will run *both* widgets, updating the result dynamic at
90− -- hydration will fail.
80+ -- switchover time.
91− prerenderImpl :: m (a, b) -> ((PrerenderClientConstraint t (Client m)) => Client m b) -> m (Maybe a, Dynamic t b)
81+ prerender :: m a -> ((PrerenderClientConstraint t (Client m)) => Client m a) -> m (Dynamic t a)
93instance (Adjustable t m, PrerenderBaseConstraints t m) => Prerender t (HydrationDomBuilderT GhcjsDomSpace t m) where
83instance (Adjustable t m, PrerenderBaseConstraints t m) => Prerender t (HydrationDomBuilderT GhcjsDomSpace t m) where
94 type Client (HydrationDomBuilderT GhcjsDomSpace t m) = HydrationDomBuilderT GhcjsDomSpace t m
84 type Client (HydrationDomBuilderT GhcjsDomSpace t m) = HydrationDomBuilderT GhcjsDomSpace t m
95− prerenderImpl _ client = (,) Nothing . pure <$> client
85+ prerender _ client = pure <$> client
97instance (Adjustable t m, PrerenderBaseConstraints t m, ReflexHost t) => Prerender t (HydrationDomBuilderT HydrationDomSpace t m) where
87instance (Adjustable t m, PrerenderBaseConstraints t m, ReflexHost t) => Prerender t (HydrationDomBuilderT HydrationDomSpace t m) where
98 -- | PostBuildT is needed here because we delay running the client builder
88 -- | PostBuildT is needed here because we delay running the client builder
99 -- until after switchover, at which point the postBuild of @m@ has already fired
89 -- until after switchover, at which point the postBuild of @m@ has already fired
100− type Client (HydrationDomBuilderT HydrationDomSpace t m) = PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m) -- PostBuildT t (ImmediateDomBuilderT t m)
90+ type Client (HydrationDomBuilderT HydrationDomSpace t m) = PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m)
101 -- | Runs the server widget up until switchover, then replaces it with the
91 -- | Runs the server widget up until switchover, then replaces it with the
102 -- client widget.
92 -- client widget.
103− prerenderImpl server client = do
93+ prerender server client = do
104 env <- HydrationDomBuilderT ask
94 env <- HydrationDomBuilderT ask
105 events <- askEvents
95 events <- askEvents
106 doc <- askDocument
96 doc <- askDocument
@@ -117,64 +107,77 @@ instance (Adjustable t m, PrerenderBaseConstraints t m, ReflexHost t) => Prerend
117 , _hydrationDomBuilderEnv_hydrationMode = hydrationMode
107 , _hydrationDomBuilderEnv_hydrationMode = hydrationMode
118 , _hydrationDomBuilderEnv_switchover = never
108 , _hydrationDomBuilderEnv_switchover = never
120− (a, b0) <- lift $ runHydrationDomBuilderT server (env { _hydrationDomBuilderEnv_delayed = delayed }) events
110+ a0 <- lift $ runHydrationDomBuilderT server (env { _hydrationDomBuilderEnv_delayed = delayed }) events
121− (b', trigger) <- newTriggerEvent
111+ (a', trigger) <- newTriggerEvent
122 getHydrationMode >>= \case
112 getHydrationMode >>= \case
123 HydrationMode_Immediate -> do
113 HydrationMode_Immediate -> do
124− liftIO . trigger <=< lift $ runHydrationDomBuilderT (runPostBuildT client $ void b') env' events
114+ liftIO . trigger <=< lift $ runHydrationDomBuilderT (runPostBuildT client $ void a') env' events
125 append $ DOM.toNode df
115 append $ DOM.toNode df
126 HydrationMode_Hydrating -> addHydrationStep $ do
116 HydrationMode_Hydrating -> addHydrationStep $ do
127− liftIO . trigger <=< lift $ runHydrationDomBuilderT (runPostBuildT client $ void b') env' events
117+ liftIO . trigger <=< lift $ runHydrationDomBuilderT (runPostBuildT client $ void a') env' events
128 insertBefore df =<< deleteToPrerenderEnd doc
118 insertBefore df =<< deleteToPrerenderEnd doc
129− (,) (Just a) <$> holdDyn b0 b'
119+ holdDyn a0 a'
131instance SupportsStaticDomBuilder t m => Prerender t (StaticDomBuilderT t m) where
121instance SupportsStaticDomBuilder t m => Prerender t (StaticDomBuilderT t m) where
132 type Client (StaticDomBuilderT t m) = HydrationDomBuilderT GhcjsDomSpace t m
122 type Client (StaticDomBuilderT t m) = HydrationDomBuilderT GhcjsDomSpace t m
133− prerenderImpl server _ = do
123+ prerender server _ = do
134 _ <- commentNode $ CommentNodeConfig startMarker Nothing
124 _ <- commentNode $ CommentNodeConfig startMarker Nothing
135− (a, b) <- server
125+ a <- server
136 _ <- commentNode $ CommentNodeConfig endMarker Nothing
126 _ <- commentNode $ CommentNodeConfig endMarker Nothing
137− pure (Just a, pure b)
127+ pure $ pure a
139instance (Prerender t m, Monad m) => Prerender t (ReaderT r m) where
129instance (Prerender t m, Monad m) => Prerender t (ReaderT r m) where
140− type Client (ReaderT r m) = Client m
130+ type Client (ReaderT r m) = ReaderT r (Client m)
141− prerenderImpl server client = do
131+ prerender server client = do
143− lift $ prerenderImpl (runReaderT server r) client
133+ lift $ prerender (runReaderT server r) (runReaderT client r)
145−instance (Prerender t m, Monad m, Functor (Client m)) => Prerender t (StateT s m) where
135+instance (Prerender t m, Monad m, Reflex t, MonadFix m, Monoid w) => Prerender t (DynamicWriterT t w m) where
146− type Client (StateT s m) = Client m
136+ type Client (DynamicWriterT t w m) = DynamicWriterT t w (Client m)
147− prerenderImpl server client = do
137+ prerender server client = do
148− s <- get
138+ x <- lift $ prerender (runDynamicWriterT server) (runDynamicWriterT client)
149− (ma, evt) <- lift $ prerenderImpl
139+ let (a, w') = splitDynPure x
150− (do ((a, b), s') <- runStateT server s; pure ((a, s'), b))
140+ w = join w'
151− client
141+ tellDyn w
152− traverse_ (put . snd) ma
153− pure (fst <$> ma, evt)
142+ pure a
155−instance (Prerender t m, Monad m, Functor (Client m)) => Prerender t (DynamicWriterT t w m) where
144+instance (Prerender t m, Monad m, Reflex t, Semigroup w) => Prerender t (EventWriterT t w m) where
156− type Client (DynamicWriterT t w m) = Client m
145+ type Client (EventWriterT t w m) = EventWriterT t w (Client m)
157− prerenderImpl (DynamicWriterT server) client = DynamicWriterT $ prerenderImpl server client
146+ prerender server client = do
158−
147+ x <- lift $ prerender (runEventWriterT server) (runEventWriterT client)
148+ let (a, w') = splitDynPure x
149+ w = switch $ current w'
159−instance (Prerender t m, Monad m, Functor (Client m)) => Prerender t (EventWriterT t w m) where
154+--instance (Prerender t m, Monad m) => Prerender t (RequesterT t request response m) where
160− type Client (EventWriterT t w m) = Client m
155+-- type Client (RequesterT t request response m) = RequesterT t request response (Client m)
161− prerenderImpl (EventWriterT server) client = EventWriterT $ prerenderImpl server client
156+-- prerender server client = mdo
162−
157+-- response :: Event t (RequesterData response) <- requesting request
163−instance (Prerender t m, Monad m, Functor (Client m)) => Prerender t (RequesterT t request response m) where
158+-- x <- lift $ prerender (runRequesterT server response) (runRequesterT client response)
164− type Client (RequesterT t request response m) = Client m
159+-- let (a, request') = splitDynPure x
165− prerenderImpl (RequesterT server) client = RequesterT $ prerenderImpl server client
160+-- request = switch $ current request' :: Event t (RequesterData request)
167−instance (Prerender t m, Monad m, Functor (Client m)) => Prerender t (QueryT t q m) where
163+instance (Prerender t m, Monad m, Reflex t, MonadFix m, Group q, Additive q, Query q) => Prerender t (QueryT t q m) where
168− type Client (QueryT t q m) = Client m
164+ type Client (QueryT t q m) = QueryT t q (Client m)
169− prerenderImpl (QueryT server) client = QueryT $ prerenderImpl server client
165+ prerender server client = mdo
166+ result <- queryDyn query
167+ x <- lift $ prerender (runQueryT server result) (runQueryT client result)
168+ let (a, inc) = splitDynPure x
169+ query = incrementalToDynamic =<< inc -- Can we avoid the incrementalToDynamic?
171instance (Prerender t m, Monad m) => Prerender t (InputDisabledT m) where
172instance (Prerender t m, Monad m) => Prerender t (InputDisabledT m) where
172 type Client (InputDisabledT m) = Client m
173 type Client (InputDisabledT m) = Client m
173− prerenderImpl (InputDisabledT server) client = InputDisabledT $ prerenderImpl server client
174+ prerender (InputDisabledT server) client = InputDisabledT $ prerender server client
175−instance (Prerender t m, Monad m) => Prerender t (PostBuildT t m) where
176+instance (Prerender t m, Monad m, ReflexHost t) => Prerender t (PostBuildT t m) where
176− type Client (PostBuildT t m) = Client m
177+ type Client (PostBuildT t m) = PostBuildT t (Client m)
177− prerenderImpl (PostBuildT server) client = PostBuildT $ prerenderImpl server client
178+ prerender server client = PostBuildT $ do
180+ lift $ prerender (runPostBuildT server pb) (runPostBuildT client pb)
179startMarker, endMarker :: Text
182startMarker, endMarker :: Text
180startMarker = "prerender/start"
183startMarker = "prerender/start"