schema-profunctor-0.1.0
Safe HaskellSafe-Inferred
LanguageGHC2021

Data.Schema

Description

Combinator library for defining bidirectional JSON encodings with associated Swagger schemas.

Documentation on the organisation of this library and a tutorial can be found in README.md.

Synopsis

Documentation

data SchemaP doc v w a b Source #

A combined JSON encoder-decoder with associated documentation.

A value of type 'SchemaP d v w a b', which we will refer to as a schema, contains both a JSON parser and a JSON serialiser, together with documentation-like metadata, such as a JSON or Swagger schema.

The type variables are as follows:

d
documentation type, usually a Monoid.
v
type of JSON values being parsed (e.g. Value).
w
type of JSON values being serialised (e.g. Value).
a
input type
b
output type

Input and output types deserve some more explanation. We can think of a value sch of type 'SchemaP d v w a b' as a kind of special "function" from a to b, but where a and b might potentially live in different "languages". The parser portion of sch takes a JSON-encoded value of type a and produces a value of type b, while the serialiser portion of sch takes a haskell value of type a and produces a JSON-encoding of something of type b.

In terms of composability, this way of representing schemas (based on input and output types) is superior to the perhaps more natural approach of using "bidirectional functions" or isomorphisms (based on a single type parameter).

Although schemas cannot be composed as functions (i.e. they do not form a Category), they still admit a number of important and useful instances, such as Profunctor (and specifically Choice), which makes it possible to use prism quite effectively to build schema values.

Using type variables to represent JSON types might seem like excessive generality, but it is useful to represent "intermediate" schemas arising when building complex ones. For example, a schema which is able to work with fields of a JSON object (see field) should not output full-blown objects, but only lists of pairs, so that they can be combined correctly via the usual Monoid structure of lists when using the Applicative interface of 'SchemaP d v w a b'.

The idea of using the profunctor structure of SchemaP is taken from the codec library.

Instances

