swagger2-2.1.4.1: Swagger 2.0 data model

Safe HaskellNone
LanguageHaskell2010

Data.Swagger.Internal.Schema

Synopsis

Documentation

class ToSchema a where #

Convert a type into Schema.

An example type and instance:

{-# LANGUAGE OverloadedStrings #-}   -- allows to write Text literals
{-# LANGUAGE OverloadedLists #-}     -- allows to write Map and HashMap as lists

import Control.Lens
import Data.Proxy
import Data.Swagger

data Coord = Coord { x :: Double, y :: Double }

instance ToSchema Coord where
  declareNamedSchema _ = do
    doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
    return $ NamedSchema (Just "Coord") $ mempty
      & type_ .~ SwaggerObject
      & properties .~
          [ ("x", doubleSchema)
          , ("y", doubleSchema)
          ]
      & required .~ [ "x", "y" ]

Instead of manually writing your ToSchema instance you can use a default generic implementation of declareNamedSchema.

To do that, simply add deriving Generic clause to your datatype and declare a ToSchema instance for your datatype without giving definition for declareNamedSchema.

For instance, the previous example can be simplified into this:

{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics (Generic)

data Coord = Coord { x :: Double, y :: Double } deriving Generic

instance ToSchema Coord

Methods

declareNamedSchema :: proxy a -> Declare (Definitions Schema) NamedSchema #

Convert a type into an optionally named schema together with all used definitions. Note that the schema itself is included in definitions only if it is recursive (and thus needs its definition in scope).

declareNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare (Definitions Schema) NamedSchema #

Convert a type into an optionally named schema together with all used definitions. Note that the schema itself is included in definitions only if it is recursive (and thus needs its definition in scope).

Instances

ToSchema Bool # 
ToSchema Char # 
ToSchema Double # 
ToSchema Float # 
ToSchema Int # 
ToSchema Int8 # 
ToSchema Int16 # 
ToSchema Int32 # 
ToSchema Int64 # 
ToSchema Integer # 
ToSchema Word # 
ToSchema Word8 # 
ToSchema Word16 # 
ToSchema Word32 # 
ToSchema Word64 # 
ToSchema () # 
ToSchemaByteStringError Constraint ByteString => ToSchema ByteString # 
ToSchemaByteStringError Constraint ByteString => ToSchema ByteString # 
ToSchema Scientific # 
ToSchema String # 
ToSchema Text # 
ToSchema UTCTime #
>>> toSchema (Proxy :: Proxy UTCTime) ^. format
Just "yyyy-mm-ddThh:MM:ssZ"
ToSchema Text # 
ToSchema All # 
ToSchema Any # 
ToSchema IntSet # 
ToSchema LocalTime #
>>> toSchema (Proxy :: Proxy LocalTime) ^. format
Just "yyyy-mm-ddThh:MM:ss"
ToSchema ZonedTime #

Format "date" corresponds to yyyy-mm-ddThh:MM:ss(Z|+hh:MM) format.

ToSchema NominalDiffTime # 
ToSchema Day #

Format "date" corresponds to yyyy-mm-dd format.

ToSchema UUID #

For ToJSON instance, see uuid-aeson package.

ToSchema a => ToSchema [a] # 
ToSchema a => ToSchema (Maybe a) # 
ToSchema a => ToSchema (Dual a) # 
ToSchema a => ToSchema (Sum a) # 
ToSchema a => ToSchema (Product a) # 
ToSchema a => ToSchema (First a) # 
ToSchema a => ToSchema (Last a) # 
ToSchema a => ToSchema (IntMap a) #

NOTE: This schema does not account for the uniqueness of keys.

ToSchema a => ToSchema (Set a) # 
ToSchema a => ToSchema (Vector a) # 
ToSchema a => ToSchema (Vector a) # 
ToSchema a => ToSchema (Vector a) # 
ToSchema a => ToSchema (Vector a) # 
ToSchema a => ToSchema (HashSet a) # 
(ToSchema a, ToSchema b) => ToSchema (Either a b) # 
(ToSchema a, ToSchema b) => ToSchema (a, b) # 
(ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) # 
(ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) # 
(ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) # 

Methods

declareNamedSchema :: proxy (a, b, c) -> Declare (Definitions Schema) NamedSchema #

(ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) # 

Methods

declareNamedSchema :: proxy (a, b, c, d) -> Declare (Definitions Schema) NamedSchema #

(ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) # 

Methods

declareNamedSchema :: proxy (a, b, c, d, e) -> Declare (Definitions Schema) NamedSchema #

(ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) # 

Methods

declareNamedSchema :: proxy (a, b, c, d, e, f) -> Declare (Definitions Schema) NamedSchema #

(ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) # 

Methods

declareNamedSchema :: proxy (a, b, c, d, e, f, g) -> Declare (Definitions Schema) NamedSchema #

declareSchema :: ToSchema a => proxy a -> Declare (Definitions Schema) Schema #

Convert a type into a schema and declare all used schema definitions.

toNamedSchema :: ToSchema a => proxy a -> NamedSchema #

Convert a type into an optionally named schema.

>>> toNamedSchema (Proxy :: Proxy String) ^. name
Nothing
>>> encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
"{\"type\":\"string\"}"
>>> toNamedSchema (Proxy :: Proxy Day) ^. name
Just "Day"
>>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
"{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"

schemaName :: ToSchema a => proxy a -> Maybe Text #

Get type's schema name according to its ToSchema instance.

>>> schemaName (Proxy :: Proxy Int)
Nothing
>>> schemaName (Proxy :: Proxy UTCTime)
Just "UTCTime"

toSchema :: ToSchema a => proxy a -> Schema #

Convert a type into a schema.

>>> encode $ toSchema (Proxy :: Proxy Int8)
"{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
>>> encode $ toSchema (Proxy :: Proxy [Day])
"{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"

toSchemaRef :: ToSchema a => proxy a -> Referenced Schema #

Convert a type into a referenced schema if possible. Only named schemas can be referenced, nameless schemas are inlined.

>>> encode $ toSchemaRef (Proxy :: Proxy Integer)
"{\"type\":\"integer\"}"
>>> encode $ toSchemaRef (Proxy :: Proxy Day)
"{\"$ref\":\"#/definitions/Day\"}"

declareSchemaRef :: ToSchema a => proxy a -> Declare (Definitions Schema) (Referenced Schema) #

Convert a type into a referenced schema if possible and declare all used schema definitions. Only named schemas can be referenced, nameless schemas are inlined.

Schema definitions are typically declared for every referenced schema. If declareSchemaRef returns a reference, a corresponding schema will be declared (regardless of whether it is recusive or not).

inlineSchemasWhen :: Data s => (Text -> Bool) -> Definitions Schema -> s -> s #

Inline any referenced schema if its name satisfies given predicate.

NOTE: if a referenced schema is not found in definitions the predicate is ignored and schema stays referenced.

WARNING: inlineSchemasWhen will produce infinite schemas when inlining recursive schemas.

inlineSchemas :: Data s => [Text] -> Definitions Schema -> s -> s #

Inline any referenced schema if its name is in the given list.

NOTE: if a referenced schema is not found in definitions it stays referenced even if it appears in the list of names.

WARNING: inlineSchemas will produce infinite schemas when inlining recursive schemas.

inlineAllSchemas :: Data s => Definitions Schema -> s -> s #

Inline all schema references for which the definition can be found in Definitions.

WARNING: inlineAllSchemas will produce infinite schemas when inlining recursive schemas.

toInlinedSchema :: ToSchema a => proxy a -> Schema #

Convert a type into a schema without references.

>>> encode $ toInlinedSchema (Proxy :: Proxy [Day])
"{\"items\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"},\"type\":\"array\"}"

WARNING: toInlinedSchema will produce infinite schema when inlining recursive schemas.

inlineNonRecursiveSchemas :: Data s => Definitions Schema -> s -> s #

Inline all non-recursive schemas for which the definition can be found in Definitions.

binarySchema :: Schema #

Default schema for binary data (any sequence of octets).

byteSchema :: Schema #

Default schema for binary data (base64 encoded).

passwordSchema :: Schema #

Default schema for password string. "password" format is used to hint UIs the input needs to be obscured.

sketchSchema :: ToJSON a => a -> Schema #

Make an unrestrictive sketch of a Schema based on a ToJSON instance. Produced schema can be used for further refinement.

>>> encode $ sketchSchema "hello"
"{\"example\":\"hello\",\"type\":\"string\"}"
>>> encode $ sketchSchema (1, 2, 3)
"{\"example\":[1,2,3],\"items\":{\"type\":\"number\"},\"type\":\"array\"}"
>>> encode $ sketchSchema ("Jack", 25)
"{\"example\":[\"Jack\",25],\"items\":[{\"type\":\"string\"},{\"type\":\"number\"}],\"type\":\"array\"}"
>>> data Person = Person { name :: String, age :: Int } deriving (Generic)
>>> instance ToJSON Person
>>> encode $ sketchSchema (Person "Jack" 25)
"{\"required\":[\"age\",\"name\"],\"properties\":{\"age\":{\"type\":\"number\"},\"name\":{\"type\":\"string\"}},\"example\":{\"age\":25,\"name\":\"Jack\"},\"type\":\"object\"}"

sketchStrictSchema :: ToJSON a => a -> Schema #

Make a restrictive sketch of a Schema based on a ToJSON instance. Produced schema uses as much constraints as possible.

>>> encode $ sketchStrictSchema "hello"
"{\"maxLength\":5,\"pattern\":\"hello\",\"minLength\":5,\"type\":\"string\",\"enum\":[\"hello\"]}"
>>> encode $ sketchStrictSchema (1, 2, 3)
"{\"minItems\":3,\"uniqueItems\":true,\"items\":[{\"maximum\":1,\"minimum\":1,\"multipleOf\":1,\"type\":\"number\",\"enum\":[1]},{\"maximum\":2,\"minimum\":2,\"multipleOf\":2,\"type\":\"number\",\"enum\":[2]},{\"maximum\":3,\"minimum\":3,\"multipleOf\":3,\"type\":\"number\",\"enum\":[3]}],\"maxItems\":3,\"type\":\"array\",\"enum\":[[1,2,3]]}"
>>> encode $ sketchStrictSchema ("Jack", 25)
"{\"minItems\":2,\"uniqueItems\":true,\"items\":[{\"maxLength\":4,\"pattern\":\"Jack\",\"minLength\":4,\"type\":\"string\",\"enum\":[\"Jack\"]},{\"maximum\":25,\"minimum\":25,\"multipleOf\":25,\"type\":\"number\",\"enum\":[25]}],\"maxItems\":2,\"type\":\"array\",\"enum\":[[\"Jack\",25]]}"
>>> data Person = Person { name :: String, age :: Int } deriving (Generic)
>>> instance ToJSON Person
>>> encode $ sketchStrictSchema (Person "Jack" 25)
"{\"required\":[\"age\",\"name\"],\"properties\":{\"age\":{\"maximum\":25,\"minimum\":25,\"multipleOf\":25,\"type\":\"number\",\"enum\":[25]},\"name\":{\"maxLength\":4,\"pattern\":\"Jack\",\"minLength\":4,\"type\":\"string\",\"enum\":[\"Jack\"]}},\"maxProperties\":2,\"minProperties\":2,\"type\":\"object\",\"enum\":[{\"age\":25,\"name\":\"Jack\"}]}"

class GToSchema f where #

Minimal complete definition

gdeclareNamedSchema

Instances

ToSchema c => GToSchema (K1 i c) # 
ToSchema c => GToSchema (K1 i (Maybe c)) # 
(GSumToSchema f, GSumToSchema g) => GToSchema ((:+:) f g) # 
(GToSchema f, GToSchema g) => GToSchema ((:*:) f g) # 
(Datatype Meta d, GToSchema f) => GToSchema (D1 d f) # 
(Selector Meta s, GToSchema f) => GToSchema (C1 c (S1 s f)) #

Single field constructor.

Constructor Meta c => GToSchema (C1 c U1) # 
GToSchema f => GToSchema (C1 c f) # 
(Selector Meta s, GToSchema f) => GToSchema (S1 s f) #

Record fields.

(Selector Meta s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) #

Optional record fields.

type family ToSchemaByteStringError bs where ... #

Equations

ToSchemaByteStringError bs = TypeError ((((Text "Impossible to have an instance " :<>: ShowType (ToSchema bs)) :<>: Text ".") :$$: ((Text "Please, use a newtype wrapper around " :<>: ShowType bs) :<>: Text " instead.")) :$$: Text "Consider using byteSchema or binarySchema templates.") 

toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema #

Default schema for Bounded, Integral types.

>>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
"{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"

genericToNamedSchemaBoundedIntegral :: forall a d f proxy. (Bounded a, Integral a, Generic a, Rep a ~ D1 d f, Datatype d) => SchemaOptions -> proxy a -> NamedSchema #

Default generic named schema for Bounded, Integral types.

genericDeclareSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema #

A configurable generic Schema creator.

genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema #

A configurable generic NamedSchema creator. This function applied to defaultSchemaOptions is used as the default for declareNamedSchema when the type is an instance of Generic.

gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe Text #

paramSchemaToNamedSchema :: forall a d f proxy. (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) => SchemaOptions -> proxy a -> NamedSchema #

Lift a plain ParamSchema into a model NamedSchema.

paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema #

Lift a plain ParamSchema into a model Schema.

withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) => SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema #

gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) => Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema #

gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) => SchemaOptions -> proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema #

data Proxy2 a b #

Constructors

Proxy2 

data Proxy3 a b c #

Constructors

Proxy3 
>>> import Data.Swagger