{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
-- Generic a is redundant in  ToParamSchema a default imple
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- For TypeErrors
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
module Data.Swagger.Internal.ParamSchema where

import Control.Lens
import Data.Aeson (ToJSON (..))
import Data.Proxy
import GHC.Generics

import Data.Int
import "unordered-containers" Data.HashSet (HashSet)
import Data.Monoid
import Data.Set (Set)
import Data.Scientific
import Data.Fixed (HasResolution(..), Fixed, Pico)
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 Data.UUID.Types (UUID)
import Web.Cookie (SetCookie)

import Data.Swagger.Internal
import Data.Swagger.Lens
import Data.Swagger.SchemaOptions

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import GHC.TypeLits (TypeError, ErrorMessage(..))

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

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

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

-- | Convert a type into a plain @'ParamSchema'@.
--
-- An example type and instance:
--
-- @
-- {-\# LANGUAGE OverloadedStrings \#-}   -- allows to write 'T.Text' literals
--
-- import Control.Lens
--
-- data Direction = Up | Down
--
-- instance ToParamSchema Direction where
--   toParamSchema _ = mempty
--      & type_ ?~ SwaggerString
--      & enum_ ?~ [ \"Up\", \"Down\" ]
-- @
--
-- Instead of manually writing your @'ToParamSchema'@ instance you can
-- use a default generic implementation of @'toParamSchema'@.
--
-- To do that, simply add @deriving 'Generic'@ clause to your datatype
-- and declare a @'ToParamSchema'@ instance for your datatype without
-- giving definition for @'toParamSchema'@.
--
-- For instance, the previous example can be simplified into this:
--
-- @
-- {-\# LANGUAGE DeriveGeneric \#-}
--
-- import GHC.Generics (Generic)
--
-- data Direction = Up | Down deriving Generic
--
-- instance ToParamSchema Direction
-- @
class ToParamSchema a where
  -- | Convert a type into a plain parameter schema.
  --
  -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
  -- "{\"type\":\"integer\"}"
  toParamSchema :: Proxy a -> ParamSchema t
  default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t
  toParamSchema = SchemaOptions -> Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
(Generic a, GToParamSchema (Rep a)) =>
SchemaOptions -> Proxy a -> ParamSchema t
genericToParamSchema SchemaOptions
defaultSchemaOptions

instance {-# OVERLAPPING #-} ToParamSchema String where
  toParamSchema :: Proxy String -> ParamSchema t
toParamSchema Proxy String
_ = ParamSchema t
forall a. Monoid a => a
mempty ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString

instance ToParamSchema Bool where
  toParamSchema :: Proxy Bool -> ParamSchema t
toParamSchema Proxy Bool
_ = ParamSchema t
forall a. Monoid a => a
mempty ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerBoolean

instance ToParamSchema Integer where
  toParamSchema :: Proxy Integer -> ParamSchema t
toParamSchema Proxy Integer
_ = ParamSchema t
forall a. Monoid a => a
mempty ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerInteger

instance ToParamSchema Natural where
  toParamSchema :: Proxy Natural -> ParamSchema t
toParamSchema Proxy Natural
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_            ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerInteger
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasMinimum s a => Lens' s a
minimum_         ((Maybe Scientific -> Identity (Maybe Scientific))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Scientific -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific
0
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasExclusiveMinimum s a => Lens' s a
exclusiveMinimum ((Maybe Bool -> Identity (Maybe Bool))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Bool -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
False

instance ToParamSchema Int    where toParamSchema :: Proxy Int -> ParamSchema t
toParamSchema = Proxy Int -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral
instance ToParamSchema Int8   where toParamSchema :: Proxy Int8 -> ParamSchema t
toParamSchema = Proxy Int8 -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral
instance ToParamSchema Int16  where toParamSchema :: Proxy Int16 -> ParamSchema t
toParamSchema = Proxy Int16 -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral

instance ToParamSchema Int32 where
  toParamSchema :: Proxy Int32 -> ParamSchema t
toParamSchema Proxy Int32
proxy = Proxy Int32 -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral Proxy Int32
proxy ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"int32"

instance ToParamSchema Int64 where
  toParamSchema :: Proxy Int64 -> ParamSchema t
toParamSchema Proxy Int64
proxy = Proxy Int64 -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral Proxy Int64
proxy ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"int64"

instance ToParamSchema Word   where toParamSchema :: Proxy Word -> ParamSchema t
toParamSchema = Proxy Word -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral
instance ToParamSchema Word8  where toParamSchema :: Proxy Word8 -> ParamSchema t
toParamSchema = Proxy Word8 -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral
instance ToParamSchema Word16 where toParamSchema :: Proxy Word16 -> ParamSchema t
toParamSchema = Proxy Word16 -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral

instance ToParamSchema Word32 where
  toParamSchema :: Proxy Word32 -> ParamSchema t
toParamSchema Proxy Word32
proxy = Proxy Word32 -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral Proxy Word32
proxy ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"int32"

instance ToParamSchema Word64 where
  toParamSchema :: Proxy Word64 -> ParamSchema t
toParamSchema Proxy Word64
proxy = Proxy Word64 -> ParamSchema t
forall a (t :: SwaggerKind *).
(Bounded a, Integral a) =>
Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral Proxy Word64
proxy ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"int64"

-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
--
-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral :: Proxy a -> ParamSchema t
toParamSchemaBoundedIntegral Proxy a
_ = ParamSchema t
forall a. Monoid a => a
mempty
  ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerInteger
  ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasMinimum s a => Lens' s a
minimum_ ((Maybe Scientific -> Identity (Maybe Scientific))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Scientific -> ParamSchema t -> ParamSchema t
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))
  ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasMaximum s a => Lens' s a
maximum_ ((Maybe Scientific -> Identity (Maybe Scientific))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Scientific -> ParamSchema t -> ParamSchema t
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))

instance ToParamSchema Char where
  toParamSchema :: Proxy Char -> ParamSchema t
toParamSchema Proxy Char
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasMaxLength s a => Lens' s a
maxLength ((Maybe Integer -> Identity (Maybe Integer))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Integer -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer
1
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Integer -> Identity (Maybe Integer))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasMinLength s a => Lens' s a
minLength ((Maybe Integer -> Identity (Maybe Integer))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Integer -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Integer
1

instance ToParamSchema Scientific where
  toParamSchema :: Proxy Scientific -> ParamSchema t
toParamSchema Proxy Scientific
_ = ParamSchema t
forall a. Monoid a => a
mempty ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerNumber

instance HasResolution a => ToParamSchema (Fixed a) where
  toParamSchema :: Proxy (Fixed a) -> ParamSchema t
toParamSchema Proxy (Fixed a)
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_      ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerNumber
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Scientific -> Identity (Maybe Scientific))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasMultipleOf s a => Lens' s a
multipleOf ((Maybe Scientific -> Identity (Maybe Scientific))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Scientific -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Scientific -> Scientific
forall a. Fractional a => a -> a
recip (Scientific -> Scientific)
-> (Integer -> Scientific) -> Integer -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> Integer -> Scientific
forall a b. (a -> b) -> a -> b
$ Proxy a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

instance ToParamSchema Double where
  toParamSchema :: Proxy Double -> ParamSchema t
toParamSchema Proxy Double
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_  ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerNumber
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"double"

instance ToParamSchema Float where
  toParamSchema :: Proxy Float -> ParamSchema t
toParamSchema Proxy Float
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_  ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerNumber
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"float"

timeParamSchema :: String -> ParamSchema t
timeParamSchema :: String -> ParamSchema t
timeParamSchema String
fmt = ParamSchema t
forall a. Monoid a => a
mempty
  ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_  ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
  ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String -> Format
T.pack String
fmt

-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
instance ToParamSchema Day where
  toParamSchema :: Proxy Day -> ParamSchema t
toParamSchema Proxy Day
_ = String -> ParamSchema t
forall (t :: SwaggerKind *). String -> ParamSchema t
timeParamSchema String
"date"

-- |
-- >>> toParamSchema (Proxy :: Proxy TimeOfDay) ^. format
-- Just "hh:MM:ss"
instance ToParamSchema TimeOfDay where
  toParamSchema :: Proxy TimeOfDay -> ParamSchema t
toParamSchema Proxy TimeOfDay
_ = String -> ParamSchema t
forall (t :: SwaggerKind *). String -> ParamSchema t
timeParamSchema String
"hh:MM:ss"

-- |
-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format
-- Just "yyyy-mm-ddThh:MM:ss"
instance ToParamSchema LocalTime where
  toParamSchema :: Proxy LocalTime -> ParamSchema t
toParamSchema Proxy LocalTime
_ = String -> ParamSchema t
forall (t :: SwaggerKind *). String -> ParamSchema t
timeParamSchema String
"yyyy-mm-ddThh:MM:ss"

-- |
-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
instance ToParamSchema ZonedTime where
  toParamSchema :: Proxy ZonedTime -> ParamSchema t
toParamSchema Proxy ZonedTime
_ = String -> ParamSchema t
forall (t :: SwaggerKind *). String -> ParamSchema t
timeParamSchema String
"yyyy-mm-ddThh:MM:ss+hhMM"

-- |
-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
-- Just "yyyy-mm-ddThh:MM:ssZ"
instance ToParamSchema UTCTime where
  toParamSchema :: Proxy UTCTime -> ParamSchema t
toParamSchema Proxy UTCTime
_ = String -> ParamSchema t
forall (t :: SwaggerKind *). String -> ParamSchema t
timeParamSchema String
"yyyy-mm-ddThh:MM:ssZ"

instance ToParamSchema NominalDiffTime where
  toParamSchema :: Proxy NominalDiffTime -> ParamSchema t
toParamSchema Proxy NominalDiffTime
_ = Proxy Pico -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy Pico
forall k (t :: k). Proxy t
Proxy :: Proxy Pico)

instance ToParamSchema T.Text where
  toParamSchema :: Proxy Format -> ParamSchema t
toParamSchema Proxy Format
_ = Proxy String -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String)

instance ToParamSchema TL.Text where
  toParamSchema :: Proxy Text -> ParamSchema t
toParamSchema Proxy Text
_ = Proxy String -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String)

instance ToParamSchema Version where
  toParamSchema :: Proxy Version -> ParamSchema t
toParamSchema Proxy Version
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasPattern s a => Lens' s a
pattern ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"^\\d+(\\.\\d+)*$"

instance ToParamSchema SetCookie where
  toParamSchema :: Proxy SetCookie -> ParamSchema t
toParamSchema Proxy SetCookie
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString

type family ToParamSchemaByteStringError bs where
  ToParamSchemaByteStringError bs = TypeError
      ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
   :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
   :$$: 'Text "Consider using byteParamSchema or binaryParamSchema templates." )

instance ToParamSchemaByteStringError BS.ByteString  => ToParamSchema BS.ByteString  where toParamSchema :: Proxy ByteString -> ParamSchema t
toParamSchema = String -> Proxy ByteString -> ParamSchema t
forall a. HasCallStack => String -> a
error String
"impossible"
instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema :: Proxy ByteString -> ParamSchema t
toParamSchema = String -> Proxy ByteString -> ParamSchema t
forall a. HasCallStack => String -> a
error String
"impossible"

instance ToParamSchema All where toParamSchema :: Proxy All -> ParamSchema t
toParamSchema Proxy All
_ = Proxy Bool -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy Bool
forall k (t :: k). Proxy t
Proxy :: Proxy Bool)
instance ToParamSchema Any where toParamSchema :: Proxy Any -> ParamSchema t
toParamSchema Proxy Any
_ = Proxy Bool -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy Bool
forall k (t :: k). Proxy t
Proxy :: Proxy Bool)
instance ToParamSchema a => ToParamSchema (Sum a)     where toParamSchema :: Proxy (Sum a) -> ParamSchema t
toParamSchema Proxy (Sum a)
_ = Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance ToParamSchema a => ToParamSchema (Product a) where toParamSchema :: Proxy (Product a) -> ParamSchema t
toParamSchema Proxy (Product a)
_ = Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance ToParamSchema a => ToParamSchema (First a)   where toParamSchema :: Proxy (First a) -> ParamSchema t
toParamSchema Proxy (First a)
_ = Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance ToParamSchema a => ToParamSchema (Last a)    where toParamSchema :: Proxy (Last a) -> ParamSchema t
toParamSchema Proxy (Last a)
_ = Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance ToParamSchema a => ToParamSchema (Dual a)    where toParamSchema :: Proxy (Dual a) -> ParamSchema t
toParamSchema Proxy (Dual a)
_ = Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema :: Proxy (Identity a) -> ParamSchema t
toParamSchema Proxy (Identity a)
_ = Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance ToParamSchema a => ToParamSchema [a] where
  toParamSchema :: Proxy [a] -> ParamSchema t
toParamSchema Proxy [a]
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerItems t) -> Identity (Maybe (SwaggerItems t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasItems s a => Lens' s a
items ((Maybe (SwaggerItems t) -> Identity (Maybe (SwaggerItems t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerItems t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
forall (k :: SwaggerKind *).
Maybe (CollectionFormat k) -> ParamSchema k -> SwaggerItems k
SwaggerItemsPrimitive Maybe (CollectionFormat t)
forall a. Maybe a
Nothing (Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema :: Proxy (Vector a) -> ParamSchema t
toParamSchema Proxy (Vector a)
_ = Proxy [a] -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema :: Proxy (Vector a) -> ParamSchema t
toParamSchema Proxy (Vector a)
_ = Proxy [a] -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
instance ToParamSchema a => ToParamSchema (VS.Vector a) where toParamSchema :: Proxy (Vector a) -> ParamSchema t
toParamSchema Proxy (Vector a)
_ = Proxy [a] -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
instance ToParamSchema a => ToParamSchema (VU.Vector a) where toParamSchema :: Proxy (Vector a) -> ParamSchema t
toParamSchema Proxy (Vector a)
_ = Proxy [a] -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])

instance ToParamSchema a => ToParamSchema (Set a) where
  toParamSchema :: Proxy (Set a) -> ParamSchema t
toParamSchema Proxy (Set a)
_ = Proxy [a] -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasUniqueItems s a => Lens' s a
uniqueItems ((Maybe Bool -> Identity (Maybe Bool))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Bool -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True

instance ToParamSchema a => ToParamSchema (HashSet a) where
  toParamSchema :: Proxy (HashSet a) -> ParamSchema t
toParamSchema Proxy (HashSet a)
_ = Proxy (Set a) -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy (Set a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Set a))

-- |
-- >>> encode $ toParamSchema (Proxy :: Proxy ())
-- "{\"enum\":[\"_\"],\"type\":\"string\"}"
instance ToParamSchema () where
  toParamSchema :: Proxy () -> ParamSchema t
toParamSchema Proxy ()
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasEnum s a => Lens' s a
enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
 -> ParamSchema t -> Identity (ParamSchema t))
-> [Value] -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Value
"_"]

instance ToParamSchema UUID where
  toParamSchema :: Proxy UUID -> ParamSchema t
toParamSchema Proxy UUID
_ = ParamSchema t
forall a. Monoid a => a
mempty
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> ParamSchema t -> Identity (ParamSchema t))
-> Format -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"uuid"

-- | A configurable generic @'ParamSchema'@ creator.
--
-- >>> :set -XDeriveGeneric
-- >>> data Color = Red | Blue deriving Generic
-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
-- "{\"enum\":[\"Red\",\"Blue\"],\"type\":\"string\"}"
genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema t
genericToParamSchema :: SchemaOptions -> Proxy a -> ParamSchema t
genericToParamSchema SchemaOptions
opts Proxy a
_ = SchemaOptions -> Proxy (Rep a) -> ParamSchema t -> ParamSchema t
forall (f :: * -> *) (t :: SwaggerKind *).
GToParamSchema f =>
SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
gtoParamSchema SchemaOptions
opts (Proxy (Rep a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Rep a)) ParamSchema t
forall a. Monoid a => a
mempty

class GToParamSchema (f :: * -> *) where
  gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t

instance GToParamSchema f => GToParamSchema (D1 d f) where
  gtoParamSchema :: SchemaOptions -> Proxy (D1 d f) -> ParamSchema t -> ParamSchema t
gtoParamSchema SchemaOptions
opts Proxy (D1 d f)
_ = SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
forall (f :: * -> *) (t :: SwaggerKind *).
GToParamSchema f =>
SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
gtoParamSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)

instance Constructor c => GToParamSchema (C1 c U1) where
  gtoParamSchema :: SchemaOptions -> Proxy (C1 c U1) -> ParamSchema t -> ParamSchema t
gtoParamSchema = SchemaOptions -> Proxy (C1 c U1) -> ParamSchema t -> ParamSchema t
forall (f :: * -> *) (t :: SwaggerKind *).
GEnumParamSchema f =>
SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
genumParamSchema

instance GToParamSchema f => GToParamSchema (C1 c (S1 s f)) where
  gtoParamSchema :: SchemaOptions
-> Proxy (C1 c (S1 s f)) -> ParamSchema t -> ParamSchema t
gtoParamSchema SchemaOptions
opts Proxy (C1 c (S1 s f))
_ = SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
forall (f :: * -> *) (t :: SwaggerKind *).
GToParamSchema f =>
SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
gtoParamSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f)

