git.iko.soy/reflex-dom
on develop help sign in
Re-add HasJS constraint to Prerender
28b8692Tom Smalley
reflex-dom-core/src/Reflex/Dom/Prerender.hs+23−18
compare with develop
unifiedsplit
@@ -1,4 +1,5 @@
1{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE EmptyDataDecls #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FunctionalDependencies #-}
5{-# LANGUAGE FunctionalDependencies #-}
@@ -38,16 +39,16 @@ import qualified GHCJS.DOM.Document as Document
38import qualified GHCJS.DOM.Node as Node
39import qualified GHCJS.DOM.Node as Node
39import qualified GHCJS.DOM.Types as DOM
40import qualified GHCJS.DOM.Types as DOM
40
41
41−type PrerenderClientConstraint t m =
42+type PrerenderClientConstraint js t m =
42 ( DomBuilder t m
43 ( DomBuilder t m
43 , DomBuilderSpace m ~ GhcjsDomSpace
44 , DomBuilderSpace m ~ GhcjsDomSpace
44 , HasDocument m
45 , HasDocument m
45 , TriggerEvent t m
46 , TriggerEvent t m
46− , Prerender t m
47+ , Prerender js t m
47− , PrerenderBaseConstraints t m
48+ , PrerenderBaseConstraints js t m
48 )
49 )
49
50
50−type PrerenderBaseConstraints t m =
51+type PrerenderBaseConstraints js t m =
51 ( HasJSContext (Performable m)
52 ( HasJSContext (Performable m)
52 , HasJSContext m
53 , HasJSContext m
53 , MonadFix m
54 , MonadFix m
@@ -63,28 +64,30 @@ type PrerenderBaseConstraints t m =
63 , PrimMonad m
64 , PrimMonad m
64 , Ref (Performable m) ~ IORef
65 , Ref (Performable m) ~ IORef
65 , Ref m ~ IORef
66 , Ref m ~ IORef
67+ , HasJS js m
68+ , HasJS js (Performable m)
66 )
69 )
67
70
68-- | Render the first widget on the server, and the second on the client. The
71-- | Render the first widget on the server, and the second on the client. The
69-- hydration builder will run *both* widgets.
72-- hydration builder will run *both* widgets.
70prerender_
73prerender_
71− :: (Functor m, Reflex t, Prerender t m)
74+ :: (Functor m, Reflex t, Prerender js t m)
72− => m () -> ((PrerenderClientConstraint t (Client m)) => Client m ()) -> m ()
75+ => m () -> ((PrerenderClientConstraint js t (Client m)) => Client m ()) -> m ()
73prerender_ server client = void $ prerender server client
76prerender_ server client = void $ prerender server client
74
77
75−class Prerender t m | m -> t where
78+class Prerender js t m | m -> t js where
76 -- | Monad in which the client widget is built
79 -- | Monad in which the client widget is built
77 type Client m :: * -> *
80 type Client m :: * -> *
78 -- | Render the first widget on the server, and the second on the client. The
81 -- | Render the first widget on the server, and the second on the client. The
79 -- hydration builder will run *both* widgets, updating the result dynamic at
82 -- hydration builder will run *both* widgets, updating the result dynamic at
80 -- switchover time.
83 -- switchover time.
81− prerender :: m a -> ((PrerenderClientConstraint t (Client m)) => Client m a) -> m (Dynamic t a)
84+ prerender :: m a -> ((PrerenderClientConstraint js t (Client m)) => Client m a) -> m (Dynamic t a)
82
85
83−instance (Adjustable t m, PrerenderBaseConstraints t m) => Prerender t (HydrationDomBuilderT GhcjsDomSpace t m) where
86+instance (ReflexHost t, Adjustable t m, PrerenderBaseConstraints js t m) => Prerender js t (HydrationDomBuilderT GhcjsDomSpace t m) where
84 type Client (HydrationDomBuilderT GhcjsDomSpace t m) = HydrationDomBuilderT GhcjsDomSpace t m
87 type Client (HydrationDomBuilderT GhcjsDomSpace t m) = HydrationDomBuilderT GhcjsDomSpace t m
85 prerender _ client = pure <$> client
88 prerender _ client = pure <$> client
86
89
87−instance (Adjustable t m, PrerenderBaseConstraints t m, ReflexHost t) => Prerender t (HydrationDomBuilderT HydrationDomSpace t m) where
90+instance (Adjustable t m, PrerenderBaseConstraints js t m, ReflexHost t) => Prerender js t (HydrationDomBuilderT HydrationDomSpace t m) where
88 -- | PostBuildT is needed here because we delay running the client builder
91 -- | PostBuildT is needed here because we delay running the client builder
89 -- until after switchover, at which point the postBuild of @m@ has already fired
92 -- until after switchover, at which point the postBuild of @m@ has already fired
90 type Client (HydrationDomBuilderT HydrationDomSpace t m) = PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m)
93 type Client (HydrationDomBuilderT HydrationDomSpace t m) = PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m)
@@ -118,7 +121,9 @@ instance (Adjustable t m, PrerenderBaseConstraints t m, ReflexHost t) => Prerend
118 insertBefore df =<< deleteToPrerenderEnd doc
121 insertBefore df =<< deleteToPrerenderEnd doc
119 holdDyn a0 a'
122 holdDyn a0 a'
120
123
124+data NoJavaScript -- This type should never have a HasJS instance
125+
121−instance SupportsStaticDomBuilder t m => Prerender t (StaticDomBuilderT t m) where
126+instance (js ~ NoJavaScript, SupportsStaticDomBuilder t m) => Prerender js t (StaticDomBuilderT t m) where
122 type Client (StaticDomBuilderT t m) = HydrationDomBuilderT GhcjsDomSpace t m
127 type Client (StaticDomBuilderT t m) = HydrationDomBuilderT GhcjsDomSpace t m
123 prerender server _ = do
128 prerender server _ = do
124 _ <- commentNode $ CommentNodeConfig startMarker Nothing
129 _ <- commentNode $ CommentNodeConfig startMarker Nothing
@@ -126,13 +131,13 @@ instance SupportsStaticDomBuilder t m => Prerender t (StaticDomBuilderT t m) whe
126 _ <- commentNode $ CommentNodeConfig endMarker Nothing
131 _ <- commentNode $ CommentNodeConfig endMarker Nothing
127 pure $ pure a
132 pure $ pure a
128
133
129−instance (Prerender t m, Monad m) => Prerender t (ReaderT r m) where
134+instance (Prerender js t m, Monad m) => Prerender js t (ReaderT r m) where
130 type Client (ReaderT r m) = ReaderT r (Client m)
135 type Client (ReaderT r m) = ReaderT r (Client m)
131 prerender server client = do
136 prerender server client = do
132 r <- ask
137 r <- ask
133 lift $ prerender (runReaderT server r) (runReaderT client r)
138 lift $ prerender (runReaderT server r) (runReaderT client r)
134
139
135−instance (Prerender t m, Monad m, Reflex t, MonadFix m, Monoid w) => Prerender t (DynamicWriterT t w m) where
140+instance (Prerender js t m, Monad m, Reflex t, MonadFix m, Monoid w) => Prerender js t (DynamicWriterT t w m) where
136 type Client (DynamicWriterT t w m) = DynamicWriterT t w (Client m)
141 type Client (DynamicWriterT t w m) = DynamicWriterT t w (Client m)
137 prerender server client = do
142 prerender server client = do
138 x <- lift $ prerender (runDynamicWriterT server) (runDynamicWriterT client)
143 x <- lift $ prerender (runDynamicWriterT server) (runDynamicWriterT client)
@@ -141,7 +146,7 @@ instance (Prerender t m, Monad m, Reflex t, MonadFix m, Monoid w) => Prerender t
141 tellDyn w
146 tellDyn w
142 pure a
147 pure a
143
148
144−instance (Prerender t m, Monad m, Reflex t, Semigroup w) => Prerender t (EventWriterT t w m) where
149+instance (Prerender js t m, Monad m, Reflex t, Semigroup w) => Prerender js t (EventWriterT t w m) where
145 type Client (EventWriterT t w m) = EventWriterT t w (Client m)
150 type Client (EventWriterT t w m) = EventWriterT t w (Client m)
146 prerender server client = do
151 prerender server client = do
147 x <- lift $ prerender (runEventWriterT server) (runEventWriterT client)
152 x <- lift $ prerender (runEventWriterT server) (runEventWriterT client)
@@ -151,7 +156,7 @@ instance (Prerender t m, Monad m, Reflex t, Semigroup w) => Prerender t (EventWr
151 pure a
156 pure a
152
157
153-- TODO
158-- TODO
154−--instance (Prerender t m, Monad m) => Prerender t (RequesterT t request response m) where
159+--instance (Prerender js t m, Monad m) => Prerender js t (RequesterT t request response m) where
155-- type Client (RequesterT t request response m) = RequesterT t request response (Client m)
160-- type Client (RequesterT t request response m) = RequesterT t request response (Client m)
156-- prerender server client = mdo
161-- prerender server client = mdo
157-- response :: Event t (RequesterData response) <- requesting request
162-- response :: Event t (RequesterData response) <- requesting request
@@ -160,7 +165,7 @@ instance (Prerender t m, Monad m, Reflex t, Semigroup w) => Prerender t (EventWr
160-- request = switch $ current request' :: Event t (RequesterData request)
165-- request = switch $ current request' :: Event t (RequesterData request)
161-- pure a
166-- pure a
162
167
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+instance (Prerender js t m, Monad m, Reflex t, MonadFix m, Group q, Additive q, Query q) => Prerender js t (QueryT t q m) where
164 type Client (QueryT t q m) = QueryT t q (Client m)
169 type Client (QueryT t q m) = QueryT t q (Client m)
165 prerender server client = mdo
170 prerender server client = mdo
166 result <- queryDyn query
171 result <- queryDyn query
@@ -169,11 +174,11 @@ instance (Prerender t m, Monad m, Reflex t, MonadFix m, Group q, Additive q, Que
169 query = incrementalToDynamic =<< inc -- Can we avoid the incrementalToDynamic?
174 query = incrementalToDynamic =<< inc -- Can we avoid the incrementalToDynamic?
170 pure a
175 pure a
171
176
172−instance (Prerender t m, Monad m) => Prerender t (InputDisabledT m) where
177+instance (Prerender js t m, Monad m) => Prerender js t (InputDisabledT m) where
173 type Client (InputDisabledT m) = Client m
178 type Client (InputDisabledT m) = Client m
174 prerender (InputDisabledT server) client = InputDisabledT $ prerender server client
179 prerender (InputDisabledT server) client = InputDisabledT $ prerender server client
175
180
176−instance (Prerender t m, Monad m, ReflexHost t) => Prerender t (PostBuildT t m) where
181+instance (Prerender js t m, Monad m, ReflexHost t) => Prerender js t (PostBuildT t m) where
177 type Client (PostBuildT t m) = PostBuildT t (Client m)
182 type Client (PostBuildT t m) = PostBuildT t (Client m)
178 prerender server client = PostBuildT $ do
183 prerender server client = PostBuildT $ do
179 pb <- ask
184 pb <- ask
reflex-dom-core/test/hydration.hs+2−2
@@ -1306,7 +1306,7 @@ withSeleniumServer f = do
1306 , _selenium_stopServer = stopServer
1306 , _selenium_stopServer = stopServer
1307 }
1307 }
1308
1308
1309−triggerEventWithChan :: (Reflex t, TriggerEvent t m, Prerender t m) => Chan a -> m (Event t a)
1309+triggerEventWithChan :: (Reflex t, TriggerEvent t m, Prerender js t m) => Chan a -> m (Event t a)
1310triggerEventWithChan chan = do
1310triggerEventWithChan chan = do
1311 (e, trigger) <- newTriggerEvent
1311 (e, trigger) <- newTriggerEvent
1312 -- In prerender because we only want to do this on the client
1312 -- In prerender because we only want to do this on the client
@@ -1338,7 +1338,7 @@ checkTextInId i expected = WD.findElem (WD.ById i) >>= shouldContainText expecte
1338divId :: DomBuilder t m => Text -> m a -> m a
1338divId :: DomBuilder t m => Text -> m a -> m a
1339divId i = elAttr "div" ("id" =: i)
1339divId i = elAttr "div" ("id" =: i)
1340
1340
1341−type TestWidget n t m = (DomBuilder t m, MonadHold t m, PostBuild t m, Prerender t m, PerformEvent t m, TriggerEvent t m, MonadFix m, MonadIO (Performable m), MonadIO m)
1341+type TestWidget js t m = (DomBuilder t m, MonadHold t m, PostBuild t m, Prerender js t m, PerformEvent t m, TriggerEvent t m, MonadFix m, MonadIO (Performable m), MonadIO m)
1342
1342
1343testWidgetStatic
1343testWidgetStatic
1344 :: WD b
1344 :: WD b