git.iko.soy/reflex-dom
on develop help sign in
Add Prerender
14919b5Luigy Leon
reflex-dom-core/default.nix+3−3
compare with develop
unifiedsplit
@@ -1,5 +1,5 @@
1{ mkDerivation, ghc, aeson, base, bifunctors, bimap, blaze-builder
1{ mkDerivation, ghc, aeson, base, bifunctors, bimap, blaze-builder
2−, bytestring, containers, contravariant, data-default
2+, bytestring, constraints, containers, contravariant, data-default
3, dependent-map, dependent-sum, dependent-sum-template, directory
3, dependent-map, dependent-sum, dependent-sum-template, directory
4, exception-transformers, ghcjs-dom, hlint, jsaddle, keycode, lens
4, exception-transformers, ghcjs-dom, hlint, jsaddle, keycode, lens
5, monad-control, mtl, primitive, random, ref-tf, reflex, semigroups
5, monad-control, mtl, primitive, random, ref-tf, reflex, semigroups
@@ -16,8 +16,8 @@ in mkDerivation (addGcTestDepends {
16 version = "0.4";
16 version = "0.4";
17 src = ./.;
17 src = ./.;
18 libraryHaskellDepends = [
18 libraryHaskellDepends = [
19− aeson base bifunctors bimap blaze-builder bytestring containers
19+ aeson base bifunctors bimap blaze-builder bytestring constraints
20− contravariant data-default dependent-map dependent-sum
20+ containers contravariant data-default dependent-map dependent-sum
21 dependent-sum-template directory exception-transformers ghcjs-dom
21 dependent-sum-template directory exception-transformers ghcjs-dom
22 jsaddle keycode lens monad-control mtl primitive random ref-tf
22 jsaddle keycode lens monad-control mtl primitive random ref-tf
23 reflex semigroups stm template-haskell text these time transformers
23 reflex semigroups stm template-haskell text these time transformers
reflex-dom-core/reflex-dom-core.cabal+2
@@ -43,6 +43,7 @@ library
43 blaze-builder,
43 blaze-builder,
44 bytestring == 0.10.*,
44 bytestring == 0.10.*,
45 containers == 0.5.*,
45 containers == 0.5.*,
46+ constraints,
46 contravariant >= 1.4 && < 1.5,
47 contravariant >= 1.4 && < 1.5,
47 data-default >= 0.5 && < 0.8,
48 data-default >= 0.5 && < 0.8,
48 dependent-map == 0.2.*,
49 dependent-map == 0.2.*,
@@ -94,6 +95,7 @@ library
94 Reflex.Dom.Location
95 Reflex.Dom.Location
95 Reflex.Dom.Main
96 Reflex.Dom.Main
96 Reflex.Dom.Old
97 Reflex.Dom.Old
98+ Reflex.Dom.Prerender
97 Reflex.Dom.Time
99 Reflex.Dom.Time
98 Reflex.Dom.WebSocket
100 Reflex.Dom.WebSocket
99 Reflex.Dom.Widget
101 Reflex.Dom.Widget
reflex-dom-core/src/Reflex/Dom/Builder/InputDisabled.hs+9
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
@@ -15,6 +16,9 @@ import Control.Monad.Trans.Control
15import Data.Coerce
16import Data.Coerce
16import qualified Data.Map as Map
17import qualified Data.Map as Map
17import Foreign.JavaScript.TH
18import Foreign.JavaScript.TH
19+#ifndef ghcjs_HOST_OS
20+import GHCJS.DOM.Types (MonadJSM (..))
21+#endif
18import Reflex
22import Reflex
19import Reflex.Dom.Builder.Class
23import Reflex.Dom.Builder.Class
20import Reflex.Dom.Builder.Immediate (HasDocument (..))
24import Reflex.Dom.Builder.Immediate (HasDocument (..))
@@ -26,6 +30,11 @@ import Reflex.Host.Class
26-- "select" as their tag will NOT be disabled.
30-- "select" as their tag will NOT be disabled.
27newtype InputDisabledT m a = InputDisabledT { runInputDisabledT :: m a } deriving (Functor, Applicative, Monad, MonadAtomicRef, MonadFix, MonadIO)
31newtype InputDisabledT m a = InputDisabledT { runInputDisabledT :: m a } deriving (Functor, Applicative, Monad, MonadAtomicRef, MonadFix, MonadIO)
28
32
33+#ifndef ghcjs_HOST_OS
34+instance MonadJSM m => MonadJSM (InputDisabledT m) where
35+ liftJSM' = InputDisabledT . liftJSM'
36+#endif
37+
29deriving instance MonadSample t m => MonadSample t (InputDisabledT m)
38deriving instance MonadSample t m => MonadSample t (InputDisabledT m)
30deriving instance MonadHold t m => MonadHold t (InputDisabledT m)
39deriving instance MonadHold t m => MonadHold t (InputDisabledT m)
31
40
reflex-dom-core/src/Reflex/Dom/Core.hs+1
@@ -9,6 +9,7 @@ import Reflex.Dom.Class as X
9import Reflex.Dom.Location as X
9import Reflex.Dom.Location as X
10import Reflex.Dom.Main as X
10import Reflex.Dom.Main as X
11import Reflex.Dom.Old as X
11import Reflex.Dom.Old as X
12+import Reflex.Dom.Prerender as X
12import Reflex.Dom.Time as X
13import Reflex.Dom.Time as X
13import Reflex.Dom.WebSocket as X
14import Reflex.Dom.WebSocket as X
14import Reflex.Dom.Widget as X
15import Reflex.Dom.Widget as X
reflex-dom-core/src/Reflex/Dom/Prerender.hsnew file+84
@@ -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)