servant-0.20.3.0: A family of combinators for defining webservices APIs
Safe HaskellNone
LanguageHaskell2010

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

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 for UVerb, but MultiVerb also supports using an arbitrary type with an AsUnion instance. Each response is responsible for their content type.
  • Headers can be attached to individual responses, also without affecting the handler return type.

Example

Expand

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

Instances

Instances details
HasLink (MultiVerb method cs as r :: Type) Source # 
Instance details

Defined in Servant.Links

Methods

toLink :: (Link -> a) -> Proxy (MultiVerb method cs as r) -> Link -> MkLink (MultiVerb method cs as r) a Source #

type MkLink (MultiVerb method cs as r :: Type) a Source # 
Instance details

Defined in Servant.Links

type MkLink (MultiVerb method cs as r :: Type) a = a

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

Instances details
AsConstructor '[a] (Respond code description a) Source # 
Instance details

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 # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (Respond s description a) = a

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

Instances details
AsConstructor ('[] :: [Type]) (RespondEmpty code description) Source # 
Instance details

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 False, corresponds to the first response.

Instance details

Defined in Servant.API.MultiVerb

AsConstructor '[a] (RespondAs responseContentTypes code description a) Source # 
Instance details

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 # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (RespondAs responseContentType s description a) = a

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

Instances details
type ResponseType (RespondStreaming s description framing ct) Source # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (RespondStreaming s description framing ct) = SourceIO ByteString

Headers

data WithHeaders (headers :: [Type]) returnType response Source #

This type adds response headers to a MultiVerb response.

Instances

Instances details
AsConstructor '[a] (WithHeaders headers a response) Source # 
Instance details

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 # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (WithHeaders headers returnType response) = returnType

data DescHeader (name :: Symbol) (description :: Symbol) a Source #

Instances

Instances details
(KnownSymbol name, ToHttpApiData x) => ServantHeader (DescHeader name description x :: Type) name x Source # 
Instance details

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

Instances details
ServantHeader h name x => ServantHeader (OptHeader h :: Type) name (Maybe x) Source # 
Instance details

Defined in Servant.API.MultiVerb

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

Instances details
AsHeaders '[a] () a Source #

Single-header empty response

Instance details

Defined in Servant.API.MultiVerb

Methods

fromHeaders :: (NP I '[a], ()) -> a Source #

toHeaders :: a -> (NP I '[a], ()) Source #

AsHeaders '[a, b] () (a, b) Source #

Two headers and an empty response, return value is a tuple of the response and the header

Instance details

Defined in Servant.API.MultiVerb

Methods

fromHeaders :: (NP I '[a, b], ()) -> (a, b) Source #

toHeaders :: (a, b) -> (NP I '[a, b], ()) Source #

AsHeaders '[h] a (a, h) Source #

Single-header non-empty response, return value is a tuple of the response and the header

Instance details

Defined in Servant.API.MultiVerb

Methods

fromHeaders :: (NP I '[h], a) -> (a, h) Source #

toHeaders :: (a, h) -> (NP I '[h], a) Source #

class ServantHeaders (headers :: k) (xs :: [Type]) | headers -> xs where Source #

Instances

Instances details
ServantHeaders ('[] :: [a]) ('[] :: [Type]) Source # 
Instance details

Defined in Servant.API.MultiVerb

Methods

constructHeaders :: NP I ('[] :: [Type]) -> [Header] Source #

extractHeaders :: Seq Header -> Maybe (NP I ('[] :: [Type])) Source #

(KnownSymbol name, ServantHeader h name x, FromHttpApiData x, ServantHeaders headers xs) => ServantHeaders (h ': headers :: [a]) (x ': xs) Source # 
Instance details

Defined in Servant.API.MultiVerb

Methods

constructHeaders :: NP I (x ': xs) -> [Header] Source #

extractHeaders :: Seq Header -> Maybe (NP I (x ': xs)) Source #

class ServantHeader (h :: k) (name :: Symbol) x | h -> name x where Source #

Methods

constructHeader :: x -> [Header] Source #

Instances

Instances details
ServantHeader h name x => ServantHeader (OptHeader h :: Type) name (Maybe x) Source # 
Instance details

Defined in Servant.API.MultiVerb

(KnownSymbol name, ToHttpApiData x) => ServantHeader (Header' mods name x :: Type) name x Source # 
Instance details

Defined in Servant.API.MultiVerb

Methods

constructHeader :: x -> [Header] Source #

(KnownSymbol name, ToHttpApiData x) => ServantHeader (DescHeader name description x :: Type) name x Source # 
Instance details

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

Expand

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.

Instances

Instances details
rs ~ ResponseTypes as => AsUnion as (Union rs) Source #

Unions can be used directly as handler return types using this trivial instance.

Instance details

Defined in Servant.API.MultiVerb

(Code a ~ xss, Generic a, AsConstructors xss rs) => AsUnion rs (GenericAsUnion rs a) Source # 
Instance details

Defined in Servant.API.MultiVerb

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 False, corresponds to the first response.

Instance details

Defined in Servant.API.MultiVerb

ResponseType r ~ a => AsUnion '[r] a Source #

A handler with a single response.

Instance details

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 Maybe value. The convention is that the "failure" case, normally represented by Nothing, corresponds to the first response.

Instance details

Defined in Servant.API.MultiVerb

Methods

toUnion :: Maybe a -> Union (ResponseTypes '[r1, r2]) Source #

fromUnion :: Union (ResponseTypes '[r1, r2]) -> Maybe a Source #

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.

Instances

Instances details
(Code (ResponseType r) ~ '[xs], Generic (ResponseType r)) => AsConstructor xs (GenericAsConstructor r) Source # 
Instance details

Defined in Servant.API.MultiVerb

AsConstructor ('[] :: [Type]) (RespondEmpty code description) Source # 
Instance details

Defined in Servant.API.MultiVerb

Methods

toConstructor :: ResponseType (RespondEmpty code description) -> NP I ('[] :: [Type]) Source #

fromConstructor :: NP I ('[] :: [Type]) -> ResponseType (RespondEmpty code description) Source #

AsConstructor '[a] (Respond code description a) Source # 
Instance details

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 #

AsConstructor '[a] (WithHeaders headers a response) Source # 
Instance details

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 #

AsConstructor '[a] (RespondAs responseContentTypes code description a) Source # 
Instance details

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 #

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

Instances details
(Code a ~ xss, Generic a, AsConstructors xss rs) => AsUnion rs (GenericAsUnion rs a) Source # 
Instance details

Defined in Servant.API.MultiVerb

type family ResponseType a Source #

Instances

Instances details
type ResponseType (GenericAsConstructor r) Source # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (Respond s description a) Source # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (Respond s description a) = a
type ResponseType (WithHeaders headers returnType response) Source # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (WithHeaders headers returnType response) = returnType
type ResponseType (RespondStreaming s description framing ct) Source # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (RespondStreaming s description framing ct) = SourceIO ByteString
type ResponseType (RespondAs responseContentType s description a) Source # 
Instance details

Defined in Servant.API.MultiVerb

type ResponseType (RespondAs responseContentType s description a) = a

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'.

Instances

Instances details
Alternative UnrenderResult Source # 
Instance details

Defined in Servant.API.MultiVerb

Applicative UnrenderResult Source # 
Instance details

Defined in Servant.API.MultiVerb

Functor UnrenderResult Source # 
Instance details

Defined in Servant.API.MultiVerb

Methods

fmap :: (a -> b) -> UnrenderResult a -> UnrenderResult b #

(<$) :: a -> UnrenderResult b -> UnrenderResult a #

Monad UnrenderResult Source # 
Instance details

Defined in Servant.API.MultiVerb

MonadPlus UnrenderResult Source # 
Instance details

Defined in Servant.API.MultiVerb

Show a => Show (UnrenderResult a) Source # 
Instance details

Defined in Servant.API.MultiVerb

Eq a => Eq (UnrenderResult a) Source # 
Instance details

Defined in Servant.API.MultiVerb