git.iko.soy/typeable/servant-reflex
on cb7bb12 help sign in
3 files changed+74−83
since splitsnapshots
unifiedsplit
exec/Example.hs+20−19 overrides.nix+3−3 src/Servant/Reflex.hs+51−61
exec/Example.hs+20−19
@@ -30,6 +30,7 @@ api = Proxy
3030
3131main :: IO ()
3232main = mainWidget $ do
33+ el "h1" $ text "Wowzers!"
3334 divClass "example-base" run
3435 divClass "example-multi" runMulti
3536
@@ -64,9 +65,9 @@ runMulti = do
6465 grts <- fmap (fmap T.words . value) $ divClass "" $ do
6566 text "Greetings"
6667 textInput def
67− gust <- fmap (value) $ divClass "gusto-input" $ checkbox False def
68+ gust <- fmap value $ divClass "gusto-input" $ checkbox False def
6869 b <- button "Go"
69− r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) $ grts) (constDyn [True, False]) (1 <$ b)
70+ r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) grts) (constDyn [True, False]) (1 <$ b)
7071
7172 dynText =<< holdDyn "Waiting" (T.pack . show . catMaybes . fmap reqSuccess <$> r')
7273
@@ -103,11 +104,11 @@ run = mdo
103104 unitResponse <- getUnit $ tag (current reqCount) unitBtn
104105 intResponse :: Event t (ReqResult Int Int) <- getInt $ tag (current reqCount) intBtn
105106
106− score <- foldDyn (+) 0 (fmapMaybe reqSuccess (intResponse))
107+ score <- foldDyn (+) 0 (fmapMaybe reqSuccess intResponse)
107108
108− r <- holdDyn "Waiting" $ fmap showXhrResponse $
109− leftmost [fmapMaybe response (unitResponse)
110− ,fmapMaybe response (intResponse)
109+ r <- holdDyn "Waiting" $ showXhrResponse <$>
110+ leftmost [fmapMaybe response unitResponse
111+ ,fmapMaybe response intResponse
111112 ]
112113 divClass "unit-int-response" $ el "p" $ dynText r >> el "br" (return ()) >> text "Total: " >> display score
113114 return (unitBtn, intBtn)
@@ -116,14 +117,14 @@ run = mdo
116117
117118 text "Name"
118119 el "br" $ return ()
119− inp :: Dynamic t Text <- fmap value $ divClass "name-input" $ (textInput def)
120+ inp :: Dynamic t Text <- fmap value $ divClass "name-input" $ textInput def
120121 let checkedName = fmap (\i -> bool (QParamSome i) (QParamInvalid "Need a name") (T.null i)) inp
121122 el "br" $ return ()
122123
123124 text "Greetings (space-separated)"
124125 el "br" $ return ()
125126 greetings <- fmap (fmap T.words . value) $
126− divClass "greetings-input" $ (textInput def)
127+ divClass "greetings-input" $ textInput def
127128
128129 el "br" $ return ()
129130
@@ -135,23 +136,23 @@ run = mdo
135136
136137 resp <- sayhi checkedName greetings gusto (tag (current reqCount) triggers)
137138 divClass "greeting-response" $ dynText =<<
138− holdDyn "No hi yet" (leftmost [ fmapMaybe reqSuccess (resp)
139− , fmapMaybe reqFailure (resp)])
139+ holdDyn "No hi yet" (leftmost [ fmapMaybe reqSuccess resp
140+ , fmapMaybe reqFailure resp])
140141 return sayHiClicks
141142
142143 dblBtn <- elClass "div" "demo-group" $ do
143144 text "A Double to double"
144145 el "br" $ return ()
145146 dblinp <- fmap value $ divClass "double-input" $ textInput def
146− (dblBtn) <- divClass "double-button" $ button "Double it"
147− dblResp <- dbl (fmap (note "read failure" . readMaybe . T.unpack) $
147+ dblBtn <- divClass "double-button" $ button "Double it"
148+ dblResp <- dbl ((note "read failure" . readMaybe . T.unpack) <$>
148149 dblinp) (tag (current reqCount) dblBtn)
149150 divClass "double-errors" $ dynText =<<
150− holdDyn "(no errors)" (fmapMaybe reqFailure (dblResp))
151+ holdDyn "(no errors)" (fmapMaybe reqFailure dblResp)
151152 el "br" (return ())
152153 divClass "double-result" $ el "p" $ dynText =<<
153− holdDyn "No number yet" (fmap tShow $
154− fmapMaybe reqSuccess (dblResp))
154+ holdDyn "No number yet" (tShow <$>
155+ fmapMaybe reqSuccess dblResp)
155156 return dblBtn
156157
157158 mpGo <- elClass "div" "demo-group" $ do
@@ -159,9 +160,9 @@ run = mdo
159160 b <- value <$> checkbox False def
160161 mpGo <- button "Test"
161162 multiResp <- multi b (tag (current reqCount) mpGo)
162− dynText =<< holdDyn "No res yet" (fmap tShow $
163− fmapMaybe reqSuccess $
164− (multiResp))
163+ dynText =<< holdDyn "No res yet" (tShow <$>
164+ fmapMaybe reqSuccess
165+ multiResp)
165166 return mpGo
166167
167168 return ()
@@ -171,7 +172,7 @@ run = mdo
171172 elClass "div" "demo-group" $ do
172173 text "JSON Unicode encoding test"
173174 txt <- value <$> textInput def
174− ev <- fmap (1 <$) $ button "Question"
175+ ev <- (1 <$) <$> button "Question"
175176 let dQ = Right . Question <$> traceDyn "will send: " txt
176177 rr <- qna dQ ev
177178 el "p" $
overrides.nix+3−3
@@ -6,8 +6,8 @@ let
66
77in
88reflex-platform.ghcjs.override {
9− overrides = self: super: {
10− # servant = dc (self.callPackage (c2n deps/servant/servant) {});
11− # http-api-data = dc (self.callPackage (c2n deps/http-api-data) {});
9+ overrides = self: super: {
10+ servant = dc (self.callPackage (c2n deps/servant/servant) {});
11+ http-api-data = dc (self.callPackage (c2n deps/http-api-data) {});
1212 };
1313}
src/Servant/Reflex.hs+51−61
@@ -4,13 +4,6 @@
44{-# LANGUAGE FlexibleContexts #-}
55{-# LANGUAGE FlexibleInstances #-}
66{-# LANGUAGE InstanceSigs #-}
7−{-# LANGUAGE OverloadedStrings #-}
8−{-# LANGUAGE PolyKinds #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE TupleSections #-}
11−{-# LANGUAGE TypeFamilies #-}
12−{-# LANGUAGE TypeOperators #-}
13−{-# LANGUAGE UndecidableInstances #-}
147{-# LANGUAGE MultiParamTypeClasses #-}
158{-# LANGUAGE OverloadedStrings #-}
169{-# LANGUAGE PolyKinds #-}
@@ -35,49 +28,46 @@ module Servant.Reflex
3528
3629------------------------------------------------------------------------------
3730import Control.Applicative
38−import Data.Monoid ((<>))
39−import qualified Data.Set as Set
40−import qualified Data.Text.Encoding as E
41−import Data.CaseInsensitive (mk)
31+import Data.CaseInsensitive (mk)
4232import Data.Functor.Identity
43−import Data.Proxy (Proxy (..))
44−import qualified Data.Map as Map
45−import Data.Text (Text)
46−import qualified Data.Text as T
47−import GHC.TypeLits (KnownSymbol, symbolVal)
48−import Servant.API ((:<|>)(..),(:>), BasicAuth,
49− BasicAuthData, BuildHeadersTo(..),
50− Capture, contentType, Header,
51− Headers(..), HttpVersion, IsSecure,
52− MimeRender(..), MimeUnrender,
53− NoContent, QueryFlag, QueryParam,
54− QueryParams, Raw, ReflectMethod(..),
55− RemoteHost, ReqBody,
56− ToHttpApiData(..), Vault, Verb)
57−
58−import Reflex.Dom (Dynamic, Event, Reflex,
59− XhrRequest(..),
60− XhrResponseHeaders(..),
61− XhrResponse(..), attachPromptlyDynWith, constDyn, ffor, fmapMaybe,
62− leftmost, performRequestsAsync,
63− )
33+import qualified Data.Map as Map
34+import Data.Monoid ((<>))
35+import Data.Proxy (Proxy (..))
36+import qualified Data.Set as Set
37+import Data.Text (Text)
38+import qualified Data.Text as T
39+import qualified Data.Text.Encoding as E
40+import GHC.TypeLits (KnownSymbol, symbolVal)
41+import Servant.API ((:<|>) (..), (:>), BasicAuth,
42+ BasicAuthData, BuildHeadersTo (..),
43+ Capture, Header, Headers (..),
44+ HttpVersion, IsSecure, MimeRender (..),
45+ MimeUnrender, NoContent, QueryFlag,
46+ QueryParam, QueryParams, Raw,
47+ ReflectMethod (..), RemoteHost,
48+ ReqBody, ToHttpApiData (..), Vault,
49+ Verb, contentType)
50+
51+import Reflex.Dom (Dynamic, Event, Reflex,
52+ XhrRequest (..), XhrResponse (..),
53+ XhrResponseHeaders (..),
54+ attachPromptlyDynWith, constDyn, ffor,
55+ fmapMaybe, leftmost,
56+ performRequestsAsync)
6457------------------------------------------------------------------------------
65−import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
66− showBaseUrl,
67− SupportsServantReflex)
68−import Servant.Common.Req (Req, ReqResult(..), QParam(..),
69− QueryPart(..), addHeader, authData,
70− defReq, evalResponse, prependToPathParts,
71− -- performRequestCT,
72− performRequestsCT,
73− -- performRequestNoBody,
74− performRequestsNoBody,
75− performSomeRequestsAsync,
76− qParamToQueryPart, reqBody,
77− reqSuccess, reqFailure,
78− reqMethod, respHeaders, response,
79− reqTag,
80− qParams)
58+import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),
59+ SupportsServantReflex, baseUrlWidget,
60+ showBaseUrl)
61+import Servant.Common.Req (QParam (..), QueryPart (..), Req,
62+ ReqResult (..), addHeader, authData,
63+ defReq, evalResponse,
64+ performRequestsCT,
65+ performRequestsNoBody,
66+ performSomeRequestsAsync,
67+ prependToPathParts, qParamToQueryPart,
68+ qParams, reqBody, reqFailure,
69+ reqMethod, reqSuccess, reqTag,
70+ respHeaders, response)
8171
8272
8373-- * Accessing APIs as a Client
@@ -97,7 +87,7 @@ import Servant.Common.Req (Req, ReqResult(..), QParam(..),
9787-- > where host = constDyn $ BaseUrl Http "localhost" 8080
9888client :: (HasClient t m layout tag)
9989 => Proxy layout -> Proxy m -> Proxy tag -> Dynamic t BaseUrl -> Client t m layout tag
100−client p q t baseurl = clientWithRoute p q t defReq baseurl
90+client p q t = clientWithRoute p q t defReq
10191
10292
10393-- | This class lets us define how each API combinator
@@ -139,7 +129,7 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout ta
139129 q t
140130 (prependToPathParts p req)
141131 baseurl
142− where p = (fmap . fmap) (toUrlPiece) val
132+ where p = (fmap . fmap) toUrlPiece val
143133
144134
145135-- VERB (Returning content) --
@@ -153,7 +143,7 @@ instance {-# OVERLAPPABLE #-}
153143 -- ExceptT ServantError IO a
154144 clientWithRoute Proxy _ _ req baseurl trigs =
155145 -- performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs
156− fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl trigs
146+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl trigs
157147 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
158148 req' = req { reqMethod = method }
159149
@@ -267,8 +257,8 @@ instance HasClient t m sublayout tag
267257 type Client t m (HttpVersion :> sublayout) tag =
268258 Client t m sublayout tag
269259
270− clientWithRoute Proxy q t =
271− clientWithRoute (Proxy :: Proxy sublayout) q t
260+ clientWithRoute Proxy =
261+ clientWithRoute (Proxy :: Proxy sublayout)
272262
273263
274264-- | If you use a 'QueryParam' in one of your endpoints in your API,
@@ -462,9 +452,9 @@ instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
462452instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
463453 type Client t m (path :> sublayout) tag = Client t m sublayout tag
464454
465− clientWithRoute Proxy q t req baseurl =
455+ clientWithRoute Proxy q t req =
466456 clientWithRoute (Proxy :: Proxy sublayout) q t
467− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl
457+ (prependToPathParts (pure (Right $ T.pack p)) req)
468458
469459 where p = symbolVal (Proxy :: Proxy path)
470460
@@ -472,23 +462,23 @@ instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient
472462instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
473463 type Client t m (Vault :> api) tag = Client t m api tag
474464
475− clientWithRoute Proxy q t req baseurl =
476− clientWithRoute (Proxy :: Proxy api) q t req baseurl
465+ clientWithRoute Proxy =
466+ clientWithRoute (Proxy :: Proxy api)
477467
478468
479469instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
480470 type Client t m (RemoteHost :> api) tag = Client t m api tag
481471
482− clientWithRoute Proxy q t req baseurl =
483− clientWithRoute (Proxy :: Proxy api) q t req baseurl
472+ clientWithRoute Proxy =
473+ clientWithRoute (Proxy :: Proxy api)
484474
485475
486476
487477instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
488478 type Client t m (IsSecure :> api) tag = Client t m api tag
489479
490− clientWithRoute Proxy q t req baseurl =
491− clientWithRoute (Proxy :: Proxy api) q t req baseurl
480+ clientWithRoute Proxy =
481+ clientWithRoute (Proxy :: Proxy api)
492482
493483
494484instance (HasClient t m api tag, Reflex t)