@@ -0,0 +1,84 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE EmptyDataDecls #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE Rank2Types #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TypeApplications #-}
11+{-# LANGUAGE TypeFamilies #-}
12+{-# LANGUAGE TypeSynonymInstances #-}
13+{-# LANGUAGE UndecidableInstances #-}
14+module Reflex.Dom.Prerender
15+ ( Prerender (..)
16+ , prerender
17+ ) where
18+
19+import Control.Monad.Reader
20+import Data.Constraint
21+import Foreign.JavaScript.TH
22+import GHCJS.DOM.Types (MonadJSM)
23+import Reflex
24+import Reflex.Dom.Builder.InputDisabled
25+import Reflex.Dom.Builder.Immediate
26+import Reflex.Dom.Builder.Static
27+import Reflex.Host.Class
28+
29+type PrerenderClientConstraint js m =
30+ ( HasJS js m
31+ , HasJS js (Performable m)
32+ , MonadJSM m
33+ , MonadJSM (Performable m)
34+ , HasJSContext m
35+ , HasJSContext (Performable m)
36+ , MonadFix m
37+ , MonadFix (Performable m)
38+ )
39+
40+class Prerender js m | m -> js where
41+ prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m))
42+
43+-- | Draw one widget when prerendering (e.g. server-side) and another when the
44+-- widget is fully instantiated. In a given execution of this function, there
45+-- will be exactly one invocation of exactly one of the arguments.
46+prerender :: forall js m a. Prerender js m => m a -> (PrerenderClientConstraint js m => m a) -> m a
47+prerender server client = case prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)) of
48+ Nothing -> server
49+ Just Dict -> client
50+
51+instance ( HasJS js m
52+ , HasJS js (Performable m)
53+ , HasJSContext m
54+ , HasJSContext (Performable m)
55+ , MonadJSM m
56+ , MonadJSM (Performable m)
57+ , MonadFix m
58+ , MonadFix (Performable m)
59+ , ReflexHost t
60+ ) => Prerender js (ImmediateDomBuilderT t m) where
61+ prerenderClientDict = Just Dict
62+
63+data NoJavaScript -- This type should never have a HasJS instance
64+
65+instance js ~ NoJavaScript => Prerender js (StaticDomBuilderT t m) where
66+ prerenderClientDict = Nothing
67+
68+instance (Prerender js m, ReflexHost t) => Prerender js (PostBuildT t m) where
69+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict @js @m)
70+
71+instance Prerender js m => Prerender js (DynamicWriterT t w m) where
72+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict @js @m)
73+
74+instance Prerender js m => Prerender js (ReaderT w m) where
75+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict @js @m)
76+
77+instance Prerender js m => Prerender js (RequesterT t request response m) where
78+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict @js @m)
79+
80+instance Prerender js m => Prerender js (QueryT t q m) where
81+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict @js @m)
82+
83+instance Prerender js m => Prerender js (InputDisabledT m) where
84+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict @js @m)