@@ -1,24 +1,18 @@
1−{-# LANGUAGE AllowAmbiguousTypes #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE InstanceSigs #-}
7−{-# LANGUAGE OverloadedStrings #-}
8−{-# LANGUAGE PolyKinds #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE TupleSections #-}
11−{-# LANGUAGE TypeFamilies #-}
12−{-# LANGUAGE TypeOperators #-}
13−{-# LANGUAGE UndecidableInstances #-}
14−{-# LANGUAGE MultiParamTypeClasses #-}
15−{-# LANGUAGE OverloadedStrings #-}
16−{-# LANGUAGE PolyKinds #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−{-# LANGUAGE TupleSections #-}
19−{-# LANGUAGE TypeFamilies #-}
20−{-# LANGUAGE TypeOperators #-}
21−{-# LANGUAGE UndecidableInstances #-}
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
7+{-# LANGUAGE InstanceSigs #-}
8+{-# LANGUAGE MultiParamTypeClasses #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE PolyKinds #-}
11+{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE TupleSections #-}
13+{-# LANGUAGE TypeFamilies #-}
14+{-# LANGUAGE TypeOperators #-}
15+{-# LANGUAGE UndecidableInstances #-}
2216
2317-- #include "overlapping-compat.h"
2418-- | This module provides 'client' which can automatically generate
@@ -35,49 +29,46 @@ module Servant.Reflex
3529
3630------------------------------------------------------------------------------
3731import 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)
32+import Data.CaseInsensitive (mk)
4233import 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− )
34+import qualified Data.Map as Map
35+import Data.Monoid ((<>))
36+import Data.Proxy (Proxy (..))
37+import qualified Data.Set as Set
38+import Data.Text (Text)
39+import qualified Data.Text as T
40+import qualified Data.Text.Encoding as E
41+import GHC.TypeLits (KnownSymbol, symbolVal)
42+import Servant.API ((:<|>) (..), (:>), BasicAuth,
43+ BasicAuthData, BuildHeadersTo (..),
44+ Capture, Header, Headers (..),
45+ HttpVersion, IsSecure, MimeRender (..),
46+ MimeUnrender, NoContent, QueryFlag,
47+ QueryParam, QueryParams, Raw,
48+ ReflectMethod (..), RemoteHost,
49+ ReqBody, ToHttpApiData (..), Vault,
50+ Verb, contentType)
51+
52+import Reflex.Dom (Dynamic, Event, Reflex,
53+ XhrRequest (..), XhrResponse (..),
54+ XhrResponseHeaders (..),
55+ attachPromptlyDynWith, constDyn, ffor,
56+ fmapMaybe, leftmost,
57+ performRequestsAsync)
6458------------------------------------------------------------------------------
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)
59+import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),
60+ SupportsServantReflex, baseUrlWidget,
61+ showBaseUrl)
62+import Servant.Common.Req (QParam (..), QueryPart (..), Req,
63+ ReqIO, ReqResult (..), addHeader,
64+ authData, defReq, evalResponse,
65+ performRequestsCT,
66+ performRequestsNoBody,
67+ performSomeRequestsAsync,
68+ prependToPathParts, qParamToQueryPart,
69+ qParams, reqBody, reqFailure,
70+ reqMethod, reqSuccess, reqTag,
71+ respHeaders, response)
8172
8273
8374-- * Accessing APIs as a Client
@@ -97,24 +88,42 @@ import Servant.Common.Req (Req, ReqResult(..), QParam(..),
9788-- > where host = constDyn $ BaseUrl Http "localhost" 8080
9889client :: (HasClient t m layout tag)
9990 => 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
91+client p q t = clientWithRoute p q t defReq
10192
10293
10394-- | This class lets us define how each API combinator
10495-- influences the creation of an HTTP request. It's mostly
10596-- an internal class, you can just use 'client'.
106−class HasClient t m layout (tag :: *) where
97+class HasClient t m layout (tag :: *) | m -> t where
10798 type Client t m layout tag :: *
108− clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> Client t m layout tag
109−
99+ type ClientIO m layout tag :: *
100+ clientWithRoute
101+ :: Proxy layout
102+ -> Proxy m
103+ -> Proxy tag
104+ -> Req t
105+ -> Dynamic t BaseUrl
106+ -> Client t m layout tag
107+ clientWithRouteIO
108+ :: Proxy layout
109+ -> Proxy m
110+ -> Proxy tag
111+ -> ReqIO
112+ -> BaseUrl
113+ -> ClientIO m layout tag
110114
111115instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where
112116 type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag
117+ type ClientIO m (a :<|> b) tag = ClientIO m a tag :<|> ClientIO m b tag
113118
114119 clientWithRoute Proxy q pTag req baseurl =
115120 clientWithRoute (Proxy :: Proxy a) q pTag req baseurl :<|>
116121 clientWithRoute (Proxy :: Proxy b) q pTag req baseurl
117122
123+ clientWithRouteIO Proxy q pTag req baseurl =
124+ clientWithRouteIO (Proxy :: Proxy a) q pTag req baseurl :<|>
125+ clientWithRouteIO (Proxy :: Proxy b) q pTag req baseurl
126+
118127
119128-- Capture. Example:
120129-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
@@ -134,12 +143,22 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout ta
134143 type Client t m (Capture capture a :> sublayout) tag =
135144 Dynamic t (Either Text a) -> Client t m sublayout tag
136145
146+ type ClientIO m (Capture capture a :> sublayout) tag =
147+ a -> ClientIO m sublayout tag
148+
137149 clientWithRoute Proxy q t req baseurl val =
138150 clientWithRoute (Proxy :: Proxy sublayout)
139151 q t
140152 (prependToPathParts p req)
141153 baseurl
142− where p = (fmap . fmap) (toUrlPiece) val
154+ where p = (fmap . fmap) toUrlPiece val
155+
156+ clientWithRouteIO Proxy q t req baseurl val =
157+ clientWithRouteIO (Proxy :: Proxy sublayout)
158+ q t
159+ (prependToPathParts p req)
160+ baseurl
161+ where p = (fmap . fmap) toUrlPiece val
143162
144163
145164-- VERB (Returning content) --
@@ -147,13 +166,24 @@ instance {-# OVERLAPPABLE #-}
147166 -- Note [Non-Empty Content Types]
148167 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
149168 ) => HasClient t m (Verb method status cts' a) tag where
169+
150170 type Client t m (Verb method status cts' a) tag =
151171 Event t tag -> m (Event t (ReqResult tag a))
172+
173+ type ClientIO m (Verb method status cts' a) tag =
174+ tag -> m (ReqResult tag a)
175+
152176 -- TODO how to access input types here?
153177 -- ExceptT ServantError IO a
154178 clientWithRoute Proxy _ _ req baseurl trigs =
155179 -- performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs
156− fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl trigs
180+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl trigs
181+ where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
182+ req' = req { reqMethod = method }
183+
184+ clientWithRouteIO Proxy _ _ req baseurl tag =
185+ -- performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs
186+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl tag
157187 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
158188 req' = req { reqMethod = method }
159189
@@ -267,8 +297,8 @@ instance HasClient t m sublayout tag
267297 type Client t m (HttpVersion :> sublayout) tag =
268298 Client t m sublayout tag
269299
270− clientWithRoute Proxy q t =
271− clientWithRoute (Proxy :: Proxy sublayout) q t
300+ clientWithRoute Proxy =
301+ clientWithRoute (Proxy :: Proxy sublayout)
272302
273303
274304-- | If you use a 'QueryParam' in one of your endpoints in your API,
@@ -462,9 +492,9 @@ instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
462492instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
463493 type Client t m (path :> sublayout) tag = Client t m sublayout tag
464494
465− clientWithRoute Proxy q t req baseurl =
495+ clientWithRoute Proxy q t req =
466496 clientWithRoute (Proxy :: Proxy sublayout) q t
467− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl
497+ (prependToPathParts (pure (Right $ T.pack p)) req)
468498
469499 where p = symbolVal (Proxy :: Proxy path)
470500
@@ -472,23 +502,23 @@ instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient
472502instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
473503 type Client t m (Vault :> api) tag = Client t m api tag
474504
475− clientWithRoute Proxy q t req baseurl =
476− clientWithRoute (Proxy :: Proxy api) q t req baseurl
505+ clientWithRoute Proxy =
506+ clientWithRoute (Proxy :: Proxy api)
477507
478508
479509instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
480510 type Client t m (RemoteHost :> api) tag = Client t m api tag
481511
482− clientWithRoute Proxy q t req baseurl =
483− clientWithRoute (Proxy :: Proxy api) q t req baseurl
512+ clientWithRoute Proxy =
513+ clientWithRoute (Proxy :: Proxy api)
484514
485515
486516
487517instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
488518 type Client t m (IsSecure :> api) tag = Client t m api tag
489519
490− clientWithRoute Proxy q t req baseurl =
491− clientWithRoute (Proxy :: Proxy api) q t req baseurl
520+ clientWithRoute Proxy =
521+ clientWithRoute (Proxy :: Proxy api)
492522
493523
494524instance (HasClient t m api tag, Reflex t)