Added HasClient and HasForeign instances for NoContentVerb
This commit is contained in:
parent
0ec5af11f5
commit
0cbed24f23
3 changed files with 30 additions and 4 deletions
|
@ -50,8 +50,9 @@ import Servant.API
|
||||||
MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
|
MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
|
||||||
QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
|
QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
|
||||||
ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,
|
ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,
|
||||||
ToSourceIO (..), Vault, Verb, WithNamedContext, contentType,
|
ToSourceIO (..), Vault, Verb, NoContentVerb, WithNamedContext,
|
||||||
getHeadersHList, getResponse, toQueryParam, toUrlPiece)
|
contentType, getHeadersHList, getResponse, toQueryParam,
|
||||||
|
toUrlPiece)
|
||||||
import Servant.API.ContentTypes
|
import Servant.API.ContentTypes
|
||||||
(contentTypes)
|
(contentTypes)
|
||||||
import Servant.API.Modifiers
|
import Servant.API.Modifiers
|
||||||
|
@ -241,6 +242,18 @@ instance {-# OVERLAPPING #-}
|
||||||
|
|
||||||
hoistClientMonad _ _ f ma = f ma
|
hoistClientMonad _ _ f ma = f ma
|
||||||
|
|
||||||
|
instance {-# OVERLAPPING #-}
|
||||||
|
( RunClient m, ReflectMethod method
|
||||||
|
) => HasClient m (NoContentVerb method) where
|
||||||
|
type Client m (NoContentVerb method)
|
||||||
|
= m NoContent
|
||||||
|
clientWithRoute _pm Proxy req = do
|
||||||
|
_response <- runRequest req { requestMethod = method }
|
||||||
|
return NoContent
|
||||||
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
|
|
||||||
|
hoistClientMonad _ _ f ma = f ma
|
||||||
|
|
||||||
instance {-# OVERLAPPING #-}
|
instance {-# OVERLAPPING #-}
|
||||||
-- Note [Non-Empty Content Types]
|
-- Note [Non-Empty Content Types]
|
||||||
( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
|
( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
|
||||||
|
|
|
@ -85,7 +85,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
|
||||||
type Api =
|
type Api =
|
||||||
Get '[JSON] Person
|
Get '[JSON] Person
|
||||||
:<|> "get" :> Get '[JSON] Person
|
:<|> "get" :> Get '[JSON] Person
|
||||||
:<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent
|
:<|> "deleteEmpty" :> DeleteNoContent
|
||||||
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
|
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
|
||||||
:<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
|
:<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
|
||||||
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
|
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
|
||||||
|
@ -101,7 +101,7 @@ type Api =
|
||||||
ReqBody '[JSON] [(String, [Rational])] :>
|
ReqBody '[JSON] [(String, [Rational])] :>
|
||||||
Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
|
Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
|
||||||
:<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)
|
:<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)
|
||||||
:<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent
|
:<|> "deleteContentType" :> DeleteNoContent
|
||||||
:<|> "redirectWithCookie" :> Raw
|
:<|> "redirectWithCookie" :> Raw
|
||||||
:<|> "empty" :> EmptyAPI
|
:<|> "empty" :> EmptyAPI
|
||||||
|
|
||||||
|
|
|
@ -244,6 +244,19 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
|
||||||
method = reflectMethod (Proxy :: Proxy method)
|
method = reflectMethod (Proxy :: Proxy method)
|
||||||
methodLC = toLower $ decodeUtf8 method
|
methodLC = toLower $ decodeUtf8 method
|
||||||
|
|
||||||
|
instance (HasForeignType lang ftype NoContent, ReflectMethod method)
|
||||||
|
=> HasForeign lang ftype (NoContentVerb method) where
|
||||||
|
type Foreign ftype (NoContentVerb method) = Req ftype
|
||||||
|
|
||||||
|
foreignFor lang Proxy Proxy req =
|
||||||
|
req & reqFuncName . _FunctionName %~ (methodLC :)
|
||||||
|
& reqMethod .~ method
|
||||||
|
& reqReturnType .~ Just retType
|
||||||
|
where
|
||||||
|
retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy NoContent)
|
||||||
|
method = reflectMethod (Proxy :: Proxy method)
|
||||||
|
methodLC = toLower $ decodeUtf8 method
|
||||||
|
|
||||||
-- | TODO: doesn't taking framing into account.
|
-- | TODO: doesn't taking framing into account.
|
||||||
instance (ct ~ JSON, HasForeignType lang ftype a, ReflectMethod method)
|
instance (ct ~ JSON, HasForeignType lang ftype a, ReflectMethod method)
|
||||||
=> HasForeign lang ftype (Stream method status framing ct a) where
|
=> HasForeign lang ftype (Stream method status framing ct a) where
|
||||||
|
|
Loading…
Reference in a new issue