{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- For TypeErrors
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
module Data.Swagger.Internal.Schema where

import Prelude ()
import Prelude.Compat

import Control.Lens
import Data.Data.Lens (template)

import Control.Monad
import Control.Monad.Writer
import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
import Data.Char
import Data.Data (Data)
import Data.Foldable (traverse_)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import           "unordered-containers" Data.HashSet (HashSet)
import qualified "unordered-containers" Data.HashSet as HashSet
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import Data.Int
import Data.IntSet (IntSet)
import Data.IntMap (IntMap)
import Data.List.NonEmpty.Compat (NonEmpty)
import Data.Map (Map)
import Data.Proxy
import Data.Scientific (Scientific)
import Data.Fixed (Fixed, HasResolution, Pico)
import Data.Set (Set)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time
import qualified Data.Vector as V
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import Data.Version (Version)
import Numeric.Natural.Compat (Natural)
import Data.Word
import GHC.Generics
import qualified Data.UUID.Types as UUID

import Data.Swagger.Declare
import Data.Swagger.Internal
import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
import Data.Swagger.Lens hiding (name, schema)
import qualified Data.Swagger.Lens as Swagger
import Data.Swagger.SchemaOptions
import Data.Swagger.Internal.TypeShape

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import GHC.TypeLits (TypeError, ErrorMessage(..))
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Key (toText)

unnamed :: Schema -> NamedSchema
unnamed :: Schema -> NamedSchema
unnamed Schema
schema = Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
schema

named :: T.Text -> Schema -> NamedSchema
named :: Text -> Schema -> NamedSchema
named Text
name Schema
schema = Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) Schema
schema

plain :: Schema -> Declare (Definitions Schema) NamedSchema
plain :: Schema -> Declare (Definitions Schema) NamedSchema
plain = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Schema -> NamedSchema)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> NamedSchema
unnamed

unname :: NamedSchema -> NamedSchema
unname :: NamedSchema -> NamedSchema
unname (NamedSchema Maybe Text
_ Schema
schema) = Schema -> NamedSchema
unnamed Schema
schema

rename :: Maybe T.Text -> NamedSchema -> NamedSchema
rename :: Maybe Text -> NamedSchema -> NamedSchema
rename Maybe Text
name (NamedSchema Maybe Text
_ Schema
schema) = Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
name Schema
schema

-- | Convert a type into @'Schema'@.
--
-- An example type and instance:
--
-- @
-- {-\# LANGUAGE OverloadedStrings \#-}   -- allows to write 'T.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
-- @
class ToSchema a where
  -- | 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 :: Proxy a -> Declare (Definitions Schema) NamedSchema
  default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
    Proxy a -> Declare (Definitions Schema) NamedSchema
  declareNamedSchema = SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema SchemaOptions
defaultSchemaOptions

instance ToSchema TimeOfDay where
  declareNamedSchema :: Proxy TimeOfDay -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy TimeOfDay
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> NamedSchema
named Text
"TimeOfDay" (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema
timeSchema Text
"hh:MM:ss"
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ TimeOfDay -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
12 Int
33 Pico
15)

-- | Convert a type into a schema and declare all used schema definitions.
declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
declareSchema :: Proxy a -> Declare (Definitions Schema) Schema
declareSchema = (NamedSchema -> Schema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedSchema -> Schema
_namedSchemaSchema (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) Schema)
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> Proxy a
-> Declare (Definitions Schema) Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema

-- | 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\"}"
toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
toNamedSchema :: Proxy a -> NamedSchema
toNamedSchema = Declare (Definitions Schema) NamedSchema -> NamedSchema
forall d a. Monoid d => Declare d a -> a
undeclare (Declare (Definitions Schema) NamedSchema -> NamedSchema)
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> Proxy a
-> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema

-- | Get type's schema name according to its @'ToSchema'@ instance.
--
-- >>> schemaName (Proxy :: Proxy Int)
-- Nothing
--
-- >>> schemaName (Proxy :: Proxy UTCTime)
-- Just "UTCTime"
schemaName :: ToSchema a => Proxy a -> Maybe T.Text
schemaName :: Proxy a -> Maybe Text
schemaName = NamedSchema -> Maybe Text
_namedSchemaName (NamedSchema -> Maybe Text)
-> (Proxy a -> NamedSchema) -> Proxy a -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> NamedSchema
forall a. ToSchema a => Proxy a -> NamedSchema
toNamedSchema

-- | 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\"}"
toSchema :: ToSchema a => Proxy a -> Schema
toSchema :: Proxy a -> Schema
toSchema = NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> (Proxy a -> NamedSchema) -> Proxy a -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> NamedSchema
forall a. ToSchema a => Proxy a -> NamedSchema
toNamedSchema

-- | 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\"}"
toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
toSchemaRef :: Proxy a -> Referenced Schema
toSchemaRef = Declare (Definitions Schema) (Referenced Schema)
-> Referenced Schema
forall d a. Monoid d => Declare d a -> a
undeclare (Declare (Definitions Schema) (Referenced Schema)
 -> Referenced Schema)
-> (Proxy a -> Declare (Definitions Schema) (Referenced Schema))
-> Proxy a
-> Referenced Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef

-- | 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).
declareSchemaRef :: ToSchema a => Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef :: Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef Proxy a
proxy = do
  case Proxy a -> NamedSchema
forall a. ToSchema a => Proxy a -> NamedSchema
toNamedSchema Proxy a
proxy of
    NamedSchema (Just Text
name) Schema
schema -> do
      -- This check is very important as it allows generically
      -- derive used definitions for recursive schemas.
      -- Lazy Declare monad allows toNamedSchema to ignore
      -- any declarations (which would otherwise loop) and
      -- retrieve the schema and its name to check if we
      -- have already declared it.
      -- If we have, we don't need to declare anything for
      -- this schema this time and thus simply return the reference.
      Bool
known <- (Definitions Schema -> Bool)
-> DeclareT (Definitions Schema) Identity Bool
forall d (m :: * -> *) a. MonadDeclare d m => (d -> a) -> m a
looks (Text -> Definitions Schema -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
InsOrdHashMap.member Text
name)
      Bool
-> DeclareT (Definitions Schema) Identity ()
-> DeclareT (Definitions Schema) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
known) (DeclareT (Definitions Schema) Identity ()
 -> DeclareT (Definitions Schema) Identity ())
-> DeclareT (Definitions Schema) Identity ()
-> DeclareT (Definitions Schema) Identity ()
forall a b. (a -> b) -> a -> b
$ do
        Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare [(Text
name, Schema
schema)]
        Declare (Definitions Schema) NamedSchema
-> DeclareT (Definitions Schema) Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Declare (Definitions Schema) NamedSchema
 -> DeclareT (Definitions Schema) Identity ())
-> Declare (Definitions Schema) NamedSchema
-> DeclareT (Definitions Schema) Identity ()
forall a b. (a -> b) -> a -> b
$ Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy a
proxy
      Referenced Schema
