eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

make BaseUrl an argument to 'client' instead of each function produced by 'client'

Browse source 
Headers for all

Remove Canonicalize
This commit is contained in:
Alp Mestanogullari 2015-04-24 17:51:30 +02:00 committed by Brandon Martin
parent 95abfc4090
commit 8f100a14e8
4 changed files with 142 additions and 88 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

203
servant-client/src/Servant/Client.hs
View file

@ -36,6 +36,8 @@ import Network.HTTP.Media
import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types as H
import qualified Network.HTTP.Types.Header as HTTP import qualified Network.HTTP.Types.Header as HTTP
import Servant.API import Servant.API
import Servant.API.ResponseHeaders
import Servant.API.ContentTypes
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
import Servant.Common.Req import Servant.Common.Req
@ -62,6 +64,7 @@ class HasClient layout where
type Client layout :: * type Client layout :: *
clientWithRoute :: Proxy layout -> Req -> Client layout clientWithRoute :: Proxy layout -> Req -> Client layout
type Client layout = Client' layout
-- | A client querying function for @a ':<|>' b@ will actually hand you -- | A client querying function for @a ':<|>' b@ will actually hand you
-- one function for querying @a@ and another one for querying @b@, -- one function for querying @a@ and another one for querying @b@,
@ -107,9 +110,10 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)
type Client (Capture capture a :> sublayout) = type Client (Capture capture a :> sublayout) =
a -> Client sublayout a -> Client sublayout
clientWithRoute Proxy req val = clientWithRoute Proxy req baseurl val =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
appendToPath p req (appendToPath p req)
baseurl
where p = unpack (toText val) where p = unpack (toText val)
@ -122,9 +126,9 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where (MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where
type Client (Delete (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client (Delete (ct ': cts) a) = EitherT ServantError IO a
clientWithRoute Proxy req host = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] host snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
-- | If you have a 'Delete xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Delete xs ()' endpoint, the client expects a 204 No Content
-- HTTP header. -- HTTP header.
@ -133,9 +137,9 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Delete (ct ': cts) ()) where HasClient (Delete (ct ': cts) ()) where
type Client (Delete (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client (Delete (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodDelete req [204] host void $ performRequestNoBody H.methodDelete req [204] baseurl
-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the -- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
-- corresponding headers. -- corresponding headers.
@ -145,14 +149,13 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Delete (ct ': cts) (Headers ls a)) where ) => HasClient (Delete (ct ': cts) (Headers ls a)) where
type Client (Delete (ct ': cts) (Headers ls a)) = BaseUrl -> EitherT ServantError IO (Headers ls a) type Client (Delete (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req host = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] host (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
, getHeadersHList = buildHeadersTo hdrs , getHeadersHList = buildHeadersTo hdrs
} }
-- | If you have a 'Get' endpoint in your API, the client -- | If you have a 'Get' endpoint in your API, the client
-- side querying function that is created when calling 'client' -- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
@ -162,9 +165,9 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
type Client (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result type Client (Get (ct ': cts) result) = EitherT ServantError IO result
clientWithRoute Proxy req host = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] host snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl
-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content
-- HTTP status. -- HTTP status.
@ -173,9 +176,9 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Get (ct ': cts) ()) where HasClient (Get (ct ': cts) ()) where
type Client (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client (Get (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req baseurl =
performRequestNoBody H.methodGet req [204] host performRequestNoBody H.methodGet req [204] baseurl
-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the -- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
-- corresponding headers. -- corresponding headers.
@ -185,9 +188,9 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Get (ct ': cts) (Headers ls a)) where ) => HasClient (Get (ct ': cts) (Headers ls a)) where
type Client (Get (ct ': cts) (Headers ls a)) = BaseUrl -> EitherT ServantError IO (Headers ls a) type Client (Get (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req host = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] host (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
, getHeadersHList = buildHeadersTo hdrs , getHeadersHList = buildHeadersTo hdrs
} }
@ -223,9 +226,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
type Client (Header sym a :> sublayout) = type Client (Header sym a :> sublayout) =
Maybe a -> Client sublayout Maybe a -> Client sublayout
clientWithRoute Proxy req mval = clientWithRoute Proxy req baseurl mval =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval (maybe req
(\value -> Servant.Common.Req.addHeader hname value req)
mval
)
baseurl
where hname = symbolVal (Proxy :: Proxy sym) where hname = symbolVal (Proxy :: Proxy sym)
@ -238,10 +245,9 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
type Client (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client (Post (ct ': cts) a) = EitherT ServantError IO a
clientWithRoute Proxy req baseurl =
clientWithRoute Proxy req uri = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] uri
-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content
-- HTTP header. -- HTTP header.
@ -250,9 +256,9 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Post (ct ': cts) ()) where HasClient (Post (ct ': cts) ()) where
type Client (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client (Post (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPost req [204] host void $ performRequestNoBody H.methodPost req [204] baseurl
-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the -- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
-- corresponding headers. -- corresponding headers.
@ -262,9 +268,9 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Post (ct ': cts) (Headers ls a)) where ) => HasClient (Post (ct ': cts) (Headers ls a)) where
type Client (Post (ct ': cts) (Headers ls a)) = BaseUrl -> EitherT ServantError IO (Headers ls a) type Client (Post (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req host = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] host (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
, getHeadersHList = buildHeadersTo hdrs , getHeadersHList = buildHeadersTo hdrs
} }
@ -278,10 +284,9 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
type Client (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client (Put (ct ': cts) a) = EitherT ServantError IO a
clientWithRoute Proxy req baseurl =
clientWithRoute Proxy req host = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] host
-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content
-- HTTP header. -- HTTP header.
@ -290,9 +295,9 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Put (ct ': cts) ()) where HasClient (Put (ct ': cts) ()) where
type Client (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client (Put (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPut req [204] host void $ performRequestNoBody H.methodPut req [204] baseurl
-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the -- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
-- corresponding headers. -- corresponding headers.
@ -302,9 +307,9 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Put (ct ': cts) (Headers ls a)) where ) => HasClient (Put (ct ': cts) (Headers ls a)) where
type Client (Put (ct ': cts) (Headers ls a)) = BaseUrl -> EitherT ServantError IO (Headers ls a) type Client (Put (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req host = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] host (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
, getHeadersHList = buildHeadersTo hdrs , getHeadersHList = buildHeadersTo hdrs
} }
@ -318,10 +323,9 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
type Client (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client (Patch (ct ': cts) a) = EitherT ServantError IO a
clientWithRoute Proxy req baseurl =
clientWithRoute Proxy req host = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] host
-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content
-- HTTP header. -- HTTP header.
@ -330,9 +334,9 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Patch (ct ': cts) ()) where HasClient (Patch (ct ': cts) ()) where
type Client (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client (Patch (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPatch req [204] host void $ performRequestNoBody H.methodPatch req [204] baseurl
-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the -- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
-- corresponding headers. -- corresponding headers.
@ -342,9 +346,9 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Patch (ct ': cts) (Headers ls a)) where ) => HasClient (Patch (ct ': cts) (Headers ls a)) where
type Client (Patch (ct ': cts) (Headers ls a)) = BaseUrl -> EitherT ServantError IO (Headers ls a) type Client (Patch (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req host = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] host (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
, getHeadersHList = buildHeadersTo hdrs , getHeadersHList = buildHeadersTo hdrs
} }
@ -381,9 +385,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
Maybe a -> Client sublayout Maybe a -> Client sublayout
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string
clientWithRoute Proxy req mparam = clientWithRoute Proxy req baseurl mparam =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
maybe req (flip (appendToQueryString pname) req . Just) mparamText (maybe req
(flip (appendToQueryString pname) req . Just)
mparamText
)
baseurl
where pname = cs pname' where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym) pname' = symbolVal (Proxy :: Proxy sym)
@ -422,9 +430,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
type Client (QueryParams sym a :> sublayout) = type Client (QueryParams sym a :> sublayout) =
[a] -> Client sublayout [a] -> Client sublayout
clientWithRoute Proxy req paramlist = clientWithRoute Proxy req baseurl paramlist =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just)) req paramlist' (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
req
paramlist'
)
baseurl
where pname = cs pname' where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym) pname' = symbolVal (Proxy :: Proxy sym)
@ -457,11 +469,13 @@ instance (KnownSymbol sym, HasClient sublayout)
type Client (QueryFlag sym :> sublayout) = type Client (QueryFlag sym :> sublayout) =
Bool -> Client sublayout Bool -> Client sublayout
clientWithRoute Proxy req flag = clientWithRoute Proxy req baseurl flag =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
if flag (if flag
then appendToQueryString paramname Nothing req then appendToQueryString paramname Nothing req
else req else req
)
baseurl
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
@ -497,9 +511,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
Maybe a -> Client sublayout Maybe a -> Client sublayout
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string
clientWithRoute Proxy req mparam = clientWithRoute Proxy req baseurl mparam =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
maybe req (flip (appendToMatrixParams pname . Just) req) mparamText (maybe req
(flip (appendToMatrixParams pname . Just) req)
mparamText
)
baseurl
where pname = symbolVal (Proxy :: Proxy sym) where pname = symbolVal (Proxy :: Proxy sym)
mparamText = fmap (cs . toText) mparam mparamText = fmap (cs . toText) mparam
@ -537,9 +555,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
type Client (MatrixParams sym a :> sublayout) = type Client (MatrixParams sym a :> sublayout) =
[a] -> Client sublayout [a] -> Client sublayout
clientWithRoute Proxy req paramlist = clientWithRoute Proxy req baseurl paramlist =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
foldl' (\ req' value -> maybe req' (flip (appendToMatrixParams pname) req' . Just . cs) value) req paramlist' (foldl' (\ req' value -> maybe req' (flip (appendToMatrixParams pname) req' . Just . cs) value)
req
paramlist'
)
baseurl
where pname = cs pname' where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym) pname' = symbolVal (Proxy :: Proxy sym)
@ -572,22 +594,24 @@ instance (KnownSymbol sym, HasClient sublayout)
type Client (MatrixFlag sym :> sublayout) = type Client (MatrixFlag sym :> sublayout) =
Bool -> Client sublayout Bool -> Client sublayout
clientWithRoute Proxy req flag = clientWithRoute Proxy req baseurl flag =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
if flag (if flag
then appendToMatrixParams paramname Nothing req then appendToMatrixParams paramname Nothing req
else req else req
)
baseurl
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
-- | Pick a 'Method' and specify where the server you want to query is. You get -- | Pick a 'Method' and specify where the server you want to query is. You get
-- back the full `Response`. -- back the full `Response`.
instance HasClient Raw where instance HasClient Raw where
type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) type Client Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
clientWithRoute :: Proxy Raw -> Req -> Client Raw clientWithRoute :: Proxy Raw -> Req -> Client Raw
clientWithRoute Proxy req httpMethod host = do clientWithRoute Proxy req httpMethod baseurl = do
performRequest httpMethod req (const True) host performRequest httpMethod req (const True) baseurl
-- | If you use a 'ReqBody' in one of your endpoints in your API, -- | If you use a 'ReqBody' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -613,18 +637,23 @@ instance (MimeRender ct a, HasClient sublayout)
type Client (ReqBody (ct ': cts) a :> sublayout) = type Client (ReqBody (ct ': cts) a :> sublayout) =
a -> Client sublayout a -> Client sublayout
clientWithRoute Proxy req body = clientWithRoute Proxy req baseurl body =
clientWithRoute (Proxy :: Proxy sublayout) $ do clientWithRoute (Proxy :: Proxy sublayout)
let ctProxy = Proxy :: Proxy ct (let ctProxy = Proxy :: Proxy ct
setRQBody (mimeRender ctProxy body) (contentType ctProxy) req in setRQBody (mimeRender ctProxy body)
(contentType ctProxy)
req
)
baseurl
-- | Make the querying function append @path@ to the request path. -- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
type Client (path :> sublayout) = Client sublayout type Client (path :> sublayout) = Client sublayout
clientWithRoute Proxy req = clientWithRoute Proxy req baseurl =
clientWithRoute (Proxy :: Proxy sublayout) $ clientWithRoute (Proxy :: Proxy sublayout)
appendToPath p req (appendToPath p req)
baseurl
where p = symbolVal (Proxy :: Proxy path) where p = symbolVal (Proxy :: Proxy path)

1
servant-docs/example/greet.hs
View file

@ -8,6 +8,7 @@
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Proxy import Data.Proxy
import Data.ByteString.Conversion
import Data.String.Conversions import Data.String.Conversions
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics import GHC.Generics

26
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -40,6 +40,7 @@ import GHC.Generics
import GHC.TypeLits import GHC.TypeLits
import Servant.API import Servant.API
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Servant.API.ResponseHeaders
import Servant.Utils.Links import Servant.Utils.Links
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
@ -395,7 +396,6 @@ instance ToSample a b => ToSample (Headers ls a) b where
toSample _ = toSample (Proxy :: Proxy a) toSample _ = toSample (Proxy :: Proxy a)
toSamples _ = toSamples (Proxy :: Proxy a) toSamples _ = toSamples (Proxy :: Proxy a)
class AllHeaderSamples ls where class AllHeaderSamples ls where
allHeaderToSample :: Proxy ls -> [HTTP.Header] allHeaderToSample :: Proxy ls -> [HTTP.Header]
@ -684,11 +684,15 @@ instance
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLe #-} {-# OVERLAPPABLe #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
=======
instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
>>>>>>> Headers for all
=> HasDocs (Get cts a) where => HasDocs (Get cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
@ -699,11 +703,15 @@ instance
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
=======
instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
>>>>>>> Headers for all
, AllHeaderSamples ls , GetHeaders (HList ls) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Get cts (Headers ls a)) where => HasDocs (Get cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
@ -726,11 +734,15 @@ instance (KnownSymbol sym, HasDocs sublayout)
action' = over headers (|> headername) action action' = over headers (|> headername) action
headername = pack $ symbolVal (Proxy :: Proxy sym) headername = pack $ symbolVal (Proxy :: Proxy sym)
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
=======
instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
>>>>>>> Headers for all
=> HasDocs (Post cts a) where => HasDocs (Post cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
@ -742,11 +754,15 @@ instance
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
=======
instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
>>>>>>> Headers for all
, AllHeaderSamples ls , GetHeaders (HList ls) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Post cts (Headers ls a)) where => HasDocs (Post cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
@ -761,11 +777,15 @@ instance
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
=======
instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
>>>>>>> Headers for all
=> HasDocs (Put cts a) where => HasDocs (Put cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
@ -777,11 +797,15 @@ instance
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
=======
instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
>>>>>>> Headers for all
, AllHeaderSamples ls , GetHeaders (HList ls) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Put cts (Headers ls a)) where => HasDocs (Put cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =

BIN
servant/Setup Executable file
View file

Binary file not shown.