Safe Haskell | None |
---|---|
Language | Haskell2010 |
Servant.API.MultiVerb
Description
MultiVerb is a part of the type-level eDSL that allows you to express complex routes while retaining a high level of precision with good ergonomics.
Synopsis
- data MultiVerb (method :: StdMethod) (requestMimeTypes :: k) (as :: [Type]) responses
- type MultiVerb1 (method :: StdMethod) (requestMimeTypes :: k) a = MultiVerb method requestMimeTypes '[a] (ResponseType a)
- data Respond (s :: Nat) (description :: Symbol) a
- data RespondAs (responseContentType :: k) (s :: Nat) (description :: Symbol) a
- type RespondEmpty (s :: Nat) (description :: Symbol) = RespondAs '() s description ()
- data RespondStreaming (s :: Nat) (description :: Symbol) framing ct
- data WithHeaders (headers :: [Type]) returnType response
- data DescHeader (name :: Symbol) (description :: Symbol) a
- data OptHeader (h :: k)
- class AsHeaders (headers :: [Type]) response returnType where
- class ServantHeaders (headers :: k) (xs :: [Type]) | headers -> xs where
- constructHeaders :: NP I xs -> [Header]
- extractHeaders :: Seq Header -> Maybe (NP I xs)
- class ServantHeader (h :: k) (name :: Symbol) x | h -> name x where
- constructHeader :: x -> [Header]
- class AsUnion (as :: [Type]) r where
- toUnion :: r -> Union (ResponseTypes as)
- fromUnion :: Union (ResponseTypes as) -> r
- eitherToUnion :: forall (as :: [Type]) (bs :: [Type]) a b. (InjectAfter as bs, InjectBefore as bs) => (a -> Union as) -> (b -> Union bs) -> Either a b -> Union (as .++ bs)
- eitherFromUnion :: EitherFromUnion as bs => (Union as -> a) -> (Union bs -> b) -> Union (as .++ bs) -> Either a b
- maybeToUnion :: forall (as :: [Type]) a. (InjectAfter as '[()], InjectBefore as '[()]) => (a -> Union as) -> Maybe a -> Union (as .++ '[()])
- maybeFromUnion :: forall (as :: [Type]) a. EitherFromUnion as '[()] => (Union as -> a) -> Union (as .++ '[()]) -> Maybe a
- class AsConstructor (xs :: [Type]) r where
- toConstructor :: ResponseType r -> NP I xs
- fromConstructor :: NP I xs -> ResponseType r
- newtype GenericAsConstructor r = GenericAsConstructor r
- newtype GenericAsUnion (rs :: k) a = GenericAsUnion a
- type family ResponseType a
- type family ResponseTypes (as :: [Type]) :: [Type] where ...
- data UnrenderResult a
MultiVerb types
data MultiVerb (method :: StdMethod) (requestMimeTypes :: k) (as :: [Type]) responses Source #
MultiVerb
produces an endpoint which can return
multiple values with various content types and status codes. It is similar to
UVerb
and behaves similarly, but it has some important differences:
- Descriptions and statuses can be attached to individual responses without using wrapper types and without affecting the handler return type.
- The return type of the handler can be decoupled from the types of the
individual responses. One can use a
Union
type just like forUVerb
, butMultiVerb
also supports using an arbitrary type with anAsUnion
instance. Each response is responsible for their content type. - Headers can be attached to individual responses, also without affecting the handler return type.
Example
Let us create an endpoint that captures an Int
and has the following logic:
- If the number is negative, we return status code 400 and an empty body;
- If the number is even, we return a
Bool
in the response body; - If the number is odd, we return another
Int
in the response body.
import qualified Generics.SOP as GSOP
-- All possible HTTP responses type Responses = '[ type RespondEmpty 400 "Negative" , type Respond 200 "Even number" Bool , type Respond 200 "Odd number" Int ] -- All possible return types data Result = NegativeNumber | Odd Int | Even Bool deriving stock (Generic) deriving (AsUnion Responses) via GenericAsUnion Responses Result instance GSOP.Generic Result
These deriving statements above tie together the responses and the return values, and the order in which they are defined matters. For instance, if Even
and Odd
had switched places in the definition of Result
, this would provoke an error:
• No instance for ‘AsConstructor ((:) @Type Int ('[] @Type)) (Respond 200 "Even number" Bool)’ arising from the 'deriving' clause of a data type declaration
If you would prefer to write an intance of AsUnion
by yourself, read more in the typeclass' documentation.
Finally, let us write our endpoint description:
type MultipleChoicesInt = Capture "int" Int :> MultiVerb 'GET '[JSON] Responses Result
type MultiVerb1 (method :: StdMethod) (requestMimeTypes :: k) a = MultiVerb method requestMimeTypes '[a] (ResponseType a) Source #
A MultiVerb
endpoint with a single response. Ideal to ensure that there can only be one response.
Response types
data Respond (s :: Nat) (description :: Symbol) a Source #
A type to describe a MultiVerb
response.
Includes status code, description, and return type. The content type of the
response is determined dynamically using the accept header and the list of
supported content types specified in the containing MultiVerb
type.
Instances
AsConstructor '[a] (Respond code description a) Source # | |
Defined in Servant.API.MultiVerb Methods toConstructor :: ResponseType (Respond code description a) -> NP I '[a] Source # fromConstructor :: NP I '[a] -> ResponseType (Respond code description a) Source # | |
type ResponseType (Respond s description a) Source # | |
Defined in Servant.API.MultiVerb |
data RespondAs (responseContentType :: k) (s :: Nat) (description :: Symbol) a Source #
A type to describe a MultiVerb
response with a fixed content type.
Similar to Respond
, but hardcodes the content type to be used for
generating the response. This content type is distinct from the one
given to MultiVerb
, as it dictactes the response's content type, not the
content type request that is to be accepted.
Instances
AsConstructor ('[] :: [Type]) (RespondEmpty code description) Source # | |
Defined in Servant.API.MultiVerb Methods toConstructor :: ResponseType (RespondEmpty code description) -> NP I ('[] :: [Type]) Source # fromConstructor :: NP I ('[] :: [Type]) -> ResponseType (RespondEmpty code description) Source # | |
AsUnion '[RespondEmpty s1 desc1, RespondEmpty s2 desc2] Bool Source # | A handler for a pair of empty responses can be implemented simply by
returning a boolean value. The convention is that the "failure" case, normally
represented by |
Defined in Servant.API.MultiVerb Methods toUnion :: Bool -> Union (ResponseTypes '[RespondEmpty s1 desc1, RespondEmpty s2 desc2]) Source # fromUnion :: Union (ResponseTypes '[RespondEmpty s1 desc1, RespondEmpty s2 desc2]) -> Bool Source # | |
AsConstructor '[a] (RespondAs responseContentTypes code description a) Source # | |
Defined in Servant.API.MultiVerb Methods toConstructor :: ResponseType (RespondAs responseContentTypes code description a) -> NP I '[a] Source # fromConstructor :: NP I '[a] -> ResponseType (RespondAs responseContentTypes code description a) Source # | |
type ResponseType (RespondAs responseContentType s description a) Source # | |
Defined in Servant.API.MultiVerb |
type RespondEmpty (s :: Nat) (description :: Symbol) = RespondAs '() s description () Source #
A type to describe a MultiVerb
response with an empty body.
Includes status code and description.
data RespondStreaming (s :: Nat) (description :: Symbol) framing ct Source #
A type to describe a streaming MultiVerb
response.
Includes status code, description, framing strategy and content type. Note that the handler return type is hardcoded to be 'SourceIO ByteString'.
Instances
type ResponseType (RespondStreaming s description framing ct) Source # | |
Defined in Servant.API.MultiVerb |
Headers
data WithHeaders (headers :: [Type]) returnType response Source #
This type adds response headers to a MultiVerb
response.
Instances
AsConstructor '[a] (WithHeaders headers a response) Source # | |
Defined in Servant.API.MultiVerb Methods toConstructor :: ResponseType (WithHeaders headers a response) -> NP I '[a] Source # fromConstructor :: NP I '[a] -> ResponseType (WithHeaders headers a response) Source # | |
type ResponseType (WithHeaders headers returnType response) Source # | |
Defined in Servant.API.MultiVerb |
data DescHeader (name :: Symbol) (description :: Symbol) a Source #
Instances
(KnownSymbol name, ToHttpApiData x) => ServantHeader (DescHeader name description x :: Type) name x Source # | |
Defined in Servant.API.MultiVerb Methods constructHeader :: x -> [Header] Source # |
data OptHeader (h :: k) Source #
A wrapper to turn a response header into an optional one.
Instances
ServantHeader h name x => ServantHeader (OptHeader h :: Type) name (Maybe x) Source # | |
Defined in Servant.API.MultiVerb Methods constructHeader :: Maybe x -> [Header] Source # |
class AsHeaders (headers :: [Type]) response returnType where Source #
This is used to convert a response containing headers to a custom type including the information in the headers.
If you need to send a combination of headers and response that is not provided by Servant, you can cwrite your own instance. Take example on the ones provided.
Methods
fromHeaders :: (NP I headers, response) -> returnType Source #
toHeaders :: returnType -> (NP I headers, response) Source #
Instances
AsHeaders '[a] () a Source # | Single-header empty response |
AsHeaders '[a, b] () (a, b) Source # | Two headers and an empty response, return value is a tuple of the response and the header |
AsHeaders '[h] a (a, h) Source # | Single-header non-empty response, return value is a tuple of the response and the header |
class ServantHeaders (headers :: k) (xs :: [Type]) | headers -> xs where Source #
Instances
ServantHeaders ('[] :: [a]) ('[] :: [Type]) Source # | |
(KnownSymbol name, ServantHeader h name x, FromHttpApiData x, ServantHeaders headers xs) => ServantHeaders (h ': headers :: [a]) (x ': xs) Source # | |
Defined in Servant.API.MultiVerb |
class ServantHeader (h :: k) (name :: Symbol) x | h -> name x where Source #
Methods
constructHeader :: x -> [Header] Source #
Instances
ServantHeader h name x => ServantHeader (OptHeader h :: Type) name (Maybe x) Source # | |
Defined in Servant.API.MultiVerb Methods constructHeader :: Maybe x -> [Header] Source # | |
(KnownSymbol name, ToHttpApiData x) => ServantHeader (Header' mods name x :: Type) name x Source # | |
Defined in Servant.API.MultiVerb Methods constructHeader :: x -> [Header] Source # | |
(KnownSymbol name, ToHttpApiData x) => ServantHeader (DescHeader name description x :: Type) name x Source # | |
Defined in Servant.API.MultiVerb Methods constructHeader :: x -> [Header] Source # |
Unions of responses
class AsUnion (as :: [Type]) r where Source #
This class is used to convert a handler return type to a union type
including all possible responses of a MultiVerb
endpoint.
Any glue code necessary to convert application types to and from the
canonical Union
type corresponding to a MultiVerb
endpoint should be
packaged into an AsUnion
instance.
Example
Let us take the example endpoint from the MultiVerb
documentation.
There, we derived the AsUnion
instance with the help of Generics.
The manual way of implementing the instance is:
instance AsUnion Responses Result where toUnion NegativeNumber = Z (I ()) toUnion (Even b) = S (Z (I b)) toUnion (Odd i) = S (S (Z (I i))) fromUnion (Z (I ())) = NegativeNumber fromUnion (S (Z (I b))) = Even b fromUnion (S (S (Z (I i)))) = Odd i fromUnion (S (S (S x))) = case x of {}
The last fromUnion
equation is here to please the pattern checker.
Methods
toUnion :: r -> Union (ResponseTypes as) Source #
fromUnion :: Union (ResponseTypes as) -> r Source #
Instances
rs ~ ResponseTypes as => AsUnion as (Union rs) Source # | Unions can be used directly as handler return types using this trivial instance. |
Defined in Servant.API.MultiVerb | |
(Code a ~ xss, Generic a, AsConstructors xss rs) => AsUnion rs (GenericAsUnion rs a) Source # | |
Defined in Servant.API.MultiVerb Methods toUnion :: GenericAsUnion rs a -> Union (ResponseTypes rs) Source # fromUnion :: Union (ResponseTypes rs) -> GenericAsUnion rs a Source # | |
AsUnion '[RespondEmpty s1 desc1, RespondEmpty s2 desc2] Bool Source # | A handler for a pair of empty responses can be implemented simply by
returning a boolean value. The convention is that the "failure" case, normally
represented by |
Defined in Servant.API.MultiVerb Methods toUnion :: Bool -> Union (ResponseTypes '[RespondEmpty s1 desc1, RespondEmpty s2 desc2]) Source # fromUnion :: Union (ResponseTypes '[RespondEmpty s1 desc1, RespondEmpty s2 desc2]) -> Bool Source # | |
ResponseType r ~ a => AsUnion '[r] a Source # | A handler with a single response. |
Defined in Servant.API.MultiVerb Methods toUnion :: a -> Union (ResponseTypes '[r]) Source # fromUnion :: Union (ResponseTypes '[r]) -> a Source # | |
(ResponseType r1 ~ (), ResponseType r2 ~ a) => AsUnion '[r1, r2] (Maybe a) Source # | A handler for a pair of responses where the first is empty can be
implemented simply by returning a |
Defined in Servant.API.MultiVerb |
eitherToUnion :: forall (as :: [Type]) (bs :: [Type]) a b. (InjectAfter as bs, InjectBefore as bs) => (a -> Union as) -> (b -> Union bs) -> Either a b -> Union (as .++ bs) Source #
eitherFromUnion :: EitherFromUnion as bs => (Union as -> a) -> (Union bs -> b) -> Union (as .++ bs) -> Either a b Source #
maybeToUnion :: forall (as :: [Type]) a. (InjectAfter as '[()], InjectBefore as '[()]) => (a -> Union as) -> Maybe a -> Union (as .++ '[()]) Source #
maybeFromUnion :: forall (as :: [Type]) a. EitherFromUnion as '[()] => (Union as -> a) -> Union (as .++ '[()]) -> Maybe a Source #
Internal machinery
class AsConstructor (xs :: [Type]) r where Source #
This class can be instantiated to get automatic derivation of AsUnion
instances via GenericAsUnion
. The idea is that one has to make sure that for
each response r
in a MultiVerb
endpoint, there is an instance of
AsConstructor xs r
for some xs
, and that the list xss
of all the
corresponding xs
is equal to Code
of the handler type. Then one can
write:
@
type Responses = ...
data Result = ...
deriving stock (Generic)
deriving (AsUnion Responses) via (GenericAsUnion Responses Result)
instance GSOP.Generic Result
@
and get an AsUnion
instance for free.
There are a few predefined instances for constructors taking a single type
corresponding to a simple response, and for empty responses, but in more
general cases one either has to define an AsConstructor
instance by hand,
or derive it via GenericAsConstructor
.
Methods
toConstructor :: ResponseType r -> NP I xs Source #
fromConstructor :: NP I xs -> ResponseType r Source #
Instances
newtype GenericAsConstructor r Source #
Constructors
GenericAsConstructor r |
Instances
(Code (ResponseType r) ~ '[xs], Generic (ResponseType r)) => AsConstructor xs (GenericAsConstructor r) Source # | |
Defined in Servant.API.MultiVerb Methods toConstructor :: ResponseType (GenericAsConstructor r) -> NP I xs Source # fromConstructor :: NP I xs -> ResponseType (GenericAsConstructor r) Source # | |
type ResponseType (GenericAsConstructor r) Source # | |
Defined in Servant.API.MultiVerb |
newtype GenericAsUnion (rs :: k) a Source #
This type is meant to be used with deriving via
in order to automatically
generate an AsUnion
instance using SOP
.
See AsConstructor
for more information and examples.
Constructors
GenericAsUnion a |
Instances
(Code a ~ xss, Generic a, AsConstructors xss rs) => AsUnion rs (GenericAsUnion rs a) Source # | |
Defined in Servant.API.MultiVerb Methods toUnion :: GenericAsUnion rs a -> Union (ResponseTypes rs) Source # fromUnion :: Union (ResponseTypes rs) -> GenericAsUnion rs a Source # |
type family ResponseType a Source #
Instances
type ResponseType (GenericAsConstructor r) Source # | |
Defined in Servant.API.MultiVerb | |
type ResponseType (Respond s description a) Source # | |
Defined in Servant.API.MultiVerb | |
type ResponseType (WithHeaders headers returnType response) Source # | |
Defined in Servant.API.MultiVerb | |
type ResponseType (RespondStreaming s description framing ct) Source # | |
Defined in Servant.API.MultiVerb | |
type ResponseType (RespondAs responseContentType s description a) Source # | |
Defined in Servant.API.MultiVerb |
type family ResponseTypes (as :: [Type]) :: [Type] where ... Source #
Equations
ResponseTypes ('[] :: [Type]) = '[] :: [Type] | |
ResponseTypes (a ': as) = ResponseType a ': ResponseTypes as |
data UnrenderResult a Source #
The result of parsing a response as a union alternative of type a
.
StatusMismatch
indicates that the response does not refer to the given
alternative, because the status code does not match the one produced by that
alternative.
UnrenderError
and UnrenderSuccess
represent respectively a failing and
successful parse of the response body as a value of type a
.
The UnrenderResult
type constructor has monad and alternative instances
corresponding to those of 'Either (Maybe (Last String)) a'.
Constructors
StatusMismatch | |
UnrenderError String | |
UnrenderSuccess a |