-> Declare (Definitions Schema) (Referenced Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return (Referenced Schema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Referenced Schema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref (Text -> Reference
Reference Text
name)
    NamedSchema
_ -> Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema)
-> Declare (Definitions Schema) Schema
-> Declare (Definitions Schema) (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema Proxy a
proxy

-- | 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.
inlineSchemasWhen :: Data s => (T.Text -> Bool) -> (Definitions Schema) -> s -> s
inlineSchemasWhen :: (Text -> Bool) -> Definitions Schema -> s -> s
inlineSchemasWhen Text -> Bool
p Definitions Schema
defs = (Referenced Schema -> Identity (Referenced Schema))
-> s -> Identity s
forall s a. (Data s, Typeable a) => Traversal' s a
template ((Referenced Schema -> Identity (Referenced Schema))
 -> s -> Identity s)
-> (Referenced Schema -> Referenced Schema) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Referenced Schema -> Referenced Schema
deref
  where
    deref :: Referenced Schema -> Referenced Schema
deref r :: Referenced Schema
r@(Ref (Reference Text
name))
      | Text -> Bool
p Text
name =
          case Text -> Definitions Schema -> Maybe Schema
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Text
name Definitions Schema
defs of
            Just Schema
schema -> Schema -> Referenced Schema
forall a. a -> Referenced a
Inline ((Text -> Bool) -> Definitions Schema -> Schema -> Schema
forall s. Data s => (Text -> Bool) -> Definitions Schema -> s -> s
inlineSchemasWhen Text -> Bool
p Definitions Schema
defs Schema
schema)
            Maybe Schema
Nothing -> Referenced Schema
r
      | Bool
otherwise = Referenced Schema
r
    deref (Inline Schema
schema) = Schema -> Referenced Schema
forall a. a -> Referenced a
Inline ((Text -> Bool) -> Definitions Schema -> Schema -> Schema
forall s. Data s => (Text -> Bool) -> Definitions Schema -> s -> s
inlineSchemasWhen Text -> Bool
p Definitions Schema
defs Schema
schema)

-- | 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.
inlineSchemas :: Data s => [T.Text] -> (Definitions Schema) -> s -> s
inlineSchemas :: [Text] -> Definitions Schema -> s -> s
inlineSchemas [Text]
names = (Text -> Bool) -> Definitions Schema -> s -> s
forall s. Data s => (Text -> Bool) -> Definitions Schema -> s -> s
inlineSchemasWhen (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
names)

-- | Inline all schema references for which the definition
-- can be found in @'Definitions'@.
--
-- __WARNING:__ @'inlineAllSchemas'@ will produce infinite schemas
-- when inlining recursive schemas.
inlineAllSchemas :: Data s => (Definitions Schema) -> s -> s
inlineAllSchemas :: Definitions Schema -> s -> s
inlineAllSchemas = (Text -> Bool) -> Definitions Schema -> s -> s
forall s. Data s => (Text -> Bool) -> Definitions Schema -> s -> s
inlineSchemasWhen (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | 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.
toInlinedSchema :: ToSchema a => Proxy a -> Schema
toInlinedSchema :: Proxy a -> Schema
toInlinedSchema Proxy a
proxy = Definitions Schema -> Schema -> Schema
forall s. Data s => Definitions Schema -> s -> s
inlineAllSchemas Definitions Schema
defs Schema
schema
  where
    (Definitions Schema
defs, Schema
schema) = Declare (Definitions Schema) Schema
-> Definitions Schema -> (Definitions Schema, Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema Proxy a
proxy) Definitions Schema
forall a. Monoid a => a
mempty

-- | Inline all /non-recursive/ schemas for which the definition
-- can be found in @'Definitions'@.
inlineNonRecursiveSchemas :: Data s => (Definitions Schema) -> s -> s
inlineNonRecursiveSchemas :: Definitions Schema -> s -> s
inlineNonRecursiveSchemas Definitions Schema
defs = (Text -> Bool) -> Definitions Schema -> s -> s
forall s. Data s => (Text -> Bool) -> Definitions Schema -> s -> s
inlineSchemasWhen Text -> Bool
nonRecursive Definitions Schema
defs
  where
    nonRecursive :: Text -> Bool
nonRecursive Text
name =
      case Text -> Definitions Schema -> Maybe Schema
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Text
name Definitions Schema
defs of
        Just Schema
schema -> Text
name Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Declare [Text] () -> [Text] -> [Text]
forall d a. Declare d a -> d -> d
execDeclare (Schema -> Declare [Text] ()
usedNames Schema
schema) [Text]
forall a. Monoid a => a
mempty
        Maybe Schema
Nothing     -> Bool
False

    usedNames :: Schema -> Declare [Text] ()
usedNames Schema
schema = (Referenced Schema -> Declare [Text] ())
-> [Referenced Schema] -> Declare [Text] ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Referenced Schema -> Declare [Text] ()
schemaRefNames (Schema
schema Schema
-> Getting (Endo [Referenced Schema]) Schema (Referenced Schema)
-> [Referenced Schema]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Referenced Schema]) Schema (Referenced Schema)
forall s a. (Data s, Typeable a) => Traversal' s a
template)

    schemaRefNames :: Referenced Schema -> Declare [T.Text] ()
    schemaRefNames :: Referenced Schema -> Declare [Text] ()
schemaRefNames Referenced Schema
ref = case Referenced Schema
ref of
      Ref (Reference Text
name) -> do
        Bool
seen <- ([Text] -> Bool) -> DeclareT [Text] Identity Bool
forall d (m :: * -> *) a. MonadDeclare d m => (d -> a) -> m a
looks (Text
name Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
        Bool -> Declare [Text] () -> Declare [Text] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
seen) (Declare [Text] () -> Declare [Text] ())
-> Declare [Text] () -> Declare [Text] ()
forall a b. (a -> b) -> a -> b
$ do
          [Text] -> Declare [Text] ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare [Text
Item [Text]
name]
          (Schema -> Declare [Text] ()) -> Maybe Schema -> Declare [Text] ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Schema -> Declare [Text] ()
usedNames (Text -> Definitions Schema -> Maybe Schema
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Text
name Definitions Schema
defs)
      Inline Schema
subschema -> Schema -> Declare [Text] ()
usedNames Schema
subschema

-- | Default schema for binary data (any sequence of octets).
binarySchema :: Schema
binarySchema :: Schema
binarySchema = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"binary"

-- | Default schema for binary data (base64 encoded).
byteSchema :: Schema
byteSchema :: Schema
byteSchema = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"byte"

-- | Default schema for password string.
-- @"password"@ format is used to hint UIs the input needs to be obscured.
passwordSchema :: Schema
passwordSchema :: Schema
passwordSchema = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"password"

-- | 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\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"number\"}},\"example\":{\"age\":25,\"name\":\"Jack\"},\"type\":\"object\"}"
sketchSchema :: ToJSON a => a -> Schema
sketchSchema :: a -> Schema
sketchSchema = Value -> Schema
sketch (Value -> Schema) -> (a -> Value) -> a -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON
  where
    sketch :: Value -> Schema
sketch Value
Null = Value -> Schema
go Value
Null
    sketch js :: Value
js@(Bool Bool
_) = Value -> Schema
go Value
js
    sketch Value
js = Value -> Schema
go Value
js Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
js

    go :: Value -> Schema
go Value
Null       = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerNull
    go (Bool Bool
_)   = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerBoolean
    go (String Text
_) = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
    go (Number Scientific
_) = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerNumber
    go (Array Array
xs) = Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_   ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerItems 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasItems s a => Lens' s a
items ((Maybe (SwaggerItems 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerItems 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ case Maybe Schema
ischema of
          Just Schema
s -> Referenced Schema -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsObject (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
s)
          Maybe Schema
_      -> [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsArray ((Schema -> Referenced Schema) -> [Schema] -> [Referenced Schema]
forall a b. (a -> b) -> [a] -> [b]
map Schema -> Referenced Schema
forall a. a -> Referenced a
Inline [Schema]
ys)
      where
        ys :: [Schema]
ys = (Value -> Schema) -> [Value] -> [Schema]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Schema
go (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs)
        allSame :: Bool
allSame = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((Schema -> Schema -> Bool) -> [Schema] -> [Schema] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
(==)) [Schema]
ys ([Schema] -> [Schema]
forall a. [a] -> [a]
tail [Schema]
ys))

        ischema :: Maybe Schema
ischema = case [Schema]
ys of
          (Schema
z:[Schema]
_) | Bool
allSame -> Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
z
          [Schema]
_               -> Maybe Schema
forall a. Maybe a
Nothing
    go (Object Object
o') = let o :: HashMap Text Value
o = Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KM.toHashMapText Object
o' in Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_         ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required      (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Value
o
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties    ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Value -> Referenced Schema)
-> InsOrdHashMap Text Value
-> InsOrdHashMap Text (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema)
-> (Value -> Schema) -> Value -> Referenced Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Schema
go) (HashMap Text Value -> InsOrdHashMap Text Value
forall k v. HashMap k v -> InsOrdHashMap k v
InsOrdHashMap.fromHashMap HashMap Text Value
o)

-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
-- Produced schema uses as much constraints as possible.
--
-- >>> encode $ sketchStrictSchema "hello"
-- "{\"enum\":[\"hello\"],\"maxLength\":5,\"minLength\":5,\"pattern\":\"hello\",\"type\":\"string\"}"
--
-- >>> encode $ sketchStrictSchema (1, 2, 3)
-- "{\"enum\":[[1,2,3]],\"items\":[{\"enum\":[1],\"maximum\":1,\"minimum\":1,\"multipleOf\":1,\"type\":\"number\"},{\"enum\":[2],\"maximum\":2,\"minimum\":2,\"multipleOf\":2,\"type\":\"number\"},{\"enum\":[3],\"maximum\":3,\"minimum\":3,\"multipleOf\":3,\"type\":\"number\"}],\"maxItems\":3,\"minItems\":3,\"type\":\"array\",\"uniqueItems\":true}"
--
-- >>> encode $ sketchStrictSchema ("Jack", 25)
-- "{\"enum\":[[\"Jack\",25]],\"items\":[{\"enum\":[\"Jack\"],\"maxLength\":4,\"minLength\":4,\"pattern\":\"Jack\",\"type\":\"string\"},{\"enum\":[25],\"maximum\":25,\"minimum\":25,\"multipleOf\":25,\"type\":\"number\"}],\"maxItems\":2,\"minItems\":2,\"type\":\"array\",\"uniqueItems\":true}"
--
-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
-- >>> instance ToJSON Person
-- >>> encode $ sketchStrictSchema (Person "Jack" 25)
-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"enum\":[\"Jack\"],\"maxLength\":4,\"minLength\":4,\"pattern\":\"Jack\",\"type\":\"string\"},\"age\":{\"enum\":[25],\"maximum\":25,\"minimum\":25,\"multipleOf\":25,\"type\":\"number\"}},\"maxProperties\":2,\"minProperties\":2,\"enum\":[{\"age\":25,\"name\":\"Jack\"}],\"type\":\"object\"}"
sketchStrictSchema :: ToJSON a => a -> Schema
sketchStrictSchema :: a -> Schema
sketchStrictSchema = Value -> Schema
go (Value -> Schema) -> (a -> Value) -> a -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON
  where
    go :: Value -> Schema
go Value
Null       = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerNull
    go js :: Value
js@(Bool Bool
_) = Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerBoolean
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Value
Item [Value]
js]
    go js :: Value
js@(String Text
s) = Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMaxLength s a => Lens' s a
maxLength ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Integer -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
s)
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMinLength s a => Lens' s a
minLength ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Integer -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
s)
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasPattern s a => Lens' s a
pattern   ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
s
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
enum_     ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Value
Item [Value]
js]
    go js :: Value
