@@ -1,24 +1,19 @@
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 GADTs #-}
8+{-# LANGUAGE InstanceSigs #-}
9+{-# LANGUAGE MultiParamTypeClasses #-}
10+{-# LANGUAGE OverloadedStrings #-}
11+{-# LANGUAGE PolyKinds #-}
12+{-# LANGUAGE ScopedTypeVariables #-}
13+{-# LANGUAGE TupleSections #-}
14+{-# LANGUAGE TypeFamilies #-}
15+{-# LANGUAGE TypeOperators #-}
16+{-# LANGUAGE UndecidableInstances #-}
2217
2318-- #include "overlapping-compat.h"
2419-- | This module provides 'client' which can automatically generate
@@ -35,49 +30,47 @@ module Servant.Reflex
3530
3631------------------------------------------------------------------------------
3732import 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)
33+import Data.CaseInsensitive (mk)
4234import 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− )
35+import qualified Data.Map as Map
36+import Data.Monoid ((<>))
37+import Data.Proxy (Proxy (..))
38+import qualified Data.Set as Set
39+import Data.Text (Text)
40+import qualified Data.Text as T
41+import qualified Data.Text.Encoding as E
42+import GHC.TypeLits
43+import Servant.API ((:<|>) (..), (:>), BasicAuth,
44+ BasicAuthData, BuildHeadersTo (..),
45+ Capture, Header, Headers (..),
46+ HttpVersion, IsSecure, MimeRender (..),
47+ MimeUnrender, NoContent, QueryFlag,
48+ QueryParam, QueryParams, Raw,
49+ ReflectMethod (..), RemoteHost,
50+ ReqBody, ToHttpApiData (..), Vault,
51+ Verb, contentType)
52+
53+import Reflex.Dom (Dynamic, Event, Reflex,
54+ XhrRequest (..), XhrResponse (..),
55+ XhrResponseHeaders (..),
56+ attachPromptlyDynWith, constDyn, ffor,
57+ fmapMaybe, leftmost,
58+ performRequestsAsync)
6459------------------------------------------------------------------------------
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)
60+import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),
61+ SupportsServantReflex, baseUrlWidget,
62+ showBaseUrl)
63+import Servant.Common.Req (QParam (..), QueryPart (..), Req,
64+ ReqIO(..), ReqResult (..), addHeader, addHeaderIO,
65+ authData, defReq, evalResponse,
66+ performRequestsCT,
67+ performRequestsCTIO,
68+ performRequestsNoBody,
69+ performSomeRequestsAsync,
70+ prependToPathParts, prependToPathPartsIO, qParamToQueryPart,
71+ qParams, reqBody, reqFailure,
72+ reqMethod, reqSuccess, reqTag,
73+ respHeaders, response)
8174
8275
8376-- * Accessing APIs as a Client
@@ -97,24 +90,67 @@ import Servant.Common.Req (Req, ReqResult(..), QParam(..),
9790-- > where host = constDyn $ BaseUrl Http "localhost" 8080
9891client :: (HasClient t m layout tag)
9992 => 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
93+client p q t = clientWithRoute p q t defReq
10194
10295
10396-- | This class lets us define how each API combinator
10497-- influences the creation of an HTTP request. It's mostly
10598-- an internal class, you can just use 'client'.
106−class HasClient t m layout (tag :: *) where
99+class HasClient t m layout (tag :: *) | m -> t where
107100 type Client t m layout tag :: *
108− clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> Client t m layout tag
101+ type ClientIO m layout tag :: *
102+ type Inp m layout tag :: k
103+ clientWithRoute
104+ :: Proxy layout
105+ -> Proxy m
106+ -> Proxy tag
107+ -> Req t
108+ -> Dynamic t BaseUrl
109+ -> Client t m layout tag
110+ clientWithRouteIO
111+ :: Proxy layout
112+ -> Proxy m
113+ -> Proxy tag
114+ -> ReqIO
115+ -> BaseUrl
116+ -> ClientIO m layout tag
117+
118+data HList :: [*] -> * where
119+ HNil :: HList '[]
120+ HCons :: a -> HList xs -> HList (a ': xs)
121+
122+
123+type family ToTuple xs :: *
124+
125+type instance ToTuple (HList '[]) = ()
126+type instance ToTuple (HList (a ': '[])) = a
127+type instance ToTuple (HList (a ': b ': '[])) = (a,b)
128+type instance ToTuple (HList (a ': b ': c ': '[])) = (a,b,c)
129+type instance ToTuple (HList (a ': b ': c ': d ': '[])) = (a,b,c,d)
130+type instance ToTuple (HList (a ': b ': c ': d ': e ': '[])) = (a,b,c,d,e)
131+type instance ToTuple (HList (a ': b ': c ': d ': e ': f ': '[])) = (a,b,c,d,e,f)
132+
133+type instance ToTuple (a :> ()) = a
134+type instance ToTuple (a :> b :> ()) = (a,b)
135+type instance ToTuple (a :> b :> c :> ()) = (a,b,c)
136+type instance ToTuple (a :> b :> c :> d :> ()) = (a,b,c,d)
137+type instance ToTuple (a :> b :> c :> d :> e :> ()) = (a,b,c,d,e)
138+type instance ToTuple (a :> b :> c :> d :> e :> f :> ()) = (a,b,c,d,e,f)
109139
110140
111141instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where
112142 type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag
143+ type Inp m (a :<|> b) tag = Inp m a tag :<|> Inp m b tag
144+ type ClientIO m (a :<|> b) tag = ClientIO m a tag :<|> ClientIO m b tag
113145
114146 clientWithRoute Proxy q pTag req baseurl =
115147 clientWithRoute (Proxy :: Proxy a) q pTag req baseurl :<|>
116148 clientWithRoute (Proxy :: Proxy b) q pTag req baseurl
117149
150+ clientWithRouteIO Proxy q pTag req baseurl =
151+ clientWithRouteIO (Proxy :: Proxy a) q pTag req baseurl :<|>
152+ clientWithRouteIO (Proxy :: Proxy b) q pTag req baseurl
153+
118154
119155-- Capture. Example:
120156-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
@@ -134,12 +170,26 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout ta
134170 type Client t m (Capture capture a :> sublayout) tag =
135171 Dynamic t (Either Text a) -> Client t m sublayout tag
136172
173+ -- type ClientIO m (Capture capture a :> sublayout) tag =
174+ -- ToTuple (Inp m (Capture capture a :> sublayout) -> ClientIO m sublayout tag
175+
176+ -- type Inp m (Capture capture a :> sublayout) tag =
177+ -- a :> Inp m sublayout tag
178+
137179 clientWithRoute Proxy q t req baseurl val =
138180 clientWithRoute (Proxy :: Proxy sublayout)
139181 q t
140182 (prependToPathParts p req)
141183 baseurl
142− where p = (fmap . fmap) (toUrlPiece) val
184+ where p = (fmap . fmap) toUrlPiece val
185+
186+ -- clientWithRouteIO Proxy q t req baseurl val =
187+ -- clientWithRouteIO (Proxy :: Proxy sublayout)
188+ -- q t
189+ -- req
190+ -- -- (prependToPathPartsIO p req)
191+ -- baseurl
192+ -- where p = toUrlPiece val
143193
144194
145195-- VERB (Returning content) --
@@ -147,16 +197,26 @@ instance {-# OVERLAPPABLE #-}
147197 -- Note [Non-Empty Content Types]
148198 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
149199 ) => HasClient t m (Verb method status cts' a) tag where
200+
150201 type Client t m (Verb method status cts' a) tag =
151202 Event t tag -> m (Event t (ReqResult tag a))
203+
204+ type ClientIO m (Verb method status cts' a) tag =
205+ tag -> m (ReqResult tag a)
206+
152207 -- TODO how to access input types here?
153208 -- ExceptT ServantError IO a
154209 clientWithRoute Proxy _ _ req baseurl trigs =
155210 -- performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs
156− fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl trigs
211+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl trigs
157212 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
158213 req' = req { reqMethod = method }
159214
215+ -- clientWithRouteIO Proxy _ _ req baseurl tag =
216+ -- performRequestsCTIO (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl tag
217+ -- where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
218+ -- req' = req { reqMethodIO = method }
219+
160220
161221-- -- VERB (No content) --
162222instance {-# OVERLAPPING #-}
@@ -256,6 +316,13 @@ instance (KnownSymbol sym, ToHttpApiData a,
256316 baseurl
257317 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
258318
319+ -- clientWithRouteIO Proxy q t req baseurl eVal =
320+ -- clientWithRouteIO (Proxy :: Proxy sublayout)
321+ -- q t
322+ -- (Servant.Common.Req.addHeaderIO hname eVal req)
323+ -- baseurl
324+ -- where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
325+
259326
260327
261328
@@ -267,8 +334,8 @@ instance HasClient t m sublayout tag
267334 type Client t m (HttpVersion :> sublayout) tag =
268335 Client t m sublayout tag
269336
270− clientWithRoute Proxy q t =
271− clientWithRoute (Proxy :: Proxy sublayout) q t
337+ clientWithRoute Proxy =
338+ clientWithRoute (Proxy :: Proxy sublayout)
272339
273340
274341-- | If you use a 'QueryParam' in one of your endpoints in your API,
@@ -462,9 +529,9 @@ instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
462529instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
463530 type Client t m (path :> sublayout) tag = Client t m sublayout tag
464531
465− clientWithRoute Proxy q t req baseurl =
532+ clientWithRoute Proxy q t req =
466533 clientWithRoute (Proxy :: Proxy sublayout) q t
467− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl
534+ (prependToPathParts (pure (Right $ T.pack p)) req)
468535
469536 where p = symbolVal (Proxy :: Proxy path)
470537
@@ -472,23 +539,23 @@ instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient
472539instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
473540 type Client t m (Vault :> api) tag = Client t m api tag
474541
475− clientWithRoute Proxy q t req baseurl =
476− clientWithRoute (Proxy :: Proxy api) q t req baseurl
542+ clientWithRoute Proxy =
543+ clientWithRoute (Proxy :: Proxy api)
477544
478545
479546instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
480547 type Client t m (RemoteHost :> api) tag = Client t m api tag
481548
482− clientWithRoute Proxy q t req baseurl =
483− clientWithRoute (Proxy :: Proxy api) q t req baseurl
549+ clientWithRoute Proxy =
550+ clientWithRoute (Proxy :: Proxy api)
484551
485552
486553
487554instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
488555 type Client t m (IsSecure :> api) tag = Client t m api tag
489556
490− clientWithRoute Proxy q t req baseurl =
491− clientWithRoute (Proxy :: Proxy api) q t req baseurl
557+ clientWithRoute Proxy =
558+ clientWithRoute (Proxy :: Proxy api)
492559
493560
494561instance (HasClient t m api tag, Reflex t)