instance ToParamSchema c => GToParamSchema (K1 i c) where
  gtoParamSchema :: SchemaOptions -> Proxy (K1 i c) -> ParamSchema t -> ParamSchema t
gtoParamSchema SchemaOptions
_ Proxy (K1 i c)
_ ParamSchema t
_ = Proxy c -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c)

instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) where
  gtoParamSchema :: SchemaOptions -> Proxy (f :+: g) -> ParamSchema t -> ParamSchema t
gtoParamSchema SchemaOptions
opts Proxy (f :+: g)
_ = SchemaOptions -> Proxy (f :+: g) -> ParamSchema t -> ParamSchema t
forall (f :: * -> *) (t :: SwaggerKind *).
GEnumParamSchema f =>
SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
genumParamSchema SchemaOptions
opts (Proxy (f :+: g)
forall k (t :: k). Proxy t
Proxy :: Proxy (f :+: g))

class GEnumParamSchema (f :: * -> *) where
  genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t

instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
  genumParamSchema :: SchemaOptions -> Proxy (f :+: g) -> ParamSchema t -> ParamSchema t
genumParamSchema SchemaOptions
opts Proxy (f :+: g)
_ = SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
forall (f :: * -> *) (t :: SwaggerKind *).
GEnumParamSchema f =>
SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
genumParamSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) (ParamSchema t -> ParamSchema t)
-> (ParamSchema t -> ParamSchema t)
-> ParamSchema t
-> ParamSchema t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaOptions -> Proxy g -> ParamSchema t -> ParamSchema t
forall (f :: * -> *) (t :: SwaggerKind *).
GEnumParamSchema f =>
SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
genumParamSchema SchemaOptions
opts (Proxy g
forall k (t :: k). Proxy t
Proxy :: Proxy g)