js@(Number Scientific
n) = Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_       ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerNumber
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> Schema -> Identity Schema
forall s a. HasMaximum s a => Lens' s a
maximum_    ((Maybe Scientific -> Identity (Maybe Scientific))
 -> Schema -> Identity Schema)
-> Scientific -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific
n
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> Schema -> Identity Schema
forall s a. HasMinimum s a => Lens' s a
minimum_    ((Maybe Scientific -> Identity (Maybe Scientific))
 -> Schema -> Identity Schema)
-> Scientific -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific
n
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> Schema -> Identity Schema
forall s a. HasMultipleOf s a => Lens' s a
multipleOf  ((Maybe Scientific -> Identity (Maybe Scientific))
 -> Schema -> Identity Schema)
-> Scientific -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific
n
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
enum_       ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Value
Item [Value]
js]
    go js :: Value
js@(Array Array
xs) = Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_       ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMaxItems s a => Lens' s a
maxItems    ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Integer -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMinItems s a => Lens' s a
minItems    ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Integer -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerItems 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasItems s a => Lens' s a
items       ((Maybe (SwaggerItems 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerItems 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsArray ((Value -> Referenced Schema) -> [Value] -> [Referenced Schema]
forall a b. (a -> b) -> [a] -> [b]
map (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema)
-> (Value -> Schema) -> Value -> Referenced Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Schema
go) (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs))
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Schema -> Identity Schema
forall s a. HasUniqueItems s a => Lens' s a
uniqueItems ((Maybe Bool -> Identity (Maybe Bool))
 -> Schema -> Identity Schema)
-> Bool -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
allUnique
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
enum_       ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Value
Item [Value]
js]
      where
        sz :: Int
sz = Array -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Array
xs
        allUnique :: Bool
allUnique = Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== HashSet Value -> Int
forall a. HashSet a -> Int
HashSet.size ([Value] -> HashSet Value
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs))
    go js :: Value
js@(Object Object
o') = let o :: HashMap Text Value
o = Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KM.toHashMapText Object
o' in Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_         ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required      (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text]
names
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties    ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Value -> Referenced Schema)
-> InsOrdHashMap Text Value
-> InsOrdHashMap Text (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema)
-> (Value -> Schema) -> Value -> Referenced Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Schema
go) (HashMap Text Value -> InsOrdHashMap Text Value
forall k v. HashMap k v -> InsOrdHashMap k v
InsOrdHashMap.fromHashMap HashMap Text Value
o)
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMaxProperties s a => Lens' s a
maxProperties ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Integer -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names)
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMinProperties s a => Lens' s a
minProperties ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Integer -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names)
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
enum_         ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Value
Item [Value]
js]
      where
        names :: [Text]
names = HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KM.toHashMapText Object
o')

class GToSchema (f :: * -> *) where
  gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
  declareNamedSchema :: Proxy [a] -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy [a]
_ = do
    Referenced Schema
ref <- Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema -> NamedSchema
unnamed (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerItems 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasItems s a => Lens' s a
items ((Maybe (SwaggerItems 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerItems 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsObject Referenced Schema
ref

instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema :: Proxy String -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy String -> Schema)
-> Proxy String
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy String -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Bool    where declareNamedSchema :: Proxy Bool -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Bool -> Schema)
-> Proxy Bool
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Bool -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Integer where declareNamedSchema :: Proxy Integer -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Integer -> Schema)
-> Proxy Integer
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Integer -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Natural where declareNamedSchema :: Proxy Natural -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Natural -> Schema)
-> Proxy Natural
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Natural -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Int     where declareNamedSchema :: Proxy Int -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Int -> Schema)
-> Proxy Int
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Int -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Int8    where declareNamedSchema :: Proxy Int8 -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Int8 -> Schema)
-> Proxy Int8
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Int8 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Int16   where declareNamedSchema :: Proxy Int16 -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Int16 -> Schema)
-> Proxy Int16
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Int16 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Int32   where declareNamedSchema :: Proxy Int32 -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Int32 -> Schema)
-> Proxy Int32
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Int32 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Int64   where declareNamedSchema :: Proxy Int64 -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Int64 -> Schema)
-> Proxy Int64
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Int64 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Word    where declareNamedSchema :: Proxy Word -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Word -> Schema)
-> Proxy Word
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Word -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Word8   where declareNamedSchema :: Proxy Word8 -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Word8 -> Schema)
-> Proxy Word8
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Word8 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Word16  where declareNamedSchema :: Proxy Word16 -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Word16 -> Schema)
-> Proxy Word16
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Word16 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Word32  where declareNamedSchema :: Proxy Word32 -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Word32 -> Schema)
-> Proxy Word32
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Word32 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Word64  where declareNamedSchema :: Proxy Word64 -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Word64 -> Schema)
-> Proxy Word64
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Word64 -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema

instance ToSchema Char where
  declareNamedSchema :: Proxy Char -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Char
proxy = Schema -> Declare (Definitions Schema) NamedSchema
plain (Proxy Char -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema Proxy Char
proxy)
    Declare (Definitions Schema) NamedSchema
-> (Declare (Definitions Schema) NamedSchema
    -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
forall a b. a -> (a -> b) -> b
& (NamedSchema -> Identity NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Identity (Declare (Definitions Schema) NamedSchema)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped((NamedSchema -> Identity NamedSchema)
 -> Declare (Definitions Schema) NamedSchema
 -> Identity (Declare (Definitions Schema) NamedSchema))
-> ((Maybe Value -> Identity (Maybe Value))
    -> NamedSchema -> Identity NamedSchema)
-> (Maybe Value -> Identity (Maybe Value))
-> Declare (Definitions Schema) NamedSchema
-> Identity (Declare (Definitions Schema) NamedSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Schema -> Identity Schema) -> NamedSchema -> Identity NamedSchema
forall s a. HasSchema s a => Lens' s a
Swagger.schema((Schema -> Identity Schema)
 -> NamedSchema -> Identity NamedSchema)
-> ((Maybe Value -> Identity (Maybe Value))
    -> Schema -> Identity Schema)
-> (Maybe Value -> Identity (Maybe Value))
-> NamedSchema
-> Identity NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Declare (Definitions Schema) NamedSchema
 -> Identity (Declare (Definitions Schema) NamedSchema))
-> Value
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Char -> Value
forall a. ToJSON a => a -> Value
toJSON Char
'?'

instance ToSchema Scientific  where declareNamedSchema :: Proxy Scientific -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Scientific -> Schema)
-> Proxy Scientific
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Scientific -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Double      where declareNamedSchema :: Proxy Double -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Double -> Schema)
-> Proxy Double
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Double -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Float       where declareNamedSchema :: Proxy Float -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Float -> Schema)
-> Proxy Float
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Float -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema

instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema :: Proxy (Fixed a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy (Fixed a) -> Schema)
-> Proxy (Fixed a)
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (Fixed a) -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema

instance ToSchema a => ToSchema (Maybe a) where
  declareNamedSchema :: Proxy (Maybe a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Maybe a)
_ = Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance (ToSchema a, ToSchema b) => ToSchema (Either a b)

instance ToSchema () where
  declareNamedSchema :: Proxy () -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ()
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
nullarySchema)

-- | For 'ToJSON' instance, see <http://hackage.haskell.org/package/uuid-aeson uuid-aeson> package.
instance ToSchema UUID.UUID where
  declareNamedSchema :: Proxy UUID -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy UUID
p = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> NamedSchema
named Text
"UUID" (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Proxy UUID -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema Proxy UUID
p
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
forall a. ToJSON a => a -> Value
toJSON (UUID -> Text
UUID.toText UUID
UUID.nil)

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

timeSchema :: T.Text -> Schema
timeSchema :: Text -> Schema
timeSchema Text
fmt = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
fmt

-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
instance ToSchema Day where
  declareNamedSchema :: Proxy Day -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Day
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> NamedSchema
named Text
"Day" (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema
timeSchema Text
"date"
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Day -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Int -> Int -> Day
fromGregorian Integer
2016 Int
7 Int
22)

-- |
-- >>> toSchema (Proxy :: Proxy LocalTime) ^. format
-- Just "yyyy-mm-ddThh:MM:ss"
instance ToSchema LocalTime where
  declareNamedSchema :: Proxy LocalTime -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy LocalTime
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> NamedSchema
named Text
"LocalTime" (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema
timeSchema Text
"yyyy-mm-ddThh:MM:ss"
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ LocalTime -> Value
forall a. ToJSON a => a -> Value
toJSON (Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
2016 Int
7 Int
22) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
7 Int
40 Pico
0))

-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
instance ToSchema ZonedTime where
  declareNamedSchema :: Proxy ZonedTime -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ZonedTime
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> NamedSchema
named Text
"ZonedTime" (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema
timeSchema Text
"date-time"
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ZonedTime -> Value
forall a. ToJSON a => a -> Value
toJSON (LocalTime -> TimeZone -> ZonedTime
ZonedTime (Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
2016 Int
7 Int
22) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
7 Int
40 Pico
0)) (Int -> TimeZone
hoursToTimeZone Int
3))

instance ToSchema NominalDiffTime where
  declareNamedSchema :: Proxy NominalDiffTime -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy NominalDiffTime
_ = Proxy Pico -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy Pico
forall k (t :: k). Proxy t
Proxy :: Proxy Pico)

-- |
-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
-- Just "yyyy-mm-ddThh:MM:ssZ"
instance ToSchema UTCTime where
  declareNamedSchema :: Proxy UTCTime -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy UTCTime
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> NamedSchema
named Text
"UTCTime" (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema
timeSchema Text
"yyyy-mm-ddThh:MM:ssZ"
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON (Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
2016 Int
7 Int
22) DiffTime
0)

instance ToSchema T.Text where declareNamedSchema :: Proxy Text -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Text -> Schema)
-> Proxy Text
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema TL.Text where declareNamedSchema :: Proxy Text -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Text -> Schema)
-> Proxy Text
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema

instance ToSchema Version where declareNamedSchema :: Proxy Version -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Version -> Schema)
-> Proxy Version
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Version -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema

type family ToSchemaByteStringError bs where
  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." )

instance ToSchemaByteStringError BS.ByteString  => ToSchema BS.ByteString  where declareNamedSchema :: Proxy ByteString -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = String
-> Proxy ByteString -> Declare (Definitions Schema) NamedSchema
forall a. HasCallStack => String -> a
error String
"impossible"
instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where declareNamedSchema :: Proxy ByteString -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = String
-> Proxy ByteString -> Declare (Definitions Schema) NamedSchema
forall a. HasCallStack => String -> a
error String
"impossible"

instance ToSchema IntSet where declareNamedSchema :: Proxy IntSet -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy IntSet
_ = Proxy (Set Int) -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy (Set Int)
forall k (t :: k). Proxy t
Proxy :: Proxy (Set Int))

-- | NOTE: This schema does not account for the uniqueness of keys.
instance ToSchema a => ToSchema (IntMap a) where
  declareNamedSchema :: Proxy (IntMap a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (IntMap a)
_ = Proxy [(Int, a)] -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy [(Int, a)]
forall k (t :: k). Proxy t
Proxy :: Proxy [(Int, a)])

instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
  declareNamedSchema :: Proxy (Map k v) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Map k v)
_ = case ToJSONKeyFunction k
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey :: ToJSONKeyFunction k of
      ToJSONKeyText  k -> Key
_ k -> Encoding' Key
_ -> Declare (Definitions Schema) NamedSchema
declareObjectMapSchema
      ToJSONKeyValue k -> Value
_ k -> Encoding
_ -> Proxy [(k, v)] -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy [(k, v)]
forall k (t :: k). Proxy t
Proxy :: Proxy [(k, v)])
    where
      declareObjectMapSchema :: Declare (Definitions Schema) NamedSchema
declareObjectMapSchema = do
        Referenced Schema
schema <- Proxy v -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy v
forall k (t :: k). Proxy t
Proxy :: Proxy v)
        NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema -> NamedSchema
unnamed (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe AdditionalProperties
 -> Identity (Maybe AdditionalProperties))
-> Schema -> Identity Schema
forall s a. HasAdditionalProperties s a => Lens' s a
additionalProperties ((Maybe AdditionalProperties
  -> Identity (Maybe AdditionalProperties))
 -> Schema -> Identity Schema)
-> AdditionalProperties -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> AdditionalProperties
AdditionalPropertiesSchema Referenced Schema
schema

instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
  declareNamedSchema :: Proxy (HashMap k v) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (HashMap k v)
_ = Proxy (Map k v) -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy (Map k v)
forall k (t :: k). Proxy t
Proxy :: Proxy (Map k v))

instance {-# OVERLAPPING #-} ToSchema Object where
  declareNamedSchema :: Proxy Object -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Object
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Object") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
description ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Arbitrary JSON object."
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe AdditionalProperties
 -> Identity (Maybe AdditionalProperties))
-> Schema -> Identity Schema
forall s a. HasAdditionalProperties s a => Lens' s a
additionalProperties ((Maybe AdditionalProperties
  -> Identity (Maybe AdditionalProperties))
 -> Schema -> Identity Schema)
-> AdditionalProperties -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> AdditionalProperties
AdditionalPropertiesAllowed Bool
True

instance ToSchema a => ToSchema (V.Vector a) where declareNamedSchema :: Proxy (Vector a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Vector a)
_ = Proxy [a] -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
instance ToSchema a => ToSchema (VU.Vector a) where declareNamedSchema :: Proxy (Vector a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Vector a)
_ = Proxy [a] -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
instance ToSchema a => ToSchema (VS.Vector a) where declareNamedSchema :: Proxy (Vector a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Vector a)
_ = Proxy [a] -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
instance ToSchema a => ToSchema (VP.Vector a) where declareNamedSchema :: Proxy (Vector a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Vector a)
_ = Proxy [a] -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])

instance ToSchema a => ToSchema (Set a) where
  declareNamedSchema :: Proxy (Set a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Set a)
_ = do
    Schema
