@@ -1,8 +1,9 @@
11{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE EmptyDataDecls #-}
2+{-# LANGUAGE EmptyCase #-}
33{-# LANGUAGE FlexibleContexts #-}
44{-# LANGUAGE FlexibleInstances #-}
55{-# LANGUAGE FunctionalDependencies #-}
6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
67{-# LANGUAGE LambdaCase #-}
78{-# LANGUAGE OverloadedStrings #-}
89{-# LANGUAGE Rank2Types #-}
@@ -10,6 +11,7 @@
1011{-# LANGUAGE ScopedTypeVariables #-}
1112{-# LANGUAGE TypeFamilies #-}
1213{-# LANGUAGE UndecidableInstances #-}
14+{-# LANGUAGE UndecidableSuperClasses #-}
1315
1416-- | Render the first widget on the server, and the second on the client.
1517module Reflex.Dom.Prerender
@@ -19,12 +21,13 @@ module Reflex.Dom.Prerender
1921 , PrerenderBaseConstraints
2022 ) where
2123
22−import Control.Monad.Primitive (PrimMonad)
24+import Control.Monad.Primitive (PrimMonad(..))
2325import Control.Monad.Reader
2426import Control.Monad.Ref (MonadRef(..))
2527import Data.IORef (IORef, newIORef)
2628import Data.Semigroup (Semigroup)
2729import Data.Text (Text)
30+import Data.Void
2831import Foreign.JavaScript.TH
2932import GHCJS.DOM.Types (MonadJSM)
3033import Reflex hiding (askEvents)
@@ -33,7 +36,6 @@ import Reflex.Dom.Builder.Immediate
3336import Reflex.Dom.Builder.InputDisabled
3437import Reflex.Dom.Builder.Static
3538import Reflex.Host.Class
36−import Reflex.Requester.Base
3739import Data.IntMap.Strict (IntMap)
3840import qualified Data.IntMap.Strict as IntMap
3941
@@ -47,7 +49,6 @@ type PrerenderClientConstraint js t m =
4749 , DomRenderHook t m
4850 , HasDocument m
4951 , TriggerEvent t m
50− , Prerender js t m
5152 , PrerenderBaseConstraints js t m
5253 )
5354
@@ -75,16 +76,16 @@ type PrerenderBaseConstraints js t m =
7576-- hydration builder will run *both* widgets.
7677prerender_
7778 :: (Functor m, Reflex t, Prerender js t m)
78− => m () -> ((PrerenderClientConstraint js t (Client m)) => Client m ()) -> m ()
79+ => m () -> Client m () -> m ()
7980prerender_ server client = void $ prerender server client
8081
81−class Prerender js t m | m -> t js where
82+class (PrerenderClientConstraint js t (Client m), Client (Client m) ~ Client m, Prerender js t (Client m)) => Prerender js t m | m -> t js where
8283 -- | Monad in which the client widget is built
8384 type Client m :: * -> *
8485 -- | Render the first widget on the server, and the second on the client. The
8586 -- hydration builder will run *both* widgets, updating the result dynamic at
8687 -- switchover time.
87− prerender :: m a -> ((PrerenderClientConstraint js t (Client m)) => Client m a) -> m (Dynamic t a)
88+ prerender :: m a -> Client m a -> m (Dynamic t a)
8889
8990instance (ReflexHost t, Adjustable t m, PrerenderBaseConstraints js t m) => Prerender js t (HydrationDomBuilderT GhcjsDomSpace t m) where
9091 type Client (HydrationDomBuilderT GhcjsDomSpace t m) = HydrationDomBuilderT GhcjsDomSpace t m
@@ -129,10 +130,104 @@ instance (Adjustable t m, PrerenderBaseConstraints js t m, ReflexHost t) => Prer
129130 insertBefore df =<< deleteToPrerenderEnd doc
130131 holdDyn a0 a'
131132
132−data NoJavaScript -- This type should never have a HasJS instance
133+newtype UnrunnableT js t m a = UnrunnableT (ReaderT Void m a)
134+ deriving (Functor, Applicative, Monad, MonadTrans)
133135
134−instance (js ~ NoJavaScript, SupportsStaticDomBuilder t m) => Prerender js t (StaticDomBuilderT t m) where
135− type Client (StaticDomBuilderT t m) = HydrationDomBuilderT GhcjsDomSpace t m
136+unrunnable :: UnrunnableT js t m a
137+unrunnable = UnrunnableT $ ReaderT $ \case {}
138+
139+instance (Reflex t, Monad m) => DomBuilder t (UnrunnableT js t m) where
140+ type DomBuilderSpace (UnrunnableT js t m) = GhcjsDomSpace
141+ textNode _ = unrunnable
142+ commentNode _ = unrunnable
143+ element _ _ _ = unrunnable
144+ inputElement _ = unrunnable
145+ textAreaElement _ = unrunnable
146+ selectElement _ _ = unrunnable
147+ placeRawElement _ = unrunnable
148+ wrapRawElement _ _ = unrunnable
149+instance (Reflex t, Monad m) => NotReady t (UnrunnableT js t m) where
150+ notReadyUntil _ = unrunnable
151+ notReady = unrunnable
152+instance (Reflex t, Monad m) => Adjustable t (UnrunnableT js t m) where
153+ runWithReplace _ _ = unrunnable
154+ traverseIntMapWithKeyWithAdjust _ _ _ = unrunnable
155+ traverseDMapWithKeyWithAdjust _ _ _ = unrunnable
156+ traverseDMapWithKeyWithAdjustWithMove _ _ _ = unrunnable
157+instance (Reflex t, Monad m) => PerformEvent t (UnrunnableT js t m) where
158+ type Performable (UnrunnableT js t m) = UnrunnableT js t m
159+ performEvent _ = unrunnable
160+ performEvent_ _ = unrunnable
161+instance Monad m => MonadRef (UnrunnableT js t m) where
162+ type Ref (UnrunnableT js t m) = Ref IO
163+ newRef _ = unrunnable
164+ readRef _ = unrunnable
165+ writeRef _ _ = unrunnable
166+instance Monad m => HasDocument (UnrunnableT js t m) where
167+ askDocument = unrunnable
168+instance Monad m => HasJSContext (UnrunnableT js t m) where
169+ type JSContextPhantom (UnrunnableT js t m) = ()
170+ askJSContext = unrunnable
171+instance Monad m => HasJS JS' (UnrunnableT js t m) where
172+ type JSX (UnrunnableT js t m) = UnrunnableT js t m
173+ liftJS _ = unrunnable
174+instance Monad m => MonadJS JS' (UnrunnableT js t m) where
175+ runJS _ _ = unrunnable
176+ forkJS _ = unrunnable
177+ mkJSUndefined = unrunnable
178+ isJSNull _ = unrunnable
179+ isJSUndefined _ = unrunnable
180+ fromJSBool _ = unrunnable
181+ fromJSString _ = unrunnable
182+ fromJSArray _ = unrunnable
183+ fromJSUint8Array _ = unrunnable
184+ fromJSNumber _ = unrunnable
185+ withJSBool _ _ = unrunnable
186+ withJSString _ _ = unrunnable
187+ withJSNumber _ _ = unrunnable
188+ withJSArray _ _ = unrunnable
189+ withJSUint8Array _ _ = unrunnable
190+ mkJSFun _ = unrunnable
191+ freeJSFun _ = unrunnable
192+ setJSProp _ _ _ = unrunnable
193+ getJSProp _ _ = unrunnable
194+ withJSNode _ _ = unrunnable
195+instance Monad m => TriggerEvent t (UnrunnableT js t m) where
196+ newTriggerEvent = unrunnable
197+ newTriggerEventWithOnComplete = unrunnable
198+ newEventWithLazyTriggerWithOnComplete _ = unrunnable
199+instance Monad m => MonadReflexCreateTrigger t (UnrunnableT js t m) where
200+ newEventWithTrigger _ = unrunnable
201+ newFanEventWithTrigger _ = unrunnable
202+instance Monad m => MonadFix (UnrunnableT js t m) where
203+ mfix _ = unrunnable
204+instance Monad m => MonadHold t (UnrunnableT js t m) where
205+ hold _ _ = unrunnable
206+ holdDyn _ _ = unrunnable
207+ holdIncremental _ _ = unrunnable
208+ buildDynamic _ _ = unrunnable
209+ headE _ = unrunnable
210+instance Monad m => MonadSample t (UnrunnableT js t m) where
211+ sample _ = unrunnable
212+instance Monad m => MonadIO (UnrunnableT js t m) where
213+ liftIO _ = unrunnable
214+instance Monad m => MonadJSM (UnrunnableT js t m) where
215+ liftJSM' _ = unrunnable
216+instance (Reflex t, Monad m) => PostBuild t (UnrunnableT js t m) where
217+ getPostBuild = unrunnable
218+instance Monad m => PrimMonad (UnrunnableT js t m) where
219+ type PrimState (UnrunnableT js t m) = PrimState IO
220+ primitive _ = unrunnable
221+instance (Reflex t, Monad m) => DomRenderHook t (UnrunnableT js t m) where
222+ withRenderHook _ _ = unrunnable
223+ requestDomAction _ = unrunnable
224+ requestDomAction_ _ = unrunnable
225+instance (Reflex t, Monad m) => Prerender JS' t (UnrunnableT js t m) where
226+ type Client (UnrunnableT js t m) = UnrunnableT js t m
227+ prerender _ _ = unrunnable
228+
229+instance (SupportsStaticDomBuilder t m) => Prerender JS' t (StaticDomBuilderT t m) where
230+ type Client (StaticDomBuilderT t m) = UnrunnableT JS' t m
136231 prerender server _ = do
137232 _ <- commentNode $ CommentNodeConfig startMarker Nothing
138233 a <- server