instance Constructor c => GEnumParamSchema (C1 c U1) where
  genumParamSchema :: SchemaOptions -> Proxy (C1 c U1) -> ParamSchema t -> ParamSchema t
genumParamSchema SchemaOptions
opts Proxy (C1 c U1)
_ ParamSchema t
s = ParamSchema t
s
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType t) -> Identity (Maybe (SwaggerType t)))
 -> ParamSchema t -> Identity (ParamSchema t))
-> SwaggerType t -> ParamSchema t -> ParamSchema t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString
    ParamSchema t -> (ParamSchema t -> ParamSchema t) -> ParamSchema t
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> ParamSchema t -> Identity (ParamSchema t)
forall s a. HasEnum s a => Lens' s a
enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
 -> ParamSchema t -> Identity (ParamSchema t))
-> (Maybe [Value] -> Maybe [Value])
-> ParamSchema t
-> ParamSchema t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Value -> Maybe [Value] -> Maybe [Value]
forall a. a -> Maybe [a] -> Maybe [a]
addEnumValue Value
tag
    where
      tag :: Value
tag = String -> Value
forall a. ToJSON a => a -> Value
toJSON (SchemaOptions -> String -> String
constructorTagModifier SchemaOptions
opts (Proxy3 c Any 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 k (f :: 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)))

      addEnumValue :: a -> Maybe [a] -> Maybe [a]
addEnumValue a
x Maybe [a]
Nothing    = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a
x]
      addEnumValue a
x (Just [a]
xs)  = [a] -> Maybe [a]
forall a. a -> Maybe a
Just (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

data Proxy3 a b c = Proxy3

-- $setup
-- >>> import Data.Aeson (encode)