schema <- Proxy [a] -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema -> NamedSchema
unnamed (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
schema
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Schema -> Identity Schema
forall s a. HasUniqueItems s a => Lens' s a
uniqueItems ((Maybe Bool -> Identity (Maybe Bool))
 -> Schema -> Identity Schema)
-> Bool -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True

instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema :: Proxy (HashSet a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (HashSet a)
_ = Proxy (Set a) -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy (Set a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Set a))

-- | @since 2.2.1
instance ToSchema a => ToSchema (NonEmpty a) where
  declareNamedSchema :: Proxy (NonEmpty a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (NonEmpty a)
_ = do
    Schema
schema <- Proxy [a] -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema -> NamedSchema
unnamed (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
schema
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMinItems s a => Lens' s a
minItems ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Maybe Integer -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1

instance ToSchema All where declareNamedSchema :: Proxy All -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy All -> Schema)
-> Proxy All
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy All -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema
instance ToSchema Any where declareNamedSchema :: Proxy Any -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Schema -> Declare (Definitions Schema) NamedSchema
plain (Schema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy Any -> Schema)
-> Proxy Any
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Any -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema

instance ToSchema a => ToSchema (Sum a)     where declareNamedSchema :: Proxy (Sum a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Sum a)
_ = NamedSchema -> NamedSchema
unname (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance ToSchema a => ToSchema (Product a) where declareNamedSchema :: Proxy (Product a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Product a)
_ = NamedSchema -> NamedSchema
unname (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance ToSchema a => ToSchema (First a)   where declareNamedSchema :: Proxy (First a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (First a)
_ = NamedSchema -> NamedSchema
unname (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance ToSchema a => ToSchema (Last a)    where declareNamedSchema :: Proxy (Last a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Last a)
_ = NamedSchema -> NamedSchema
unname (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance ToSchema a => ToSchema (Dual a)    where declareNamedSchema :: Proxy (Dual a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Dual a)
_ = NamedSchema -> NamedSchema
unname (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance ToSchema a => ToSchema (Identity a) where declareNamedSchema :: Proxy (Identity a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Identity a)
_ = Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

-- | Default schema for @'Bounded'@, @'Integral'@ types.
--
-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
toSchemaBoundedIntegral :: Proxy a -> Schema
toSchemaBoundedIntegral Proxy a
_ = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerInteger
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> Schema -> Identity Schema
forall s a. HasMinimum s a => Lens' s a
minimum_ ((Maybe Scientific -> Identity (Maybe Scientific))
 -> Schema -> Identity Schema)
-> Scientific -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a))
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> Schema -> Identity Schema
forall s a. HasMaximum s a => Lens' s a
maximum_ ((Maybe Scientific -> Identity (Maybe Scientific))
 -> Schema -> Identity Schema)
-> Scientific -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a))

-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
genericToNamedSchemaBoundedIntegral :: forall a d f.
  ( Bounded a, Integral a
  , Generic a, Rep a ~ D1 d f, Datatype d)
  => SchemaOptions -> Proxy a -> NamedSchema
genericToNamedSchemaBoundedIntegral :: SchemaOptions -> Proxy a -> NamedSchema
genericToNamedSchemaBoundedIntegral SchemaOptions
opts Proxy a
proxy
  = SchemaOptions -> Proxy a -> Schema -> NamedSchema
forall a (d :: Meta) (f :: * -> *).
(Generic a, Rep a ~ D1 d f, Datatype d) =>
SchemaOptions -> Proxy a -> Schema -> NamedSchema
genericNameSchema SchemaOptions
opts Proxy a
proxy (Proxy a -> Schema
forall a. (Bounded a, Integral a) => Proxy a -> Schema
toSchemaBoundedIntegral Proxy a
proxy)

-- | Declare a named schema for a @newtype@ wrapper.
genericDeclareNamedSchemaNewtype :: forall a d c s i inner.
  (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))
  => SchemaOptions                                          -- ^ How to derive the name.
  -> (Proxy inner -> Declare (Definitions Schema) Schema)   -- ^ How to create a schema for the wrapped type.
  -> Proxy a
  -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaNewtype :: SchemaOptions
-> (Proxy inner -> Declare (Definitions Schema) Schema)
-> Proxy a
-> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaNewtype SchemaOptions
opts Proxy inner -> Declare (Definitions Schema) Schema
f Proxy a
proxy = SchemaOptions -> Proxy a -> Schema -> NamedSchema
forall a (d :: Meta) (f :: * -> *).
(Generic a, Rep a ~ D1 d f, Datatype d) =>
SchemaOptions -> Proxy a -> Schema -> NamedSchema
genericNameSchema SchemaOptions
opts Proxy a
proxy (Schema -> NamedSchema)
-> Declare (Definitions Schema) Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy inner -> Declare (Definitions Schema) Schema
f (Proxy inner
forall k (t :: k). Proxy t
Proxy :: Proxy inner)

-- | Declare 'Schema' for a mapping with 'Bounded' 'Enum' keys.
-- This makes a much more useful schema when there aren't many options for key values.
--
-- >>> data ButtonState = Neutral | Focus | Active | Hover | Disabled deriving (Show, Bounded, Enum, Generic)
-- >>> instance ToJSON ButtonState
-- >>> instance ToSchema ButtonState
-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
-- >>> type ImageUrl = T.Text
-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
-- "{\"properties\":{\"Neutral\":{\"type\":\"string\"},\"Focus\":{\"type\":\"string\"},\"Active\":{\"type\":\"string\"},\"Hover\":{\"type\":\"string\"},\"Disabled\":{\"type\":\"string\"}},\"type\":\"object\"}"
--
-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
declareSchemaBoundedEnumKeyMapping :: forall map key value.
  (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
  => Proxy (map key value) -> Declare (Definitions Schema) Schema
declareSchemaBoundedEnumKeyMapping :: Proxy (map key value) -> Declare (Definitions Schema) Schema
declareSchemaBoundedEnumKeyMapping Proxy (map key value)
_ = case ToJSONKeyFunction key
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey :: ToJSONKeyFunction key of
  ToJSONKeyText key -> Key
keyToText key -> Encoding' Key
_ -> (key -> Key) -> Declare (Definitions Schema) Schema
objectSchema key -> Key
keyToText
  ToJSONKeyValue key -> Value
_ key -> Encoding
_ -> Proxy [(key, value)] -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy [(key, value)]
forall k (t :: k). Proxy t
Proxy :: Proxy [(key, value)])
  where
    objectSchema :: (key -> Key) -> Declare (Definitions Schema) Schema
objectSchema key -> Key
keyToText = do
      Referenced Schema
valueRef <- Proxy value -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy value
forall k (t :: k). Proxy t
Proxy :: Proxy value)
      let allKeys :: [key]
allKeys   = [Item [key]
forall a. Bounded a => a
minBound..key
forall a. Bounded a => a
maxBound :: key]
          mkPair :: key -> (Text, Referenced Schema)
mkPair key
k  = (Key -> Text
toText (Key -> Text) -> Key -> Text
forall a b. (a -> b) -> a -> b
$ key -> Key
keyToText key
k, Referenced Schema
valueRef)
      Schema -> Declare (Definitions Schema) Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Declare (Definitions Schema) Schema)
-> Schema -> Declare (Definitions Schema) Schema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_      ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList ((key -> (Text, Referenced Schema))
-> [key] -> [(Text, Referenced Schema)]
forall a b. (a -> b) -> [a] -> [b]
map key -> (Text, Referenced Schema)
mkPair [key]
allKeys)

-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
-- This makes a much more useful schema when there aren't many options for key values.
--
-- >>> data ButtonState = Neutral | Focus | Active | Hover | Disabled deriving (Show, Bounded, Enum, Generic)
-- >>> instance ToJSON ButtonState
-- >>> instance ToSchema ButtonState
-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
-- >>> type ImageUrl = T.Text
-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
-- "{\"properties\":{\"Neutral\":{\"type\":\"string\"},\"Focus\":{\"type\":\"string\"},\"Active\":{\"type\":\"string\"},\"Hover\":{\"type\":\"string\"},\"Disabled\":{\"type\":\"string\"}},\"type\":\"object\"}"
--
-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
toSchemaBoundedEnumKeyMapping :: forall map key value.
  (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
  => Proxy (map key value) -> Schema
toSchemaBoundedEnumKeyMapping :: Proxy (map key value) -> Schema
toSchemaBoundedEnumKeyMapping = (Declare (Definitions Schema) Schema
 -> Definitions Schema -> Schema)
-> Definitions Schema
-> Declare (Definitions Schema) Schema
-> Schema
forall a b c. (a -> b -> c) -> b -> a -> c
flip Declare (Definitions Schema) Schema -> Definitions Schema -> Schema
forall d a. Declare d a -> d -> a
evalDeclare Definitions Schema
forall a. Monoid a => a
mempty (Declare (Definitions Schema) Schema -> Schema)
-> (Proxy (map key value) -> Declare (Definitions Schema) Schema)
-> Proxy (map key value)
-> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (map key value) -> Declare (Definitions Schema) Schema
forall k (map :: * -> * -> k) key value.
(Bounded key, Enum key, ToJSONKey key, ToSchema key,
 ToSchema value) =>
Proxy (map key value) -> Declare (Definitions Schema) Schema
declareSchemaBoundedEnumKeyMapping

-- | A configurable generic @'Schema'@ creator.
genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
  SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
genericDeclareSchema :: SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
genericDeclareSchema = SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
forall a.
(Generic a, GToSchema (Rep a)) =>
SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
genericDeclareSchemaUnrestricted

-- | 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'@.
genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
  SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema :: SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema = SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a)) =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaUnrestricted

