git.iko.soy/typeable/servant-reflex
on master help sign in
Initial infrastructure, doesn't build
a13bdbeDoug Beardsley
.gitmodulesnew file+9
compare with master
unifiedsplit
@@ -0,0 +1,9 @@
1+[submodule "deps/reflex-dom-contrib"]
2+ path = deps/reflex-dom-contrib
3+ url = git@github.com:reflex-frp/reflex-dom-contrib.git
4+[submodule "deps/try-reflex"]
5+ path = deps/try-reflex
6+ url = git@github.com:ryantrinkle/try-reflex.git
7+[submodule "deps/servant"]
8+ path = deps/servant
9+ url = https://github.com/haskell-servant/servant.git
build.shnew file+3
@@ -0,0 +1,3 @@
1+#!/bin/sh
2+
3+deps/try-reflex/work-on ./overrides.nix ./. --run "cabal configure --ghcjs ; cabal build"
default.nixnew file+20
@@ -0,0 +1,20 @@
1+{ mkDerivation, exceptions, http-types, reflex, reflex-dom,
2+ reflex-dom-contrib, servant
3+}:
4+
5+mkDerivation {
6+ pname = "servant-reflex";
7+ version = "0.1";
8+ src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;
9+ isExecutable = true;
10+ isLibrary = true;
11+ buildDepends = [
12+ exceptions
13+ http-types
14+ reflex
15+ reflex-dom
16+ reflex-dom-contrib
17+ servant
18+ ];
19+ license = null;
20+}
deps/reflex-dom-contribnew file+1

Submodule changed.

deps/servantnew file+1

Submodule changed.

deps/try-reflexnew file+1

Submodule changed.