Instances details
Choice (SchemaP doc v v') Source # 
Instance details

Defined in Data.Schema

Methods

left' :: SchemaP doc v v' a b -> SchemaP doc v v' (Either a c) (Either b c) Source #

right' :: SchemaP doc v v' a b -> SchemaP doc v v' (Either c a) (Either c b) Source #

Profunctor (SchemaP doc v v') Source # 
Instance details

Defined in Data.Schema

Methods

dimap :: (a -> b) -> (c -> d) -> SchemaP doc v v' b c -> SchemaP doc v v' a d Source #

lmap :: (a -> b) -> SchemaP doc v v' b c -> SchemaP doc v v' a c Source #

rmap :: (b -> c) -> SchemaP doc v v' a b -> SchemaP doc v v' a c Source #

(#.) :: forall a b c q. Coercible c b => q b c -> SchemaP doc v v' a b -> SchemaP doc v v' a c Source #

(.#) :: forall a b c q. Coercible b a => SchemaP doc v v' b c -> q a b -> SchemaP doc v v' a c Source #

(NearSemiRing doc, Monoid v') => Alternative (SchemaP doc v v' a) Source # 
Instance details

Defined in Data.Schema

Methods

empty :: SchemaP doc v v' a a0 #

(<|>) :: SchemaP doc v v' a a0 -> SchemaP doc v v' a a0 -> SchemaP doc v v' a a0 #

some :: SchemaP doc v v' a a0 -> SchemaP doc v v' a [a0] #

many :: SchemaP doc v v' a a0 -> SchemaP doc v v' a [a0] #

(Monoid doc, Monoid v') => Applicative (SchemaP doc v v' a) Source # 
Instance details

Defined in Data.Schema

Methods

pure :: a0 -> SchemaP doc v v' a a0 #

(<*>) :: SchemaP doc v v' a (a0 -> b) -> SchemaP doc v v' a a0 -> SchemaP doc v v' a b #

liftA2 :: (a0 -> b -> c) -> SchemaP doc v v' a a0 -> SchemaP doc v v' a b -> SchemaP doc v v' a c #

(*>) :: SchemaP doc v v' a a0 -> SchemaP doc v v' a b -> SchemaP doc v v' a b #

(<*) :: SchemaP doc v v' a a0 -> SchemaP doc v v' a b -> SchemaP doc v v' a a0 #

Functor (SchemaP doc v w a) Source # 
Instance details

Defined in Data.Schema

Methods

fmap :: (a0 -> b) -> SchemaP doc v w a a0 -> SchemaP doc v w a b #

(<$) :: a0 -> SchemaP doc v w a b -> SchemaP doc v w a a0 #

Monoid doc => Monoid (SchemaP doc v v' a b) Source # 
Instance details

Defined in Data.Schema

Methods

mempty :: SchemaP doc v v' a b #

mappend :: SchemaP doc v v' a b -> SchemaP doc v v' a b -> SchemaP doc v v' a b #

mconcat :: [SchemaP doc v v' a b] -> SchemaP doc v v' a b #

Semigroup doc => Semigroup (SchemaP doc v v' a b) Source # 
Instance details

Defined in Data.Schema

Methods

(<>) :: SchemaP doc v v' a b -> SchemaP doc v v' a b -> SchemaP doc v v' a b #

sconcat :: NonEmpty (SchemaP doc v v' a b) -> SchemaP doc v v' a b #

stimes :: Integral b0 => b0 -> SchemaP doc v v' a b -> SchemaP doc v v' a b #

HasSchema d Schema => HasSchema (SchemaP d v w a b) Schema Source # 
Instance details

Defined in Data.Schema

Methods

schema :: Lens' (SchemaP d v w a b) Schema Source #

HasDoc (SchemaP doc v v' a b) (SchemaP doc' v v' a b) doc doc' Source # 
Instance details

Defined in Data.Schema

Methods

doc :: Lens (SchemaP doc v v' a b) (SchemaP doc' v v' a b) doc doc' Source #

type ValueSchema doc a = ValueSchemaP doc a a Source #

type ObjectSchema doc a = ObjectSchemaP doc a a Source #

class ToSchema a where Source #

A type with a canonical typed schema definition.

Using ToSchema, one can split a complicated shema definition into manageable parts by defining instances for the various types involved, and using the schema method to reuse the previously-defined schema definitions for component types.

Instances

Instances details
ToSchema Int32 Source # 
Instance details

Defined in Data.Schema

ToSchema Int64 Source # 
Instance details

Defined in Data.Schema

ToSchema Word16 Source # 
Instance details

Defined in Data.Schema

ToSchema Word32 Source # 
Instance details

Defined in Data.Schema

ToSchema Word64 Source # 
Instance details

Defined in Data.Schema

ToSchema Word8 Source # 
Instance details

Defined in Data.Schema

ToSchema Text Source # 
Instance details

Defined in Data.Schema

ToSchema Text Source # 
Instance details

Defined in Data.Schema

ToSchema String Source # 
Instance details

Defined in Data.Schema

ToSchema Integer Source # 
Instance details

Defined in Data.Schema

ToSchema Natural Source # 
Instance details

Defined in Data.Schema

ToSchema Bool Source # 
Instance details

Defined in Data.Schema

ToSchema Char Source # 
Instance details

Defined in Data.Schema

ToSchema Int Source # 
Instance details

Defined in Data.Schema

ToSchema Word Source # 
Instance details

Defined in Data.Schema

newtype Schema a Source #

Constructors

Schema 

Fields

Instances

Instances details
ToSchema a => FromJSON (Schema a) Source # 
Instance details

Defined in Data.Schema

ToSchema a => ToJSON (Schema a) Source # 
Instance details

Defined in Data.Schema

Generic (Schema a) Source # 
Instance details

Defined in Data.Schema

Associated Types

type Rep (Schema a) :: Type -> Type #

Methods

from :: Schema a -> Rep (Schema a) x #

to :: Rep (Schema a) x -> Schema a #

(Typeable a, ToSchema a) => ToSchema (Schema a) Source # 
Instance details

Defined in Data.Schema

type Rep (Schema a) Source # 
Instance details

Defined in Data.Schema

type Rep (Schema a) = D1 ('MetaData "Schema" "Data.Schema" "schema-profunctor-0.1.0-AQYffRJ0dYH1jwF7OzonW6" 'True) (C1 ('MetaCons "Schema" 'PrefixI 'True) (S1 ('MetaSel ('Just "getSchema") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)))

mkSchema :: doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b Source #

Build a schema from documentation, parser and serialiser

schemaDoc :: SchemaP ss v m a b -> ss Source #

schemaIn :: SchemaP doc v v' a b -> v -> Parser b Source #

schemaOut :: SchemaP ss v m a b -> a -> Maybe m Source #

class HasDoc a a' doc doc' | a a' -> doc doc' where Source #

Methods

doc :: Lens a a' doc doc' Source #

Instances

Instances details
HasDoc (SchemaP doc v v' a b) (SchemaP doc' v v' a b) doc doc' Source # 
Instance details

Defined in Data.Schema

Methods

doc :: Lens (SchemaP doc v v' a b) (SchemaP doc' v v' a b) doc doc' Source #

doc' :: Lens' (SchemaP doc v w a b) doc Source #

class HasSchemaRef doc where Source #

Instances

Instances details
HasSchemaRef NamedSwaggerDoc Source # 
Instance details

Defined in Data.Schema

HasSchemaRef SwaggerDoc Source # 
Instance details

Defined in Data.Schema

class Monoid doc => HasObject doc ndoc | doc -> ndoc, ndoc -> doc where Source #

Methods

mkObject :: Text -> doc -> ndoc Source #

unmkObject :: ndoc -> doc Source #

Instances

Instances details
HasObject SwaggerDoc NamedSwaggerDoc Source # 
Instance details

Defined in Data.Schema

class Monoid doc => HasField ndoc doc | ndoc -> doc where Source #

Methods

mkField :: Text -> ndoc -> doc Source #

Instances

Instances details
HasSchemaRef doc => HasField doc SwaggerDoc Source # 
Instance details

Defined in Data.Schema

Methods

mkField :: Text -> doc -> SwaggerDoc Source #

withParser :: SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b' Source #

data WithDeclare s Source #

Instances

Instances details
Applicative WithDeclare Source # 
Instance details

Defined in Data.Schema

Methods

pure :: a -> WithDeclare a #

(<*>) :: WithDeclare (a -> b) -> WithDeclare a -> WithDeclare b #

liftA2 :: (a -> b -> c) -> WithDeclare a -> WithDeclare b -> WithDeclare c #

(*>) :: WithDeclare a -> WithDeclare b -> WithDeclare b #

(<*) :: WithDeclare a -> WithDeclare b -> WithDeclare a #

Functor WithDeclare Source # 
Instance details

Defined in Data.Schema

Methods

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

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

Comonad WithDeclare Source # 
Instance details

Defined in Data.Schema

HasSchemaRef NamedSwaggerDoc Source # 
Instance details

Defined in Data.Schema

HasSchemaRef SwaggerDoc Source # 
Instance details

Defined in Data.Schema

HasSchema NamedSwaggerDoc Schema Source # 
Instance details

Defined in Data.Schema

HasSchema SwaggerDoc Schema Source # 
Instance details

Defined in Data.Schema

HasSchemaRef doc => HasField doc SwaggerDoc Source # 
Instance details

Defined in Data.Schema

Methods

mkField :: Text -> doc -> SwaggerDoc Source #

HasObject SwaggerDoc NamedSwaggerDoc Source # 
Instance details

Defined in Data.Schema

HasDeprecated NamedSwaggerDoc (Maybe Bool) Source # 
Instance details

Defined in Data.Schema

HasDescription NamedSwaggerDoc (Maybe Text) Source # 
Instance details

Defined in Data.Schema

Monoid s => Monoid (WithDeclare s) Source # 
Instance details

Defined in Data.Schema

Semigroup s => Semigroup (WithDeclare s) Source # 
Instance details

Defined in Data.Schema

HasDeprecated s a => HasDeprecated (WithDeclare s) a Source # 
Instance details

Defined in Data.Schema

HasDescription s a => HasDescription (WithDeclare s) a Source # 
Instance details

Defined in Data.Schema

HasExample s a => HasExample (WithDeclare s) a Source # 
Instance details

Defined in Data.Schema

Methods

example :: Lens' (WithDeclare s) a Source #

declareSwaggerSchema :: SchemaP (WithDeclare d) v w a b -> Declare d Source #

getName :: HasName doc => doc -> Maybe Text Source #

object :: HasObject doc doc' => Text -> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b Source #

A schema for a JSON object.

This can be used to convert a combination of schemas obtained using field into a single schema for a JSON object.

objectWithDocModifier :: HasObject doc doc' => Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a Source #

Like object, but apply an arbitrary function to the documentation of the resulting object.

objectOver :: HasObject doc doc' => Lens v v' Value Object -> Text -> SchemaP doc v' [Pair] a b -> SchemaP doc' v Value a b Source #

A version of object for more general input values.

Just like fieldOver, but for object.

jsonObject :: ValueSchema SwaggerDoc Object Source #

A schema for an arbitrary JSON object.

jsonValue :: ValueSchema SwaggerDoc Value Source #

A schema for an arbitrary JSON value.

class Functor f => FieldFunctor doc f where Source #

Methods

parseFieldF :: (Value -> Parser a) -> Object -> Text -> Parser (f a) Source #

mkDocF :: doc -> doc Source #

Instances

Instances details
FieldFunctor doc Identity Source # 
Instance details

Defined in Data.Schema

Methods

parseFieldF :: (Value -> Parser a) -> Object -> Text -> Parser (Identity a) Source #

mkDocF :: doc -> doc Source #

HasOpt doc => FieldFunctor doc Maybe Source # 
Instance details

Defined in Data.Schema

Methods

parseFieldF :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a) Source #

mkDocF :: doc -> doc Source #

field :: forall doc' doc a b. HasField doc' doc => Text -> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b Source #

A schema for a one-field JSON object.

fieldWithDocModifier :: forall doc' doc a b. HasField doc' doc => Text -> (doc' -> doc') -> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b Source #

Like field, but apply an arbitrary function to the documentation of the field.

fieldOver :: forall doc' doc v v' a b. HasField doc' doc => Lens v v' Object Value -> Text -> SchemaP doc' v' Value a b -> SchemaP doc v [Pair] a b Source #

Like fieldOverF, but specialised to the identity functor.

optField :: forall doc doc' a b. (HasOpt doc, HasField doc' doc) => Text -> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a (Maybe b) Source #

A schema for a JSON object with a single optional field.

optFieldWithDocModifier :: forall doc doc' a b. (HasOpt doc, HasField doc' doc) => Text -> (doc' -> doc') -> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a (Maybe b) Source #

Like optField, but apply an arbitrary function to the documentation of the field.

fieldF :: forall doc' doc f a b. (HasField doc' doc, FieldFunctor doc f) => Text -> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a (f b) Source #

Generalization of optField with FieldFunctor.

fieldOverF :: forall f doc' doc v v' a b. (HasField doc' doc, FieldFunctor doc f) => Lens v v' Object Value -> Text -> SchemaP doc' v' Value a b -> SchemaP doc v [Pair] a (f b) Source #

A version of field for more general input values.

This can be used when the input type v of the parser is not exactly a Object, but it contains one. The first argument is a lens that can extract the Object contained in v.

See bind for use cases.

fieldWithDocModifierF :: forall doc' doc f a b. (HasField doc' doc, FieldFunctor doc f) => Text -> (doc' -> doc') -> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a (f b) Source #

Like fieldF, but apply an arbitrary function to the documentation of the field.

array :: (HasArray ndoc doc, HasName ndoc) => ValueSchema ndoc a -> ValueSchema doc [a] Source #

A schema for a JSON array.

set :: (HasArray ndoc doc, HasName ndoc, Ord a) => ValueSchema ndoc a -> ValueSchema doc (Set a) Source #

nonEmptyArray :: (HasArray ndoc doc, HasName ndoc, HasMinItems doc (Maybe Integer)) => ValueSchema ndoc a -> ValueSchema doc (NonEmpty a) Source #

map_ :: forall ndoc doc k a. (HasMap ndoc doc, Ord k, FromJSONKey k, ToJSONKey k) => ValueSchema ndoc a -> ValueSchema doc (Map k a) Source #

A schema for a JSON object with arbitrary keys of type k. The type of keys must have instances for FromJSONKey and ToJSONKey.

Use mapWithKeys for key types that do not have such instances.

mapWithKeys :: forall ndoc doc k a. (HasMap ndoc doc, Ord k) => (k -> Text) -> (Text -> k) -> ValueSchema ndoc a -> ValueSchema doc (Map k a) Source #

A schema for a JSON object with arbitrary keys of type k, where k can be converted to and from Text.

enum :: forall v doc a b. (With v, HasEnum v doc) => Text -> SchemaP [Value] v (Alt Maybe v) a b -> SchemaP doc Value Value a b Source #

A schema for a JSON enumeration.

This is used to convert a combination of schemas obtained using element into a single schema for a JSON string.

maybe_ :: Monoid w => SchemaP d v w a b -> SchemaP d v w (Maybe a) b Source #

A schema for Maybe that omits a field on serialisation.

This is most commonly used for optional fields, and it will cause the field to be omitted from the output of the serialiser.

maybeWithDefault :: w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b Source #

A schema for Maybe, producing the given default value on serialisation.

bind :: (Monoid d, Monoid w) => SchemaP d v w a b -> SchemaP d (v, b) w a c -> SchemaP d v w a (b, c) Source #

A schema depending on a parsed value.

Even though SchemaP does not expose a monadic interface, it is possible to make the parser of a schema depend on the values parsed by a previous schema.

For example, a schema for an object containing a "type" field which determines how the rest of the object is parsed. To construct the schema to use as the second argument of bind, one can use dispatch.

dispatch :: (Bounded t, Enum t, Monoid d) => (t -> SchemaP d v w a b) -> SchemaP d (v, t) w a b Source #

A union of schemas over a finite type of "tags".

Normally used together with bind to construct schemas that depend on some "tag" value.

text :: Text -> ValueSchema NamedSwaggerDoc Text Source #

A schema for a textual value.

parsedText :: Text -> (Text -> Either String a) -> SchemaP NamedSwaggerDoc Value Value Text a Source #

A schema for a textual value with possible failure.

null_ :: Monoid d => ValueSchemaP d () () Source #

A schema for a null value.

nullable :: Monoid d => ValueSchema d a -> ValueSchema d (Maybe a) Source #

A schema for a nullable value.

The parser accepts a JSON null as a valid value, and converts it to Nothing. Any non-null value is parsed using the underlying schema.

The serialiser behaves similarly, but in the other direction.

element :: forall a b. (ToJSON a, Eq a, Eq b) => a -> b -> SchemaP [Value] a (Alt Maybe a) b b Source #

A schema for a single value of an enumeration.

tag :: Prism b b' a a' -> SchemaP ss v m a a' -> SchemaP ss v m b b' Source #

Change the input and output types of a schema via a prism.

unnamed :: HasObject doc doc' => SchemaP doc' v m a b -> SchemaP doc v m a b Source #

Turn a named schema into an unnamed one.

This is mostly useful when using a schema as a field of a bigger schema. If the inner schema is unnamed, it gets "inlined" in the larger scheme definition, and otherwise it gets "referenced". This combinator makes it possible to choose one of the two options.

named :: HasObject doc doc' => Text -> SchemaP doc v m a b -> SchemaP doc' v m a b Source #

Attach a name to a schema.

This only affects the documentation portion of a schema, and not the parsing or serialisation.

(.=) :: Profunctor p => (a -> a') -> p a' b -> p a b Source #

Change the input type of a schema.

schemaToSwagger :: forall a. ToSchema a => Proxy a -> Declare NamedSchema Source #

schemaToJSON :: forall a. ToSchema a => a -> Value Source #

JSON serialiser for an instance of ToSchema.

schemaParseJSON :: forall a. ToSchema a => Value -> Parser a Source #

JSON parser for an instance of ToSchema.