-- | A configurable generic @'Schema'@ creator.
--
-- Unlike 'genericDeclareSchema' also works for mixed sum types.
-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
genericDeclareSchemaUnrestricted :: SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
genericDeclareSchemaUnrestricted SchemaOptions
opts Proxy a
proxy = NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a)) =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaUnrestricted SchemaOptions
opts Proxy a
proxy

-- | A configurable generic @'NamedSchema'@ creator.
--
-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>
  SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaUnrestricted :: SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaUnrestricted SchemaOptions
opts Proxy a
_ = SchemaOptions
-> Proxy (Rep a)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts (Proxy (Rep a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Rep a)) Schema
forall a. Monoid a => a
mempty

-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
genericNameSchema :: forall a d f.
  (Generic a, Rep a ~ D1 d f, Datatype d)
  => SchemaOptions -> Proxy a -> Schema -> NamedSchema
genericNameSchema :: SchemaOptions -> Proxy a -> Schema -> NamedSchema
genericNameSchema SchemaOptions
opts Proxy a
_ = Maybe Text -> Schema -> NamedSchema
NamedSchema (SchemaOptions -> Proxy d -> Maybe Text
forall k (d :: k).
Datatype d =>
SchemaOptions -> Proxy d -> Maybe Text
gdatatypeSchemaName SchemaOptions
opts (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d))

gdatatypeSchemaName :: forall d. Datatype d => SchemaOptions -> Proxy d -> Maybe T.Text
gdatatypeSchemaName :: SchemaOptions -> Proxy d -> Maybe Text
gdatatypeSchemaName SchemaOptions
opts Proxy d
_ = case String
orig of
  (Char
c:String
_) | Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
name)
  String
_ -> Maybe Text
forall a. Maybe a
Nothing
  where
    orig :: String
