Safe Haskell | None |
---|---|
Language | Haskell98 |
- data Format
- data Dict h p i o e
- headers :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict a p i o e) (Header h -> Header a)
- params :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict h a i o e) (Param p -> Param a)
- inputs :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict h p a o e) (Inputs i -> Inputs a)
- outputs :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict h p i a e) (Outputs o -> Outputs a)
- errors :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict h p i o a) (Errors e -> Errors a)
- empty :: Dict () () Nothing Nothing Nothing
- type Modifier h p i o e = Dict () () Nothing Nothing Nothing -> Dict h p i o e
- data Ident id where
- data Header h where
- data Param p where
- data Input i where
- JsonI :: (Typeable i, FromJSON i, JSONSchema i) => Input i
- ReadI :: (Info i, Read i, Show i) => Input i
- StringI :: Input String
- FileI :: Input ByteString
- XmlI :: (Typeable i, XmlPickler i) => Input i
- XmlTextI :: Input Text
- RawJsonI :: Input ByteString
- RawXmlI :: Input ByteString
- RawJsonAndXmlI :: Input (Either Json Xml)
- data Output o where
- FileO :: Output (ByteString, String, Bool)
- RawJsonO :: Output ByteString
- RawXmlO :: Output ByteString
- JsonO :: (Typeable o, ToJSON o, JSONSchema o) => Output o
- XmlO :: (Typeable o, XmlPickler o) => Output o
- StringO :: Output String
- RawJsonAndXmlO :: Output ByteString
- MultipartO :: Output [BodyPart]
- data Error e where
- JsonE :: (ToResponseCode e, Typeable e, ToJSON e, JSONSchema e) => Error e
- XmlE :: (ToResponseCode e, Typeable e, XmlPickler e) => Error e
- newtype Xml = Xml {
- unXml :: ByteString
- newtype Json = Json {
- unJson :: ByteString
- data Dicts f a where
- dicts :: forall a o f. o ~ FromMaybe o a => Dicts f a :-> [f o]
- getDicts :: o ~ FromMaybe o a => Dicts f a -> [f o]
- getDicts_ :: o ~ FromMaybe () a => Dicts f a -> [f o]
- modDicts :: FromMaybe o i ~ o => ([f o] -> [f o]) -> Dicts f i -> Dicts f (Just o)
- type Inputs i = Dicts Input i
- type Outputs o = Dicts Output o
- type Errors e = Dicts Error e
- data SomeError where
- type family FromMaybe d (m :: Maybe *) :: *
Possible I/O formats.
The Format
datatype enumerates all input and output formats we might recognize.
The dictionary type.
The Dict
datatype containing sub-dictionaries for translation of
identifiers (i), headers (h), parameters (p), inputs (i), outputs (o), and
errors (e). Inputs, outputs and errors can have multiple associated
dictionaries.
headers :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict a p i o e) (Header h -> Header a) Source #
params :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict h a i o e) (Param p -> Param a) Source #
inputs :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict h p a o e) (Inputs i -> Inputs a) Source #
outputs :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict h p i a e) (Outputs o -> Outputs a) Source #
errors :: forall cat h p i o e a. ArrowApply cat => Lens cat (Dict h p i o e -> Dict h p i o a) (Errors e -> Errors a) Source #
type Modifier h p i o e = Dict () () Nothing Nothing Nothing -> Dict h p i o e Source #
Type synonym for dictionary modification.
Dictionary aspects.
The explicit dictionary Header
describes how to translate HTTP request
headers to some Haskell value. The first field in the Header
constructor
is a white list of headers we can recognize, used in generic validation and
for generating documentation. The second field is a custom parser that can
fail with a DataError
or can produce a some value. When explicitly not
interested in the headers we can use NoHeader
.
The explicit dictionary Param
describes how to translate the request
parameters to some Haskell value. The first field in the Param
constructor is a white list of paramters we can recognize, used in generic
validation and for generating documentation. The second field is a custom
parser that can fail with a DataError
or can produce a some value. When
explicitly not interested in the parameters we can use NoParam
.
The explicit dictionary Input
describes how to translate the request
body into some Haskell value. We currently use a constructor for every
combination of input type to output type. For example, we can use XML input
in multiple ways, parsed, as plain/text or as raw bytes, depending on the
needs of the backend resource.
JsonI :: (Typeable i, FromJSON i, JSONSchema i) => Input i | |
ReadI :: (Info i, Read i, Show i) => Input i | |
StringI :: Input String | |
FileI :: Input ByteString | |
XmlI :: (Typeable i, XmlPickler i) => Input i | |
XmlTextI :: Input Text | |
RawJsonI :: Input ByteString | |
RawXmlI :: Input ByteString | |
RawJsonAndXmlI :: Input (Either Json Xml) |
The explicit dictionary Output
describes how to translate some Haskell
value to a response body. We currently use a constructor for every
combination of input type to output type.
FileO :: Output (ByteString, String, Bool) | |
RawJsonO :: Output ByteString | |
RawXmlO :: Output ByteString | |
JsonO :: (Typeable o, ToJSON o, JSONSchema o) => Output o | |
XmlO :: (Typeable o, XmlPickler o) => Output o | |
StringO :: Output String | |
RawJsonAndXmlO :: Output ByteString | |
MultipartO :: Output [BodyPart] |
The explicit dictionary Error
describes how to translate some Haskell
error value to a response body.
JsonE :: (ToResponseCode e, Typeable e, ToJSON e, JSONSchema e) => Error e | |
XmlE :: (ToResponseCode e, Typeable e, XmlPickler e) => Error e |
Newtype around ByteStrings used in RawJsonAndXmlI
to add some
protection from parsing the input incorrectly.
Xml | |
|
Newtype around ByteStrings used in RawJsonAndXmlI
to add some
protection from parsing the input incorrectly.
Json | |
|
Plural dictionaries.
dicts :: forall a o f. o ~ FromMaybe o a => Dicts f a :-> [f o] Source #
Deprecated: The modifier for this lens doesn't do anything when Dicts is None. Use getDicts and modDicts instead.
getDicts :: o ~ FromMaybe o a => Dicts f a -> [f o] Source #
Get the list of dictionaries. If there are none, you get a [o].
If this is too polymorphic, try getDicts_
.
getDicts_ :: o ~ FromMaybe () a => Dicts f a -> [f o] Source #
Get the list of dictionaries. If there are none, you get a [()]. Sometimes useful to constraint the types if the element type of the list isn't clear from the context.
Custom existential packing an error together with a Reason.