git.iko.soy/reflex-dom
on develop help sign in
Merge remote-tracking branch 'origin/prerender' into develop
commit882661531aa1cfd8a66e5f9e553c8ac67d9c7d1e authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 13 Jun 2017, 22:15 (9 years ago) parent26284f89fc7da6
8 files changed+116−9
compare with develop
unifiedsplit
reflex-dom-core/default.nix+3−3 reflex-dom-core/reflex-dom-core.cabal+2 reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+12−6 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+3 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4 reflex-dom-core/src/Reflex/Dom/Builder/InputDisabled.hs+9 reflex-dom-core/src/Reflex/Dom/Core.hs+1 reflex-dom-core/src/Reflex/Dom/Prerender.hs+82
reflex-dom-core/default.nix+3−3
@@ -1,5 +1,5 @@
11{ mkDerivation, ghc, aeson, base, bifunctors, bimap, blaze-builder
2−, bytestring, containers, contravariant, data-default
2+, bytestring, constraints, containers, contravariant, data-default
33, dependent-map, dependent-sum, dependent-sum-template, directory
44, exception-transformers, ghcjs-dom, hlint, jsaddle, keycode, lens
55, monad-control, mtl, primitive, random, ref-tf, reflex, semigroups
@@ -16,8 +16,8 @@ in mkDerivation (addGcTestDepends {
1616 version = "0.4";
1717 src = ./.;
1818 libraryHaskellDepends = [
19− aeson base bifunctors bimap blaze-builder bytestring containers
20− contravariant data-default dependent-map dependent-sum
19+ aeson base bifunctors bimap blaze-builder bytestring constraints
20+ containers contravariant data-default dependent-map dependent-sum
2121 dependent-sum-template directory exception-transformers ghcjs-dom
2222 jsaddle keycode lens monad-control mtl primitive random ref-tf
2323 reflex semigroups stm template-haskell text these time transformers
reflex-dom-core/reflex-dom-core.cabal+2
@@ -43,6 +43,7 @@ library
4343 blaze-builder,
4444 bytestring == 0.10.*,
4545 containers == 0.5.*,
46+ constraints == 0.9.*,
4647 contravariant >= 1.4 && < 1.5,
4748 data-default >= 0.5 && < 0.8,
4849 dependent-map == 0.2.*,
@@ -94,6 +95,7 @@ library
9495 Reflex.Dom.Location
9596 Reflex.Dom.Main
9697 Reflex.Dom.Old
98+ Reflex.Dom.Prerender
9799 Reflex.Dom.Time
98100 Reflex.Dom.WebSocket
99101 Reflex.Dom.Widget
reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+12−6
@@ -16,13 +16,19 @@ import Reflex.Requester.Base (RequesterT)
1616import Reflex.TriggerEvent.Base
1717import Reflex.Query.Base (QueryT)
1818
19−instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m)
19+instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m) where
20+ liftJSM' = lift . liftJSM'
2021instance (MonadJSM (HostFrame t), ReflexHost t) => MonadJSM (PerformEventT t m) where
2122 liftJSM' = PerformEventT . lift . liftJSM'
22−instance MonadJSM m => MonadJSM (DynamicWriterT t w m)
23−instance MonadJSM m => MonadJSM (EventWriterT t w m)
24−instance MonadJSM m => MonadJSM (RequesterT t request response m)
25−instance MonadJSM m => MonadJSM (TriggerEventT t m)
26−instance MonadJSM m => MonadJSM (QueryT t q m)
23+instance MonadJSM m => MonadJSM (DynamicWriterT t w m) where
24+ liftJSM' = lift . liftJSM'
25+instance MonadJSM m => MonadJSM (EventWriterT t w m) where
26+ liftJSM' = lift . liftJSM'
27+instance MonadJSM m => MonadJSM (RequesterT t request response m) where
28+ liftJSM' = lift . liftJSM'
29+instance MonadJSM m => MonadJSM (TriggerEventT t m) where
30+ liftJSM' = lift . liftJSM'
31+instance MonadJSM m => MonadJSM (QueryT t q m) where
32+ liftJSM' = lift . liftJSM'
2733
2834#endif
reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+3
@@ -7,6 +7,9 @@
77{-# LANGUAGE FlexibleInstances #-}
88{-# LANGUAGE FunctionalDependencies #-}
99{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10+#if !MIN_VERSION_base(4,9,0)
11+{-# LANGUAGE ImpredicativeTypes #-}
12+#endif
1013{-# LANGUAGE LambdaCase #-}
1114{-# LANGUAGE MultiParamTypeClasses #-}
1215{-# LANGUAGE OverloadedStrings #-}
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4
@@ -760,7 +760,11 @@ instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, MonadFix m, Prim
760760 mapM_ (\(k :=> v) -> void $ placeFragment k v) $ DMap.toDescList p -- We need to go in reverse order here, to make sure the placeholders are in the right spot at the right time
761761 liftIO $ writeIORef placeholders $! phsAfter
762762
763+#if MIN_VERSION_base(4,9,0)
763764data ChildReadyState k
765+#else
766+data ChildReadyState (k :: * -> *)
767+#endif
764768 = ChildReadyState_Ready
765769 | ChildReadyState_Unready !(Maybe (Some k))
766770 deriving (Show, Read, Eq, Ord)
reflex-dom-core/src/Reflex/Dom/Builder/InputDisabled.hs+9
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE FlexibleInstances #-}
23{-# LANGUAGE GeneralizedNewtypeDeriving #-}
34{-# LANGUAGE MultiParamTypeClasses #-}
@@ -15,6 +16,9 @@ import Control.Monad.Trans.Control
1516import Data.Coerce
1617import qualified Data.Map as Map
1718import Foreign.JavaScript.TH
19+#ifndef ghcjs_HOST_OS
20+import GHCJS.DOM.Types (MonadJSM (..))
21+#endif
1822import Reflex
1923import Reflex.Dom.Builder.Class
2024import Reflex.Dom.Builder.Immediate (HasDocument (..))
@@ -26,6 +30,11 @@ import Reflex.Host.Class
2630-- "select" as their tag will NOT be disabled.
2731newtype InputDisabledT m a = InputDisabledT { runInputDisabledT :: m a } deriving (Functor, Applicative, Monad, MonadAtomicRef, MonadFix, MonadIO)
2832
33+#ifndef ghcjs_HOST_OS
34+instance MonadJSM m => MonadJSM (InputDisabledT m) where
35+ liftJSM' = InputDisabledT . liftJSM'
36+#endif
37+
2938deriving instance MonadSample t m => MonadSample t (InputDisabledT m)
3039deriving instance MonadHold t m => MonadHold t (InputDisabledT m)
3140
reflex-dom-core/src/Reflex/Dom/Core.hs+1
@@ -9,6 +9,7 @@ import Reflex.Dom.Class as X
99import Reflex.Dom.Location as X
1010import Reflex.Dom.Main as X
1111import Reflex.Dom.Old as X
12+import Reflex.Dom.Prerender as X
1213import Reflex.Dom.Time as X
1314import Reflex.Dom.WebSocket as X
1415import Reflex.Dom.Widget as X
reflex-dom-core/src/Reflex/Dom/Prerender.hsnew file+82
@@ -0,0 +1,82 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE EmptyDataDecls #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE FunctionalDependencies #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+{-# LANGUAGE Rank2Types #-}
8+{-# LANGUAGE ScopedTypeVariables #-}
9+{-# LANGUAGE TypeFamilies #-}
10+{-# LANGUAGE TypeSynonymInstances #-}
11+{-# LANGUAGE UndecidableInstances #-}
12+module Reflex.Dom.Prerender
13+ ( Prerender (..)
14+ , prerender
15+ ) where
16+
17+import Control.Monad.Reader
18+import Data.Constraint
19+import Foreign.JavaScript.TH
20+import GHCJS.DOM.Types (MonadJSM)
21+import Reflex
22+import Reflex.Dom.Builder.InputDisabled
23+import Reflex.Dom.Builder.Immediate
24+import Reflex.Dom.Builder.Static
25+import Reflex.Host.Class
26+
27+type PrerenderClientConstraint js m =
28+ ( HasJS js m
29+ , HasJS js (Performable m)
30+ , MonadJSM m
31+ , MonadJSM (Performable m)
32+ , HasJSContext m
33+ , HasJSContext (Performable m)
34+ , MonadFix m
35+ , MonadFix (Performable m)
36+ )
37+
38+class Prerender js m | m -> js where
39+ prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m))
40+
41+-- | Draw one widget when prerendering (e.g. server-side) and another when the
42+-- widget is fully instantiated. In a given execution of this function, there
43+-- will be exactly one invocation of exactly one of the arguments.
44+prerender :: forall js m a. Prerender js m => m a -> (PrerenderClientConstraint js m => m a) -> m a
45+prerender server client = case prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)) of
46+ Nothing -> server
47+ Just Dict -> client
48+
49+instance ( HasJS js m
50+ , HasJS js (Performable m)
51+ , HasJSContext m
52+ , HasJSContext (Performable m)
53+ , MonadJSM m
54+ , MonadJSM (Performable m)
55+ , MonadFix m
56+ , MonadFix (Performable m)
57+ , ReflexHost t
58+ ) => Prerender js (ImmediateDomBuilderT t m) where
59+ prerenderClientDict = Just Dict
60+
61+data NoJavaScript -- This type should never have a HasJS instance
62+
63+instance js ~ NoJavaScript => Prerender js (StaticDomBuilderT t m) where
64+ prerenderClientDict = Nothing
65+
66+instance (Prerender js m, ReflexHost t) => Prerender js (PostBuildT t m) where
67+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))
68+
69+instance Prerender js m => Prerender js (DynamicWriterT t w m) where
70+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))
71+
72+instance Prerender js m => Prerender js (ReaderT w m) where
73+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))
74+
75+instance Prerender js m => Prerender js (RequesterT t request response m) where
76+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))
77+
78+instance Prerender js m => Prerender js (QueryT t q m) where
79+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))
80+
81+instance Prerender js m => Prerender js (InputDisabledT m) where
82+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))