orig = Proxy3 d Any Any -> String
forall k (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName (forall k k (f :: k) (a :: k). Proxy3 d f a
forall k k k (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 d f a)
    name :: String
name = SchemaOptions -> String -> String
datatypeNameModifier SchemaOptions
opts String
orig

-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
  SchemaOptions -> Proxy a -> NamedSchema
paramSchemaToNamedSchema :: SchemaOptions -> Proxy a -> NamedSchema
paramSchemaToNamedSchema SchemaOptions
opts Proxy a
proxy = SchemaOptions -> Proxy a -> Schema -> NamedSchema
forall a (d :: Meta) (f :: * -> *).
(Generic a, Rep a ~ D1 d f, Datatype d) =>
SchemaOptions -> Proxy a -> Schema -> NamedSchema
genericNameSchema SchemaOptions
opts Proxy a
proxy (Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema Proxy a
proxy)

-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema :: Proxy a -> Schema
paramSchemaToSchema Proxy a
proxy = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (ParamSchema 'SwaggerKindSchema
 -> Identity (ParamSchema 'SwaggerKindSchema))
-> Schema -> Identity Schema
forall s a. HasParamSchema s a => Lens' s a
paramSchema ((ParamSchema 'SwaggerKindSchema
  -> Identity (ParamSchema 'SwaggerKindSchema))
 -> Schema -> Identity Schema)
-> ParamSchema 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proxy a -> ParamSchema 'SwaggerKindSchema
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema Proxy a
proxy

nullarySchema :: Schema
nullarySchema :: Schema
nullarySchema = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerItems 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasItems s a => Lens' s a
items ((Maybe (SwaggerItems 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerItems 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsArray []

gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
gtoNamedSchema :: SchemaOptions -> Proxy f -> NamedSchema
gtoNamedSchema SchemaOptions
opts Proxy f
proxy = Declare (Definitions Schema) NamedSchema -> NamedSchema
forall d a. Monoid d => Declare d a -> a
undeclare (Declare (Definitions Schema) NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy f
proxy Schema
forall a. Monoid a => a
mempty

gdeclareSchema :: GToSchema f => SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema
gdeclareSchema :: SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema
gdeclareSchema SchemaOptions
opts Proxy f
proxy = NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy f
proxy Schema
forall a. Monoid a => a
mempty

instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (f :*: g)
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy (f :*: g)
_ Schema
schema = do
    NamedSchema Maybe Text
_ Schema
gschema <- SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) Schema
schema
    SchemaOptions
-> Proxy g -> Schema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts (Proxy g
forall k (t :: k). Proxy t
Proxy :: Proxy g) Schema
gschema

instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (D1 d f)
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy (D1 d f)
_ Schema
s = Maybe Text -> NamedSchema -> NamedSchema
rename Maybe Text
name (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) Schema
s
    where
      name :: Maybe Text
name = SchemaOptions -> Proxy d -> Maybe Text
forall k (d :: k).
Datatype d =>
SchemaOptions -> Proxy d -> Maybe Text
gdatatypeSchemaName SchemaOptions
opts (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)

instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (C1 c f)
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy (C1 c f)
_ = SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)

instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (C1 c U1)
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema = SchemaOptions
-> Proxy (C1 c U1)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GSumToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSumSchema

-- | Single field constructor.
instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s f)) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (C1 c (S1 s f))
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy (C1 c (S1 s f))
_ Schema
s
    | SchemaOptions -> Bool
unwrapUnaryRecords SchemaOptions
opts = Declare (Definitions Schema) NamedSchema
fieldSchema
    | Bool
otherwise =
        case Schema
schema Schema
-> Getting
     (Maybe (SwaggerItems 'SwaggerKindSchema))
     Schema
     (Maybe (SwaggerItems 'SwaggerKindSchema))
-> Maybe (SwaggerItems 'SwaggerKindSchema)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (SwaggerItems 'SwaggerKindSchema))
  Schema
  (Maybe (SwaggerItems 'SwaggerKindSchema))
forall s a. HasItems s a => Lens' s a
items of
          Just (SwaggerItemsArray [Item [Referenced Schema]
_]) -> Declare (Definitions Schema) NamedSchema
fieldSchema
          Maybe (SwaggerItems 'SwaggerKindSchema)
_ -> do
            Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare Definitions Schema
defs
            NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> NamedSchema
unnamed Schema
schema)
    where
      (Definitions Schema
defs, NamedSchema Maybe Text
_ Schema
schema) = Declare (Definitions Schema) NamedSchema
-> Definitions Schema -> (Definitions Schema, NamedSchema)
forall d a. Declare d a -> d -> (d, a)
runDeclare Declare (Definitions Schema) NamedSchema
recordSchema Definitions Schema
forall a. Monoid a => a
mempty
      recordSchema :: Declare (Definitions Schema) NamedSchema
recordSchema = SchemaOptions
-> Proxy (S1 s f)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts (Proxy (S1 s f)
forall k (t :: k). Proxy t
Proxy :: Proxy (S1 s f)) Schema
s
      fieldSchema :: Declare (Definitions Schema) NamedSchema
fieldSchema  = SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) Schema
s

gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
gdeclareSchemaRef :: SchemaOptions
-> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
gdeclareSchemaRef SchemaOptions
opts Proxy a
proxy = do
  case SchemaOptions -> Proxy a -> NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions -> Proxy f -> NamedSchema
gtoNamedSchema SchemaOptions
opts Proxy a
proxy of
    NamedSchema (Just Text
name) Schema
schema -> do
      -- This check is very important as it allows generically
      -- derive used definitions for recursive schemas.
      -- Lazy Declare monad allows toNamedSchema to ignore
      -- any declarations (which would otherwise loop) and
      -- retrieve the schema and its name to check if we
      -- have already declared it.
      -- If we have, we don't need to declare anything for
      -- this schema this time and thus simply return the reference.
      Bool
known <- (Definitions Schema -> Bool)
-> DeclareT (Definitions Schema) Identity Bool
forall d (m :: * -> *) a. MonadDeclare d m => (d -> a) -> m a
looks (Text -> Definitions Schema -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
InsOrdHashMap.member Text
name)
      Bool
-> DeclareT (Definitions Schema) Identity ()
-> DeclareT (Definitions Schema) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
known) (DeclareT (Definitions Schema) Identity ()
 -> DeclareT (Definitions Schema) Identity ())
-> DeclareT (Definitions Schema) Identity ()
-> DeclareT (Definitions Schema) Identity ()
forall a b. (a -> b) -> a -> b
$ do
        Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare [(Text
name, Schema
schema)]
        Declare (Definitions Schema) NamedSchema
-> DeclareT (Definitions Schema) Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Declare (Definitions Schema) NamedSchema
 -> DeclareT (Definitions Schema) Identity ())
-> Declare (Definitions Schema) NamedSchema
-> DeclareT (Definitions Schema) Identity ()
forall a b. (a -> b) -> a -> b
$ SchemaOptions
-> Proxy a -> Schema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy a
proxy Schema
forall a. Monoid a => a
mempty
      Referenced Schema
-> Declare (Definitions Schema) (Referenced Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return (Referenced Schema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Referenced Schema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref (Text -> Reference
Reference Text
name)
    NamedSchema
_ -> Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema)
-> Declare (Definitions Schema) Schema
-> Declare (Definitions Schema) (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
forall (f :: * -> *).
GToSchema f =>
SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema
gdeclareSchema SchemaOptions
opts Proxy a
proxy

appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
appendItem :: Referenced Schema
-> Maybe (SwaggerItems 'SwaggerKindSchema)
-> Maybe (SwaggerItems 'SwaggerKindSchema)
appendItem Referenced Schema
x Maybe (SwaggerItems 'SwaggerKindSchema)
Nothing = SwaggerItems 'SwaggerKindSchema
-> Maybe (SwaggerItems 'SwaggerKindSchema)
forall a. a -> Maybe a
Just ([Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsArray [Item [Referenced Schema]
Referenced Schema
x])
appendItem Referenced Schema
x (Just (SwaggerItemsArray [Referenced Schema]
xs)) = SwaggerItems 'SwaggerKindSchema
-> Maybe (SwaggerItems 'SwaggerKindSchema)
forall a. a -> Maybe a
Just ([Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsArray ([Referenced Schema]
xs [Referenced Schema] -> [Referenced Schema] -> [Referenced Schema]
forall a. [a] -> [a] -> [a]
++ [Item [Referenced Schema]
Referenced Schema
x]))
appendItem Referenced Schema
_ Maybe (SwaggerItems 'SwaggerKindSchema)
_ = String -> Maybe (SwaggerItems 'SwaggerKindSchema)
forall a. HasCallStack => String -> a
error String
"GToSchema.appendItem: cannot append to SwaggerItemsObject"

withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
  SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
withFieldSchema :: SchemaOptions
-> proxy s f
-> Bool
-> Schema
-> Declare (Definitions Schema) Schema
withFieldSchema SchemaOptions
opts proxy s f
_ Bool
isRequiredField Schema
schema = do
  Referenced Schema
ref <- SchemaOptions
-> Proxy f -> Declare (Definitions Schema) (Referenced Schema)
forall (a :: * -> *).
GToSchema a =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
gdeclareSchemaRef SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)
  Schema -> Declare (Definitions Schema) Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Declare (Definitions Schema) Schema)
-> Schema -> Declare (Definitions Schema) Schema
forall a b. (a -> b) -> a -> b
$
    if Text -> Bool
T.null Text
fname
      then Schema
schema
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerItems 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasItems s a => Lens' s a
items ((Maybe (SwaggerItems 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerItems 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> (Maybe (SwaggerItems 'SwaggerKindSchema)
    -> Maybe (SwaggerItems 'SwaggerKindSchema))
-> Schema
-> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Referenced Schema
-> Maybe (SwaggerItems 'SwaggerKindSchema)
-> Maybe (SwaggerItems 'SwaggerKindSchema)
appendItem Referenced Schema
ref
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMaxItems s a => Lens' s a
maxItems ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> (Maybe Integer -> Maybe Integer) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Maybe Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (Integer -> Integer) -> Maybe Integer -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
1 (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)   -- increment maxItems
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMinItems s a => Lens' s a
minItems ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> (Maybe Integer -> Maybe Integer) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Maybe Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (Integer -> Integer) -> Maybe Integer -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
1 (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)   -- increment minItems
      else Schema
schema
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> ((Maybe (Referenced Schema)
     -> Identity (Maybe (Referenced Schema)))
    -> InsOrdHashMap Text (Referenced Schema)
    -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> (Maybe (Referenced Schema)
    -> Identity (Maybe (Referenced Schema)))
-> Schema
-> Identity Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap Text (Referenced Schema))
-> Lens'
     (InsOrdHashMap Text (Referenced Schema))
     (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (InsOrdHashMap Text (Referenced Schema))
fname ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Schema -> Identity Schema)
-> Referenced Schema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref
        Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& if Bool
isRequiredField
            then ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> ([Text] -> [Text]) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
fname])
            else Schema -> Schema
forall a. a -> a
id
  where
    fname :: Text
fname = String -> Text
T.pack (SchemaOptions -> String -> String
fieldLabelModifier SchemaOptions
opts (Proxy3 s f Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall k (p :: k). Proxy3 s f p
forall k k k (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 s f p)))

-- | Optional record fields.
instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (S1 s (K1 i (Maybe c)))
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy (S1 s (K1 i (Maybe c)))
_ = (Schema -> NamedSchema)
-> Declare (Definitions Schema) Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> NamedSchema
unnamed (Declare (Definitions Schema) Schema
 -> Declare (Definitions Schema) NamedSchema)
-> (Schema -> Declare (Definitions Schema) Schema)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaOptions
-> Proxy2 s (K1 i (Maybe c))
-> Bool
-> Schema
-> Declare (Definitions Schema) Schema
forall k (proxy :: k -> (* -> *) -> *) (s :: k) (f :: * -> *).
(Selector s, GToSchema f) =>
SchemaOptions
-> proxy s f
-> Bool
-> Schema
-> Declare (Definitions Schema) Schema
withFieldSchema SchemaOptions
opts (forall k. Proxy2 s (K1 i (Maybe c))
forall k k (a :: k) (b :: k). Proxy2 a b
Proxy2 :: Proxy2 s (K1 i (Maybe c))) Bool
False

-- | Record fields.
instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (S1 s f)
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
opts Proxy (S1 s f)
_ = (Schema -> NamedSchema)
-> Declare (Definitions Schema) Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> NamedSchema
unnamed (Declare (Definitions Schema) Schema
 -> Declare (Definitions Schema) NamedSchema)
-> (Schema -> Declare (Definitions Schema) Schema)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaOptions
-> Proxy2 s f
-> Bool
-> Schema
-> Declare (Definitions Schema) Schema
forall k (proxy :: k -> (* -> *) -> *) (s :: k) (f :: * -> *).
(Selector s, GToSchema f) =>
SchemaOptions
-> proxy s f
-> Bool
-> Schema
-> Declare (Definitions Schema) Schema
withFieldSchema SchemaOptions
opts (Proxy2 s f
forall k k (a :: k) (b :: k). Proxy2 a b
Proxy2 :: Proxy2 s f) Bool
True

instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (K1 i (Maybe c))
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
_ Proxy (K1 i (Maybe c))
_ Schema
_ = Proxy c -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c)

instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (K1 i c)
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema SchemaOptions
_ Proxy (K1 i c)
_ Schema
_ = Proxy c -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c)

instance ( GSumToSchema f
         , GSumToSchema g
         ) => GToSchema (f :+: g)
   where
  gdeclareNamedSchema :: SchemaOptions
-> Proxy (f :+: g)
-> Schema
-> Declare (Definitions Schema) NamedSchema
gdeclareNamedSchema = SchemaOptions
-> Proxy (f :+: g)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *).
GSumToSchema f =>
SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSumSchema

gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSumSchema :: SchemaOptions
-> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSumSchema SchemaOptions
opts Proxy f
proxy Schema
s
  | SchemaOptions -> Bool
allNullaryToStringTag SchemaOptions
opts Bool -> Bool -> Bool
&& Bool
allNullary = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema -> NamedSchema
unnamed (Schema -> Schema
forall s (f :: * -> *) a i b (t :: SwaggerKind *).
(HasProperties s (f a), ToJSON i, HasEnum b (Maybe [Value]),
 HasType b (Maybe (SwaggerType t)), Monoid b,
 FoldableWithIndex i f) =>
s -> b
toStringTag Schema
sumSchema)
  | Bool
otherwise = (Schema -> NamedSchema
unnamed (Schema -> NamedSchema)
-> ((Schema, All) -> Schema) -> (Schema, All) -> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema, All) -> Schema
forall a b. (a, b) -> a
fst) ((Schema, All) -> NamedSchema)
-> Declare (Definitions Schema) (Schema, All)
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT All (Declare (Definitions Schema)) Schema
-> Declare (Definitions Schema) (Schema, All)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT All (Declare (Definitions Schema)) Schema
declareSumSchema
  where
    declareSumSchema :: WriterT All (Declare (Definitions Schema)) Schema
declareSumSchema = SchemaOptions
-> Proxy f
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall (f :: * -> *).
GSumToSchema f =>
SchemaOptions
-> Proxy f
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
gsumToSchema SchemaOptions
opts Proxy f
proxy Schema
s
    (Schema
sumSchema, All Bool
allNullary) = Declare (Definitions Schema) (Schema, All) -> (Schema, All)
forall d a. Monoid d => Declare d a -> a
undeclare (WriterT All (Declare (Definitions Schema)) Schema
-> Declare (Definitions Schema) (Schema, All)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT All (Declare (Definitions Schema)) Schema
declareSumSchema)

    toStringTag :: s -> b
toStringTag s
schema = b
forall a. Monoid a => a
mempty
      b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> b -> Identity b
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> b -> Identity b)
-> SwaggerType t -> b -> b
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
      b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value])) -> b -> Identity b
forall s a. HasEnum s a => Lens' s a
enum_ ((Maybe [Value] -> Identity (Maybe [Value])) -> b -> Identity b)
-> [Value] -> b -> b
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (i -> Value) -> [i] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map i -> Value
forall a. ToJSON a => a -> Value
toJSON  (s
schema s -> Getting (Endo [i]) s i -> [i]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (f a -> Const (Endo [i]) (f a)) -> s -> Const (Endo [i]) s
forall s a. HasProperties s a => Lens' s a
properties((f a -> Const (Endo [i]) (f a)) -> s -> Const (Endo [i]) s)
-> ((i -> Const (Endo [i]) i) -> f a -> Const (Endo [i]) (f a))
-> Getting (Endo [i]) s i
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Indexed i a (Const (Endo [i]) a) -> f a -> Const (Endo [i]) (f a)
forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
ifolded(Indexed i a (Const (Endo [i]) a) -> f a -> Const (Endo [i]) (f a))
-> ((i -> Const (Endo [i]) i) -> Indexed i a (Const (Endo [i]) a))
-> (i -> Const (Endo [i]) i)
-> f a
-> Const (Endo [i]) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(i -> Const (Endo [i]) i) -> Indexed i a (Const (Endo [i]) a)
forall i (p :: * -> * -> *) (f :: * -> *) s.
(Indexable i p, Contravariant f, Functor f) =>
p i (f i) -> Indexed i s (f s)
asIndex)

type AllNullary = All

class GSumToSchema (f :: * -> *)  where
  gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema

instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
  gsumToSchema :: SchemaOptions
-> Proxy (f :+: g)
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
gsumToSchema SchemaOptions
opts Proxy (f :+: g)
_ = SchemaOptions
-> Proxy f
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall (f :: * -> *).
GSumToSchema f =>
SchemaOptions
-> Proxy f
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
gsumToSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) (Schema -> WriterT All (Declare (Definitions Schema)) Schema)
-> (Schema -> WriterT All (Declare (Definitions Schema)) Schema)
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> SchemaOptions
-> Proxy g
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall (f :: * -> *).
GSumToSchema f =>
SchemaOptions
-> Proxy f
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
gsumToSchema SchemaOptions
opts (Proxy g
forall k (t :: k). Proxy t
Proxy :: Proxy g)

gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
  Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
gsumConToSchemaWith :: Referenced Schema
-> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
gsumConToSchemaWith Referenced Schema
ref SchemaOptions
opts Proxy (C1 c f)
_ Schema
schema = Schema
schema
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> ((Maybe (Referenced Schema)
     -> Identity (Maybe (Referenced Schema)))
    -> InsOrdHashMap Text (Referenced Schema)
    -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> (Maybe (Referenced Schema)
    -> Identity (Maybe (Referenced Schema)))
-> Schema
-> Identity Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap Text (Referenced Schema))
-> Lens'
     (InsOrdHashMap Text (Referenced Schema))
     (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (InsOrdHashMap Text (Referenced Schema))
tag ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Schema -> Identity Schema)
-> Referenced Schema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMaxProperties s a => Lens' s a
maxProperties ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Integer -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer
1
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> Schema -> Identity Schema
forall s a. HasMinProperties s a => Lens' s a
minProperties ((Maybe Integer -> Identity (Maybe Integer))
 -> Schema -> Identity Schema)
-> Integer -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer
1
  where
    tag :: Text
tag = String -> Text
T.pack (SchemaOptions -> String -> String
constructorTagModifier SchemaOptions
opts (Proxy3 c f Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (forall k (p :: k). Proxy3 c f p
forall k k k (a :: k) (b :: k) (c :: k). Proxy3 a b c
Proxy3 :: Proxy3 c f p)))

gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
  SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
gsumConToSchema :: SchemaOptions
-> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
gsumConToSchema SchemaOptions
opts Proxy (C1 c f)
proxy Schema
schema = do
  Referenced Schema
ref <- SchemaOptions
-> Proxy (C1 c f)
-> Declare (Definitions Schema) (Referenced Schema)
forall (a :: * -> *).
GToSchema a =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
gdeclareSchemaRef SchemaOptions
opts Proxy (C1 c f)
proxy
  Schema -> Declare (Definitions Schema) Schema
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Declare (Definitions Schema) Schema)
-> Schema -> Declare (Definitions Schema) Schema
forall a b. (a -> b) -> a -> b
$ Referenced Schema
-> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
forall (c :: Meta) (f :: * -> *).
(GToSchema (C1 c f), Constructor c) =>
Referenced Schema
-> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
gsumConToSchemaWith Referenced Schema
ref SchemaOptions
opts Proxy (C1 c f)
proxy Schema
schema

instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
  gsumToSchema :: SchemaOptions
-> Proxy (C1 c f)
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
gsumToSchema SchemaOptions
opts Proxy (C1 c f)
proxy Schema
schema = do
    All -> WriterT All (Declare (Definitions Schema)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Bool -> All
All Bool
False)
    Declare (Definitions Schema) Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Declare (Definitions Schema) Schema
 -> WriterT All (Declare (Definitions Schema)) Schema)
-> Declare (Definitions Schema) Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall a b. (a -> b) -> a -> b
$ SchemaOptions
-> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
forall (c :: Meta) (f :: * -> *).
(GToSchema (C1 c f), Constructor c) =>
SchemaOptions
-> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
gsumConToSchema SchemaOptions
opts Proxy (C1 c f)
proxy Schema
schema

instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
  gsumToSchema :: SchemaOptions
-> Proxy (C1 c (S1 s f))
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
gsumToSchema SchemaOptions
opts Proxy (C1 c (S1 s f))
proxy Schema
schema = do
    All -> WriterT All (Declare (Definitions Schema)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Bool -> All
All Bool
False)
    Declare (Definitions Schema) Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Declare (Definitions Schema) Schema
 -> WriterT All (Declare (Definitions Schema)) Schema)
-> Declare (Definitions Schema) Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall a b. (a -> b) -> a -> b
$ SchemaOptions
-> Proxy (C1 c (S1 s f))
-> Schema
-> Declare (Definitions Schema) Schema
forall (c :: Meta) (f :: * -> *).
(GToSchema (C1 c f), Constructor c) =>
SchemaOptions
-> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
gsumConToSchema SchemaOptions
opts Proxy (C1 c (S1 s f))
proxy Schema
schema

instance Constructor c => GSumToSchema (C1 c U1) where
  gsumToSchema :: SchemaOptions
-> Proxy (C1 c U1)
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
gsumToSchema SchemaOptions
opts Proxy (C1 c U1)
proxy = Schema -> WriterT All (Declare (Definitions Schema)) Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> WriterT All (Declare (Definitions Schema)) Schema)
-> (Schema -> Schema)
-> Schema
-> WriterT All (Declare (Definitions Schema)) Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referenced Schema
-> SchemaOptions -> Proxy (C1 c U1) -> Schema -> Schema
forall (c :: Meta) (f :: * -> *).
(GToSchema (C1 c f), Constructor c) =>
Referenced Schema
-> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
gsumConToSchemaWith (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
nullarySchema) SchemaOptions
opts Proxy (C1 c U1)
proxy

data Proxy2 a b = Proxy2

data Proxy3 a b c = Proxy3

-- $setup
-- >>> import Data.Swagger
-- >>> import Data.Aeson (encode)
-- >>> import Data.Aeson.Types (toJSONKeyText)