overrides.nixnew file+8
@@ -0,0 +1,8 @@
1+{}:
2+let try-reflex = import deps/try-reflex {};
3+in try-reflex.ghcjs.override {
4+ overrides = self: super: {
5+ reflex-dom-contrib = self.callPackage deps/reflex-dom-contrib {};
6+ servant = self.callPackage (try-reflex.cabal2nixResult deps/servant/servant) {};
7+ };
8+}
servant-reflex.cabalnew file+46
@@ -0,0 +1,46 @@
1+Name: servant-reflex
2+Version: 0.1
3+Synopsis: Servant reflex API generator
4+Description: Servant reflex API generator
5+License: AllRightsReserved
6+License-file: LICENSE
7+Author: Doug Beardsley
8+Maintainer: mightybyte@gmail.com
9+Stability: Experimental
10+Category: Web
11+Build-type: Simple
12+Cabal-version: >=1.8
13+
14+library
15+ exposed-modules:
16+ Servant.Reflex
17+
18+ other-modules:
19+ Servant.Common.BaseUrl
20+ Servant.Common.Req
21+
22+ hs-source-dirs: src
23+ build-depends:
24+ base,
25+ bytestring >= 0.10 && < 0.11,
26+ containers,
27+ exceptions >= 0.8 && < 0.9,
28+ ghcjs-base,
29+ ghcjs-dom == 0.1.*,
30+ http-media >= 0.6 && < 0.7,
31+ http-types >= 0.8 && < 0.9,
32+ mtl,
33+ network-uri >= 2.6 && < 2.7,
34+ reflex,
35+ reflex-dom,
36+ reflex-dom-contrib,
37+ safe,
38+ servant >= 0.5 && < 0.6,
39+ string-conversions,
40+ text,
41+ transformers >= 0.4 && < 0.5
42+
43+ if impl(ghcjs)
44+ build-depends: ghcjs-base
45+
46+ ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
shell.shnew file+3
@@ -0,0 +1,3 @@
1+#!/bin/sh
2+
3+deps/try-reflex/work-on ./overrides.nix ./.
src/Servant/Common/BaseUrl.hsnew file+77
@@ -0,0 +1,77 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE ViewPatterns #-}
4+module Servant.Common.BaseUrl (
5+ -- * types
6+ BaseUrl (..)
7+ , InvalidBaseUrlException
8+ , Scheme (..)
9+ -- * functions
10+ , parseBaseUrl
11+ , showBaseUrl
12+) where
13+
14+import Control.Monad.Catch (Exception, MonadThrow, throwM)
15+import Data.List
16+import Data.Typeable
17+import GHC.Generics
18+import Network.URI hiding (path)
19+import Safe
20+import Text.Read
21+
22+-- | URI scheme to use
23+data Scheme =
24+ Http -- ^ http://
25+ | Https -- ^ https://
26+ deriving (Show, Eq, Ord, Generic)
27+
28+-- | Simple data type to represent the target of HTTP requests
29+-- for servant's automatically-generated clients.
30+data BaseUrl = BaseUrl
31+ { baseUrlScheme :: Scheme -- ^ URI scheme to use
32+ , baseUrlHost :: String -- ^ host (eg "haskell.org")
33+ , baseUrlPort :: Int -- ^ port (eg 80)
34+ , baseUrlPath :: String -- ^ path (eg "/a/b/c")
35+ } deriving (Show, Ord, Generic)
36+
37+instance Eq BaseUrl where
38+ BaseUrl a b c path == BaseUrl a' b' c' path'
39+ = a == a' && b == b' && c == c' && s path == s path'
40+ where s ('/':x) = x
41+ s x = x
42+
43+showBaseUrl :: BaseUrl -> String
44+showBaseUrl (BaseUrl urlscheme host port path) =
45+ schemeString ++ "//" ++ host ++ (portString </> path)
46+ where
47+ a </> b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b
48+ schemeString = case urlscheme of
49+ Http -> "http:"
50+ Https -> "https:"
51+ portString = case (urlscheme, port) of
52+ (Http, 80) -> ""
53+ (Https, 443) -> ""
54+ _ -> ":" ++ show port
55+
56+data InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show, Typeable)
57+instance Exception InvalidBaseUrlException
58+
59+parseBaseUrl :: MonadThrow m => String -> m BaseUrl
60+parseBaseUrl s = case parseURI (removeTrailingSlash s) of
61+ -- This is a rather hacky implementation and should be replaced with something
62+ -- implemented in attoparsec (which is already a dependency anyhow (via aeson)).
63+ Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") ->
64+ return (BaseUrl Http host port path)
65+ Just (URI "http:" (Just (URIAuth "" host "")) path "" "") ->
66+ return (BaseUrl Http host 80 path)
67+ Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") ->
68+ return (BaseUrl Https host port path)
69+ Just (URI "https:" (Just (URIAuth "" host "")) path "" "") ->
70+ return (BaseUrl Https host 443 path)
71+ _ -> if "://" `isInfixOf` s
72+ then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)
73+ else parseBaseUrl ("http://" ++ s)
74+ where
75+ removeTrailingSlash str = case lastMay str of
76+ Just '/' -> init str
77+ _ -> str
src/Servant/Common/Req.hsnew file+171
@@ -0,0 +1,171 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+module Servant.Common.Req where
6+
7+#if !MIN_VERSION_base(4,8,0)
8+import Control.Applicative
9+#endif
10+import Control.Exception
11+import Control.Monad
12+import Control.Monad.Catch (MonadThrow)
13+import Control.Monad.IO.Class
14+import Control.Monad.Trans.Except
15+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
16+import Data.String
17+import Data.String.Conversions
18+import Data.Proxy
19+import Data.Text (Text)
20+import Data.Text.Encoding
21+import Data.Typeable
22+import Network.HTTP.Media
23+import Network.HTTP.Types
24+import qualified Network.HTTP.Types.Header as HTTP
25+import Network.URI hiding (path)
26+import Servant.API.ContentTypes
27+import Servant.Common.BaseUrl
28+
29+import Web.HttpApiData
30+
31+data ServantError
32+ = FailureResponse
33+ { responseStatus :: Status
34+ , responseContentType :: MediaType
35+ , responseBody :: ByteString
36+ }
37+ | DecodeFailure
38+ { decodeError :: String
39+ , responseContentType :: MediaType
40+ , responseBody :: ByteString
41+ }
42+ | UnsupportedContentType
43+ { responseContentType :: MediaType
44+ , responseBody :: ByteString
45+ }
46+ | InvalidContentTypeHeader
47+ { responseContentTypeHeader :: ByteString
48+ , responseBody :: ByteString
49+ }
50+ | ConnectionError
51+ { connectionError :: SomeException
52+ }
53+ deriving (Show, Typeable)
54+
55+instance Exception ServantError
56+
57+data Req = Req
58+ { reqPath :: String
59+ , qs :: QueryText
60+ , reqBody :: Maybe (ByteString, MediaType)
61+ , reqAccept :: [MediaType]
62+ , headers :: [(String, Text)]
63+ }
64+
65+defReq :: Req
66+defReq = Req "" [] Nothing [] []
67+
68+appendToPath :: String -> Req -> Req
69+appendToPath p req =
70+ req { reqPath = reqPath req ++ "/" ++ p }
71+
72+appendToQueryString :: Text -- ^ param name
73+ -> Maybe Text -- ^ param value
74+ -> Req
75+ -> Req
76+appendToQueryString pname pvalue req =
77+ req { qs = qs req ++ [(pname, pvalue)]
78+ }
79+
80+addHeader :: ToHttpApiData a => String -> a -> Req -> Req
81+addHeader name val req = req { headers = headers req
82+ ++ [(name, decodeUtf8 (toHeader val))]
83+ }
84+
85+setRQBody :: ByteString -> MediaType -> Req -> Req
86+setRQBody b t req = req { reqBody = Just (b, t) }
87+
88+reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
89+reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
90+ setheaders . setAccept . setrqb . setQS <$> parseUrl url
91+
92+ where url = show $ nullURI { uriScheme = case reqScheme of
93+ Http -> "http:"
94+ Https -> "https:"
95+ , uriAuthority = Just $
96+ URIAuth { uriUserInfo = ""
97+ , uriRegName = reqHost
98+ , uriPort = ":" ++ show reqPort
99+ }
100+ , uriPath = path ++ reqPath req
101+ }
102+
103+ setrqb r = case reqBody req of
104+ Nothing -> r
105+ Just (b,t) -> r { requestBody = RequestBodyLBS b
106+ , requestHeaders = requestHeaders r
107+ ++ [(hContentType, cs . show $ t)] }
108+ setQS = setQueryString $ queryTextToQuery (qs req)
109+ setheaders r = r { requestHeaders = requestHeaders r
110+ <> fmap toProperHeader (headers req) }
111+ setAccept r = r { requestHeaders = filter ((/= "Accept") . fst) (requestHeaders r)
112+ <> [("Accept", renderHeader $ reqAccept req)
113+ | not . null . reqAccept $ req] }
114+ toProperHeader (name, val) =
115+ (fromString name, encodeUtf8 val)
116+
117+
118+-- * performing requests
119+
120+displayHttpRequest :: Method -> String
121+displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
122+
123+performRequest = undefined
124+performRequestCT = undefined
125+performRequestNoBody = undefined
126+
127+-- performRequest :: Method -> Req -> BaseUrl -> Manager
128+-- -> ExceptT ServantError IO ( Int, ByteString, MediaType
129+-- , [HTTP.Header], Response ByteString)
130+-- performRequest reqMethod req reqHost manager = do
131+-- partialRequest <- liftIO $ reqToRequest req reqHost
132+--
133+-- let request = partialRequest { Client.method = reqMethod
134+-- , checkStatus = \ _status _headers _cookies -> Nothing
135+-- }
136+--
137+-- eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager
138+-- case eResponse of
139+-- Left err ->
140+-- throwE . ConnectionError $ SomeException err
141+--
142+-- Right response -> do
143+-- let status = Client.responseStatus response
144+-- body = Client.responseBody response
145+-- hrds = Client.responseHeaders response
146+-- status_code = statusCode status
147+-- ct <- case lookup "Content-Type" $ Client.responseHeaders response of
148+-- Nothing -> pure $ "application"//"octet-stream"
149+-- Just t -> case parseAccept t of
150+-- Nothing -> throwE $ InvalidContentTypeHeader (cs t) body
151+-- Just t' -> pure t'
152+-- unless (status_code >= 200 && status_code < 300) $
153+-- throwE $ FailureResponse status ct body
154+-- return (status_code, body, ct, hrds, response)
155+--
156+--
157+-- performRequestCT :: MimeUnrender ct result =>
158+-- Proxy ct -> Method -> Req -> BaseUrl -> Manager -> ExceptT ServantError IO ([HTTP.Header], result)
159+-- performRequestCT ct reqMethod req reqHost manager = do
160+-- let acceptCT = contentType ct
161+-- (_status, respBody, respCT, hrds, _response) <-
162+-- performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager
163+-- unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
164+-- case mimeUnrender ct respBody of
165+-- Left err -> throwE $ DecodeFailure err respCT respBody
166+-- Right val -> return (hrds, val)
167+--
168+-- performRequestNoBody :: Method -> Req -> BaseUrl -> Manager -> ExceptT ServantError IO ()
169+-- performRequestNoBody reqMethod req reqHost manager =
170+-- void $ performRequest reqMethod req reqHost manager
171+
src/Servant/Reflex.hsnew file+576
@@ -0,0 +1,576 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE InstanceSigs #-}
6+{-# LANGUAGE OverloadedStrings #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE TypeFamilies #-}
9+{-# LANGUAGE TypeOperators #-}
10+{-# LANGUAGE UndecidableInstances #-}
11+#if !MIN_VERSION_base(4,8,0)
12+{-# LANGUAGE OverlappingInstances #-}
13+#endif
14+-- | This module provides 'client' which can automatically generate
15+-- querying functions for each endpoint just from the type representing your
16+-- API.
17+module Servant.Reflex
18+ ( client
19+ , HasReflexClient(..)
20+ , ServantError(..)
21+ , module Servant.Common.BaseUrl
22+ ) where
23+
24+#if !MIN_VERSION_base(4,8,0)
25+import Control.Applicative ((<$>))
26+#endif
27+import Control.Monad
28+import Control.Monad.Trans.Except
29+import Data.ByteString.Lazy (ByteString)
30+import Data.List
31+import Data.Proxy
32+import Data.String.Conversions
33+import Data.Text (unpack)
34+import GHC.TypeLits
35+import Network.HTTP.Media
36+import qualified Network.HTTP.Types as H
37+import qualified Network.HTTP.Types.Header as HTTP
38+import Servant.API
39+import Servant.Common.BaseUrl
40+import Servant.Common.Req
41+import Web.HttpApiData
42+
43+-- * Accessing APIs as a Client
44+
45+-- | 'client' allows you to produce operations to query an API from a client.
46+--
47+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
48+-- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
49+-- >
50+-- > myApi :: Proxy MyApi
51+-- > myApi = Proxy
52+-- >
53+-- > getAllBooks :: ExceptT String IO [Book]
54+-- > postNewBook :: Book -> ExceptT String IO Book
55+-- > (getAllBooks :<|> postNewBook) = client myApi host
56+-- > where host = BaseUrl Http "localhost" 8080
57+client :: HasReflexClient layout => Proxy layout -> BaseUrl -> Input layout -> Client layout
58+client p baseurl = clientWithRoute p defReq baseurl
59+
60+type Final a = forall m. m a
61+
62+data a ::> b = a ::> b deriving (Eq,Ord,Show,Read)
63+
64+infixr 3 ::>
65+
66+-- | This class lets us define how each API combinator
67+-- influences the creation of an HTTP request. It's mostly
68+-- an internal class, you can just use 'client'.
69+class HasReflexClient layout where
70+ type Input layout :: *
71+ type Client layout :: *
72+ clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Input layout -> Client layout
73+
74+
75+-- | If you have a 'Get' endpoint in your API, the client
76+-- side querying function that is created when calling 'client'
77+-- will just require an argument that specifies the scheme, host
78+-- and port to send the request to.
79+instance
80+#if MIN_VERSION_base(4,8,0)
81+ {-# OVERLAPPABLE #-}
82+#endif
83+ (MimeUnrender ct result) => HasReflexClient (Get (ct ': cts) result) where
84+ type Input (Get (ct ': cts) result) = ()
85+ type Client (Get (ct ': cts) result) = Final result
86+ clientWithRoute Proxy req baseurl _ =
87+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl
88+
89+instance
90+#if MIN_VERSION_base(4,8,0)
91+ {-# OVERLAPPING #-}
92+#endif
93+ HasReflexClient (Get (ct ': cts) ()) where
94+ type Input (Get (ct ': cts) ()) = ()
95+ type Client (Get (ct ': cts) ()) = Final ()
96+ clientWithRoute Proxy req baseurl _ =
97+ performRequestNoBody H.methodGet req baseurl
98+
99+-- | Pick a 'Method' and specify where the server you want to query is. You get
100+-- back the full `Response`.
101+instance HasReflexClient Raw where
102+ type Input Raw = H.Method ::> ()
103+ type Client Raw = Final (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
104+
105+ clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Input Raw -> Client Raw
106+ clientWithRoute Proxy req baseurl (httpMethod ::> ()) = do
107+ performRequest httpMethod req baseurl
108+
109+-- -- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
110+-- -- corresponding headers.
111+-- instance
112+-- #if MIN_VERSION_base(4,8,0)
113+-- {-# OVERLAPPING #-}
114+-- #endif
115+-- ( MimeUnrender ct a, BuildHeadersTo ls
116+-- ) => HasReflexClient (Get (ct ': cts) (Headers ls a)) where
117+-- type Input (Get (ct ': cts) (Headers ls a)) = ()
118+-- type Client (Get (ct ': cts) (Headers ls a)) = Final (Headers ls a)
119+-- clientWithRoute Proxy req baseurl _ = do
120+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl
121+-- return $ Headers { getResponse = resp
122+-- , getHeadersHList = buildHeadersTo hdrs
123+-- }
124+--
125+-- -- | A client querying function for @a ':<|>' b@ will actually hand you
126+-- -- one function for querying @a@ and another one for querying @b@,
127+-- -- stitching them together with ':<|>', which really is just like a pair.
128+-- --
129+-- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
130+-- -- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
131+-- -- >
132+-- -- > myApi :: Proxy MyApi
133+-- -- > myApi = Proxy
134+-- -- >
135+-- -- > getAllBooks :: ExceptT String IO [Book]
136+-- -- > postNewBook :: Book -> ExceptT String IO Book
137+-- -- > (getAllBooks :<|> postNewBook) = client myApi host
138+-- -- > where host = BaseUrl Http "localhost" 8080
139+-- instance (HasReflexClient a, HasReflexClient b) => HasReflexClient (a :<|> b) where
140+-- type Input (a :<|> b) = Input a :<|> Input b
141+-- type Client (a :<|> b) = Client a :<|> Client b
142+-- clientWithRoute Proxy req baseurl (a :<|> b) =
143+-- clientWithRoute (Proxy :: Proxy a) req baseurl a :<|>
144+-- clientWithRoute (Proxy :: Proxy b) req baseurl b
145+--
146+-- ------------------------------------------------------------------------------
147+-- -- | If you use a 'Capture' in one of your endpoints in your API,
148+-- -- the corresponding querying function will automatically take
149+-- -- an additional argument of the type specified by your 'Capture'.
150+-- -- That function will take care of inserting a textual representation
151+-- -- of this value at the right place in the request path.
152+-- --
153+-- -- You can control how values for this type are turned into
154+-- -- text by specifying a 'ToHttpApiData' instance for your type.
155+-- --
156+-- -- Example:
157+-- --
158+-- -- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
159+-- -- >
160+-- -- > myApi :: Proxy MyApi
161+-- -- > myApi = Proxy
162+-- -- >
163+-- -- > getBook :: Text -> ExceptT String IO Book
164+-- -- > getBook = client myApi host
165+-- -- > where host = BaseUrl Http "localhost" 8080
166+-- -- > -- then you can just use "getBook" to query that endpoint
167+-- instance (KnownSymbol capture, ToHttpApiData a, HasReflexClient sublayout)
168+-- => HasReflexClient (Capture capture a :> sublayout) where
169+--
170+-- type Input (Capture cap a :> sublayout) = a ::> Input sublayout
171+-- type Client (Capture capture a :> sublayout) = Client sublayout
172+--
173+-- clientWithRoute Proxy req baseurl (val ::> rest) =
174+-- clientWithRoute (Proxy :: Proxy sublayout)
175+-- (appendToPath p req) baseurl rest
176+--
177+-- where p = unpack (toUrlPiece val)
178+--
179+-- -- | If you have a 'Delete' endpoint in your API, the client
180+-- -- side querying function that is created when calling 'client'
181+-- -- will just require an argument that specifies the scheme, host
182+-- -- and port to send the request to.
183+-- instance
184+-- #if MIN_VERSION_base(4,8,0)
185+-- {-# OVERLAPPABLE #-}
186+-- #endif
187+-- (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasReflexClient (Delete cts' a) where
188+-- type Input (Delete cts' a) = ()
189+-- type Client (Delete cts' a) = Final a
190+-- clientWithRoute Proxy req baseurl val =
191+-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl val
192+--
193+-- instance
194+-- #if MIN_VERSION_base(4,8,0)
195+-- {-# OVERLAPPING #-}
196+-- #endif
197+-- HasReflexClient (Delete cts ()) where
198+-- type Input (Delete cts ()) = ()
199+-- type Client (Delete cts ()) = Final ()
200+-- clientWithRoute Proxy req baseurl val =
201+-- void $ performRequestNoBody H.methodDelete req baseurl val
202+--
203+-- -- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
204+-- -- corresponding headers.
205+-- instance
206+-- #if MIN_VERSION_base(4,8,0)
207+-- {-# OVERLAPPING #-}
208+-- #endif
209+-- ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
210+-- ) => HasReflexClient (Delete cts' (Headers ls a)) where
211+-- type Input (Delete cts' (Headers ls a)) = ()
212+-- type Client (Delete cts' (Headers ls a)) = Final (Headers ls a)
213+-- clientWithRoute Proxy req baseurl _ = do
214+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl
215+-- return $ Headers { getResponse = resp
216+-- , getHeadersHList = buildHeadersTo hdrs
217+-- }
218+--
219+-- -- | If you use a 'Header' in one of your endpoints in your API,
220+-- -- the corresponding querying function will automatically take
221+-- -- an additional argument of the type specified by your 'Header',
222+-- -- wrapped in Maybe.
223+-- --
224+-- -- That function will take care of encoding this argument as Text
225+-- -- in the request headers.
226+-- --
227+-- -- All you need is for your type to have a 'ToHttpApiData' instance.
228+-- --
229+-- -- Example:
230+-- --
231+-- -- > newtype Referer = Referer { referrer :: Text }
232+-- -- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
233+-- -- >
234+-- -- > -- GET /view-my-referer
235+-- -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
236+-- -- >
237+-- -- > myApi :: Proxy MyApi
238+-- -- > myApi = Proxy
239+-- -- >
240+-- -- > viewReferer :: Maybe Referer -> ExceptT String IO Book
241+-- -- > viewReferer = client myApi host
242+-- -- > where host = BaseUrl Http "localhost" 8080
243+-- -- > -- then you can just use "viewRefer" to query that endpoint
244+-- -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
245+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
246+-- => HasReflexClient (Header sym a :> sublayout) where
247+--
248+-- type Input (Header sym a :> sublayout) = Maybe a ::> Input sublayout
249+-- type Client (Header sym a :> sublayout) = Client sublayout
250+--
251+-- clientWithRoute Proxy req baseurl (mval ::> rest) =
252+-- clientWithRoute (Proxy :: Proxy sublayout)
253+-- (maybe req
254+-- (\value -> Servant.Common.Req.addHeader hname value req)
255+-- mval
256+-- )
257+-- baseurl rest
258+--
259+-- where hname = symbolVal (Proxy :: Proxy sym)
260+--
261+-- -- | If you have a 'Post' endpoint in your API, the client
262+-- -- side querying function that is created when calling 'client'
263+-- -- will just require an argument that specifies the scheme, host
264+-- -- and port to send the request to.
265+-- instance
266+-- #if MIN_VERSION_base(4,8,0)
267+-- {-# OVERLAPPABLE #-}
268+-- #endif
269+-- (MimeUnrender ct a) => HasReflexClient (Post (ct ': cts) a) where
270+-- type Input (Post (ct ': cts) a) = ()
271+-- type Client (Post (ct ': cts) a) = Final a
272+-- clientWithRoute Proxy req baseurl _ =
273+-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl
274+--
275+-- instance
276+-- #if MIN_VERSION_base(4,8,0)
277+-- {-# OVERLAPPING #-}
278+-- #endif
279+-- HasReflexClient (Post (ct ': cts) ()) where
280+-- type Input (Post (ct ': cts) ()) = ()
281+-- type Client (Post (ct ': cts) ()) = Final ()
282+-- clientWithRoute Proxy req baseurl _ =
283+-- void $ performRequestNoBody H.methodPost req baseurl
284+--
285+-- -- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
286+-- -- corresponding headers.
287+-- instance
288+-- #if MIN_VERSION_base(4,8,0)
289+-- {-# OVERLAPPING #-}
290+-- #endif
291+-- ( MimeUnrender ct a, BuildHeadersTo ls
292+-- ) => HasReflexClient (Post (ct ': cts) (Headers ls a)) where
293+-- type Input (Post (ct ': cts) (Headers ls a)) = ()
294+-- type Client (Post (ct ': cts) (Headers ls a)) = Final (Headers ls a)
295+-- clientWithRoute Proxy req baseurl _ = do
296+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl
297+-- return $ Headers { getResponse = resp
298+-- , getHeadersHList = buildHeadersTo hdrs
299+-- }
300+--
301+-- -- | If you have a 'Put' endpoint in your API, the client
302+-- -- side querying function that is created when calling 'client'
303+-- -- will just require an argument that specifies the scheme, host
304+-- -- and port to send the request to.
305+-- instance
306+-- #if MIN_VERSION_base(4,8,0)
307+-- {-# OVERLAPPABLE #-}
308+-- #endif
309+-- (MimeUnrender ct a) => HasReflexClient (Put (ct ': cts) a) where
310+-- type Input (Put (ct ': cts) a) = ()
311+-- type Client (Put (ct ': cts) a) = Final a
312+-- clientWithRoute Proxy req baseurl _ =
313+-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl
314+--
315+-- instance
316+-- #if MIN_VERSION_base(4,8,0)
317+-- {-# OVERLAPPING #-}
318+-- #endif
319+-- HasReflexClient (Put (ct ': cts) ()) where
320+-- type Input (Put (ct ': cts) ()) = ()
321+-- type Client (Put (ct ': cts) ()) = Final ()
322+-- clientWithRoute Proxy req baseurl _ =
323+-- void $ performRequestNoBody H.methodPut req baseurl
324+--
325+-- -- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
326+-- -- corresponding headers.
327+-- instance
328+-- #if MIN_VERSION_base(4,8,0)
329+-- {-# OVERLAPPING #-}
330+-- #endif
331+-- ( MimeUnrender ct a, BuildHeadersTo ls
332+-- ) => HasReflexClient (Put (ct ': cts) (Headers ls a)) where
333+-- type Input (Put (ct ': cts) (Headers ls a)) = ()
334+-- type Client (Put (ct ': cts) (Headers ls a)) = Final (Headers ls a)
335+-- clientWithRoute Proxy req baseurl _ = do
336+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl
337+-- return $ Headers { getResponse = resp
338+-- , getHeadersHList = buildHeadersTo hdrs
339+-- }
340+--
341+-- -- | If you have a 'Patch' endpoint in your API, the client
342+-- -- side querying function that is created when calling 'client'
343+-- -- will just require an argument that specifies the scheme, host
344+-- -- and port to send the request to.
345+-- instance
346+-- #if MIN_VERSION_base(4,8,0)
347+-- {-# OVERLAPPABLE #-}
348+-- #endif
349+-- (MimeUnrender ct a) => HasReflexClient (Patch (ct ': cts) a) where
350+-- type Input (Patch (ct ': cts) a) = ()
351+-- type Client (Patch (ct ': cts) a) = Final a
352+-- clientWithRoute Proxy req baseurl _ =
353+-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl
354+--
355+-- instance
356+-- #if MIN_VERSION_base(4,8,0)
357+-- {-# OVERLAPPING #-}
358+-- #endif
359+-- HasReflexClient (Patch (ct ': cts) ()) where
360+-- type Input (Patch (ct ': cts) ()) = ()
361+-- type Client (Patch (ct ': cts) ()) = Final ()
362+-- clientWithRoute Proxy req baseurl _ =
363+-- void $ performRequestNoBody H.methodPatch req baseurl
364+--
365+-- -- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
366+-- -- corresponding headers.
367+-- instance
368+-- #if MIN_VERSION_base(4,8,0)
369+-- {-# OVERLAPPING #-}
370+-- #endif
371+-- ( MimeUnrender ct a, BuildHeadersTo ls
372+-- ) => HasReflexClient (Patch (ct ': cts) (Headers ls a)) where
373+-- type Input (Patch (ct ': cts) (Headers ls a)) = ()
374+-- type Client (Patch (ct ': cts) (Headers ls a)) = Final (Headers ls a)
375+-- clientWithRoute Proxy req baseurl _ = do
376+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl
377+-- return $ Headers { getResponse = resp
378+-- , getHeadersHList = buildHeadersTo hdrs
379+-- }
380+--
381+-- -- | If you use a 'QueryParam' in one of your endpoints in your API,
382+-- -- the corresponding querying function will automatically take
383+-- -- an additional argument of the type specified by your 'QueryParam',
384+-- -- enclosed in Maybe.
385+-- --
386+-- -- If you give Nothing, nothing will be added to the query string.
387+-- --
388+-- -- If you give a non-'Nothing' value, this function will take care
389+-- -- of inserting a textual representation of this value in the query string.
390+-- --
391+-- -- You can control how values for your type are turned into
392+-- -- text by specifying a 'ToHttpApiData' instance for your type.
393+-- --
394+-- -- Example:
395+-- --
396+-- -- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
397+-- -- >
398+-- -- > myApi :: Proxy MyApi
399+-- -- > myApi = Proxy
400+-- -- >
401+-- -- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
402+-- -- > getBooksBy = client myApi host
403+-- -- > where host = BaseUrl Http "localhost" 8080
404+-- -- > -- then you can just use "getBooksBy" to query that endpoint.
405+-- -- > -- 'getBooksBy Nothing' for all books
406+-- -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
407+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
408+-- => HasReflexClient (QueryParam sym a :> sublayout) where
409+--
410+-- type Input (QueryParam sym a :> sublayout) = Maybe a ::> Input sublayout
411+-- type Client (QueryParam sym a :> sublayout) = Client sublayout
412+--
413+-- -- if mparam = Nothing, we don't add it to the query string
414+-- clientWithRoute Proxy req baseurl (mparam ::> rest) =
415+-- clientWithRoute (Proxy :: Proxy sublayout)
416+-- (maybe req
417+-- (flip (appendToQueryString pname) req . Just)
418+-- mparamText
419+-- )
420+-- baseurl rest
421+--
422+-- where pname = cs pname'
423+-- pname' = symbolVal (Proxy :: Proxy sym)
424+-- mparamText = fmap toQueryParam mparam
425+--
426+-- -- | If you use a 'QueryParams' in one of your endpoints in your API,
427+-- -- the corresponding querying function will automatically take
428+-- -- an additional argument, a list of values of the type specified
429+-- -- by your 'QueryParams'.
430+-- --
431+-- -- If you give an empty list, nothing will be added to the query string.
432+-- --
433+-- -- Otherwise, this function will take care
434+-- -- of inserting a textual representation of your values in the query string,
435+-- -- under the same query string parameter name.
436+-- --
437+-- -- You can control how values for your type are turned into
438+-- -- text by specifying a 'ToHttpApiData' instance for your type.
439+-- --
440+-- -- Example:
441+-- --
442+-- -- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
443+-- -- >
444+-- -- > myApi :: Proxy MyApi
445+-- -- > myApi = Proxy
446+-- -- >
447+-- -- > getBooksBy :: [Text] -> ExceptT String IO [Book]
448+-- -- > getBooksBy = client myApi host
449+-- -- > where host = BaseUrl Http "localhost" 8080
450+-- -- > -- then you can just use "getBooksBy" to query that endpoint.
451+-- -- > -- 'getBooksBy []' for all books
452+-- -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
453+-- -- > -- to get all books by Asimov and Heinlein
454+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
455+-- => HasReflexClient (QueryParams sym a :> sublayout) where
456+--
457+-- type Input (QueryParams sym a :> sublayout) = [a] ::> Input sublayout
458+-- type Client (QueryParams sym a :> sublayout) = Client sublayout
459+--
460+-- clientWithRoute Proxy req baseurl (paramlist ::> rest) =
461+-- clientWithRoute (Proxy :: Proxy sublayout)
462+-- (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
463+-- req
464+-- paramlist'
465+-- )
466+-- baseurl rest
467+--
468+-- where pname = cs pname'
469+-- pname' = symbolVal (Proxy :: Proxy sym)
470+-- paramlist' = map (Just . toQueryParam) paramlist
471+--
472+-- -- | If you use a 'QueryFlag' in one of your endpoints in your API,
473+-- -- the corresponding querying function will automatically take
474+-- -- an additional 'Bool' argument.
475+-- --
476+-- -- If you give 'False', nothing will be added to the query string.
477+-- --
478+-- -- Otherwise, this function will insert a value-less query string
479+-- -- parameter under the name associated to your 'QueryFlag'.
480+-- --
481+-- -- Example:
482+-- --
483+-- -- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
484+-- -- >
485+-- -- > myApi :: Proxy MyApi
486+-- -- > myApi = Proxy
487+-- -- >
488+-- -- > getBooks :: Bool -> ExceptT String IO [Book]
489+-- -- > getBooks = client myApi host
490+-- -- > where host = BaseUrl Http "localhost" 8080
491+-- -- > -- then you can just use "getBooks" to query that endpoint.
492+-- -- > -- 'getBooksBy False' for all books
493+-- -- > -- 'getBooksBy True' to only get _already published_ books
494+-- instance (KnownSymbol sym, HasReflexClient sublayout)
495+-- => HasReflexClient (QueryFlag sym :> sublayout) where
496+--
497+-- type Input (QueryFlag sym :> sublayout) = Bool ::> Input sublayout
498+-- type Client (QueryFlag sym :> sublayout) = Client sublayout
499+--
500+-- clientWithRoute Proxy req baseurl (flag ::> rest) =
501+-- clientWithRoute (Proxy :: Proxy sublayout)
502+-- (if flag
503+-- then appendToQueryString paramname Nothing req
504+-- else req
505+-- )
506+-- baseurl rest
507+--
508+-- where paramname = cs $ symbolVal (Proxy :: Proxy sym)
509+--
510+--
511+-- -- | If you use a 'ReqBody' in one of your endpoints in your API,
512+-- -- the corresponding querying function will automatically take
513+-- -- an additional argument of the type specified by your 'ReqBody'.
514+-- -- That function will take care of encoding this argument as JSON and
515+-- -- of using it as the request body.
516+-- --
517+-- -- All you need is for your type to have a 'ToJSON' instance.
518+-- --
519+-- -- Example:
520+-- --
521+-- -- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
522+-- -- >
523+-- -- > myApi :: Proxy MyApi
524+-- -- > myApi = Proxy
525+-- -- >
526+-- -- > addBook :: Book -> ExceptT String IO Book
527+-- -- > addBook = client myApi host
528+-- -- > where host = BaseUrl Http "localhost" 8080
529+-- -- > -- then you can just use "addBook" to query that endpoint
530+-- instance (MimeRender ct a, HasReflexClient sublayout)
531+-- => HasReflexClient (ReqBody (ct ': cts) a :> sublayout) where
532+--
533+-- type Input (ReqBody (ct ': cts) a :> sublayout) = a ::> Input sublayout
534+-- type Client (ReqBody (ct ': cts) a :> sublayout) = Client sublayout
535+--
536+-- clientWithRoute Proxy req baseurl (body ::> rest) =
537+-- clientWithRoute (Proxy :: Proxy sublayout)
538+-- (let ctProxy = Proxy :: Proxy ct
539+-- in setRQBody (mimeRender ctProxy body)
540+-- (contentType ctProxy)
541+-- req
542+-- )
543+-- baseurl rest
544+--
545+-- -- | Make the querying function append @path@ to the request path.
546+-- instance (KnownSymbol path, HasReflexClient sublayout) => HasReflexClient (path :> sublayout) where
547+-- type Input (path :> sublayout) = Input sublayout
548+-- type Client (path :> sublayout) = Client sublayout
549+--
550+-- clientWithRoute Proxy req baseurl val =
551+-- clientWithRoute (Proxy :: Proxy sublayout)
552+-- (appendToPath p req)
553+-- baseurl val
554+--
555+-- where p = symbolVal (Proxy :: Proxy path)
556+--
557+-- instance HasReflexClient api => HasReflexClient (Vault :> api) where
558+-- type Input (Vault :> api) = Input api
559+-- type Client (Vault :> api) = Client api
560+--
561+-- clientWithRoute Proxy req baseurl val =
562+-- clientWithRoute (Proxy :: Proxy api) req baseurl val
563+--
564+-- instance HasReflexClient api => HasReflexClient (RemoteHost :> api) where
565+-- type Input (RemoteHost :> api) = Input api
566+-- type Client (RemoteHost :> api) = Client api
567+--
568+-- clientWithRoute Proxy req baseurl val =
569+-- clientWithRoute (Proxy :: Proxy api) req baseurl val
570+--
571+-- instance HasReflexClient api => HasReflexClient (IsSecure :> api) where
572+-- type Input (IsSecure :> api) = Input api
573+-- type Client (IsSecure :> api) = Client api
574+--
575+-- clientWithRoute Proxy req baseurl val =
576+-- clientWithRoute (Proxy :: Proxy api) req baseurl val