{-# 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.OpenApi.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.OpenApi.Internal
import Data.OpenApi.Lens
import Data.OpenApi.SchemaOptions

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

-- | 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 OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> Schema -> Identity Schema)
-> Format -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"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 OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> Schema -> Identity Schema)
-> Format -> Schema -> Schema
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.
passwordSchema :: Schema
passwordSchema :: Schema
passwordSchema = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> Schema -> Identity Schema)
-> Format -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"password"

-- | Convert a type into a plain @'Schema'@.
--
-- In previous versions of the package there was a separate type called @ParamSchema@, which was
-- included in a greater 'Schema'. Now this is a single class, but distinction for schema generators
-- for "simple" types is preserved.
--
-- 'ToParamSchema' is suited only for primitive-like types without nested fields and such.
--
-- 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_ ?~ OpenApiString
--      & 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.
  --
  -- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy Integer)
  -- {
  --     "type": "integer"
  -- }
  toParamSchema :: Proxy a -> Schema
  default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema
  toParamSchema = SchemaOptions -> Proxy a -> Schema
forall k a (t :: k).
(Generic a, GToParamSchema (Rep a)) =>
SchemaOptions -> Proxy a -> Schema
genericToParamSchema SchemaOptions
defaultSchemaOptions

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

instance ToParamSchema Bool where
  toParamSchema :: Proxy Bool -> Schema
toParamSchema Proxy Bool
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiBoolean

instance ToParamSchema Integer where
  toParamSchema :: Proxy Integer -> Schema
toParamSchema Proxy Integer
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiInteger

instance ToParamSchema Natural where
  toParamSchema :: Proxy Natural -> Schema
toParamSchema Proxy Natural
_ = Schema
forall a. Monoid a => a
mempty
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_            ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiInteger
    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
0
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Schema -> Identity Schema
forall s a. HasExclusiveMinimum s a => Lens' s a
exclusiveMinimum ((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
False

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

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

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

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

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

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

-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
--
-- >>> BSL.putStrLn $ encodePretty $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
-- {
--     "maximum": 127,
--     "minimum": -128,
--     "type": "integer"
-- }
toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema
toParamSchemaBoundedIntegral :: Proxy a -> Schema
toParamSchemaBoundedIntegral Proxy a
_ = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiInteger
  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))

instance ToParamSchema Char where
  toParamSchema :: Proxy Char -> Schema
toParamSchema Proxy Char
_ = Schema
forall a. Monoid a => a
mempty
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
    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
?~ Integer
1
    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
?~ Integer
1

instance ToParamSchema Scientific where
  toParamSchema :: Proxy Scientific -> Schema
toParamSchema Proxy Scientific
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiNumber

instance HasResolution a => ToParamSchema (Fixed a) where
  toParamSchema :: Proxy (Fixed a) -> Schema
toParamSchema Proxy (Fixed a)
_ = Schema
forall a. Monoid a => a
mempty
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_      ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiNumber
    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 -> 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 -> Schema
toParamSchema Proxy Double
_ = Schema
forall a. Monoid a => a
mempty
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_  ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiNumber
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> Schema -> Identity Schema)
-> Format -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Format
"double"

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

timeParamSchema :: String -> Schema
timeParamSchema :: String -> Schema
timeParamSchema String
fmt = Schema
forall a. Monoid a => a
mempty
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_  ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
  Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Format -> Identity (Maybe Format))
-> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
format ((Maybe Format -> Identity (Maybe Format))
 -> Schema -> Identity Schema)
-> Format -> Schema -> Schema
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 -> Schema
toParamSchema Proxy Day
_ = String -> Schema
timeParamSchema String
"date"

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

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

-- |
-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
-- Just "date-time"
instance ToParamSchema ZonedTime where
  toParamSchema :: Proxy ZonedTime -> Schema
toParamSchema Proxy ZonedTime
_ = String -> Schema
timeParamSchema String
"date-time"

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

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

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

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

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

instance ToParamSchema SetCookie where
  toParamSchema :: Proxy SetCookie -> Schema
toParamSchema Proxy SetCookie
_ = Schema
forall a. Monoid a => a
mempty
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString

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 binaryParamSchemaemplates." )

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

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

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

instance ToParamSchema a => ToParamSchema [a] where
  toParamSchema :: Proxy [a] -> Schema
toParamSchema Proxy [a]
_ = Schema
forall a. Monoid a => a
mempty
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiArray
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiItems -> Identity (Maybe OpenApiItems))
-> Schema -> Identity Schema
forall s a. HasItems s a => Lens' s a
items ((Maybe OpenApiItems -> Identity (Maybe OpenApiItems))
 -> Schema -> Identity Schema)
-> OpenApiItems -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> OpenApiItems
OpenApiItemsObject (Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ Proxy a -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

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

instance ToParamSchema a => ToParamSchema (Set a) where
  toParamSchema :: Proxy (Set a) -> Schema
toParamSchema Proxy (Set a)
_ = Proxy [a] -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a])
    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 ToParamSchema a => ToParamSchema (HashSet a) where
  toParamSchema :: Proxy (HashSet a) -> Schema
toParamSchema Proxy (HashSet a)
_ = Proxy (Set a) -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (Proxy (Set a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Set a))

-- |
-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())
-- {
--     "enum": [
--         "_"
--     ],
--     "type": "string"
-- }
instance ToParamSchema () where
  toParamSchema :: Proxy () -> Schema
toParamSchema Proxy ()
_ = Schema
forall a. Monoid a => a
mempty
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
    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
"_"]

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

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

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

instance GToParamSchema f => GToParamSchema (D1 d f) where
  gtoParamSchema :: SchemaOptions -> Proxy (D1 d f) -> Schema -> Schema
gtoParamSchema SchemaOptions
opts Proxy (D1 d f)
_ = SchemaOptions -> Proxy f -> Schema -> Schema
forall (f :: * -> *).
GToParamSchema f =>
SchemaOptions -> Proxy f -> Schema -> Schema
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) -> Schema -> Schema
gtoParamSchema = SchemaOptions -> Proxy (C1 c U1) -> Schema -> Schema
forall (f :: * -> *).
GEnumParamSchema f =>
SchemaOptions -> Proxy f -> Schema -> Schema
genumParamSchema

instance GToParamSchema f => GToParamSchema (C1 c (S1 s f)) where
  gtoParamSchema :: SchemaOptions -> Proxy (C1 c (S1 s f)) -> Schema -> Schema
gtoParamSchema SchemaOptions
opts Proxy (C1 c (S1 s f))
_ = SchemaOptions -> Proxy f -> Schema -> Schema
forall (f :: * -> *).
GToParamSchema f =>
SchemaOptions -> Proxy f -> Schema -> Schema
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) -> Schema -> Schema
gtoParamSchema SchemaOptions
_ Proxy (K1 i c)
_ Schema
_ = Proxy c -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
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) -> Schema -> Schema
gtoParamSchema SchemaOptions
opts Proxy (f :+: g)
_ = SchemaOptions -> Proxy (f :+: g) -> Schema -> Schema
forall (f :: * -> *).
GEnumParamSchema f =>
SchemaOptions -> Proxy f -> Schema -> Schema
genumParamSchema SchemaOptions
opts (Proxy (f :+: g)
forall k (t :: k). Proxy t
Proxy :: Proxy (f :+: g))

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

instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
  genumParamSchema :: SchemaOptions -> Proxy (f :+: g) -> Schema -> Schema
genumParamSchema SchemaOptions
opts Proxy (f :+: g)
_ = SchemaOptions -> Proxy f -> Schema -> Schema
forall (f :: * -> *).
GEnumParamSchema f =>
SchemaOptions -> Proxy f -> Schema -> Schema
genumParamSchema SchemaOptions
opts (Proxy f
forall k (t :: k). Proxy t
Proxy :: Proxy f) (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaOptions -> Proxy g -> Schema -> Schema
forall (f :: * -> *).
GEnumParamSchema f =>
SchemaOptions -> Proxy f -> Schema -> Schema
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) -> Schema -> Schema
genumParamSchema SchemaOptions
opts Proxy (C1 c U1)
_ Schema
s = Schema
s
    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
    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)
-> (Maybe [Value] -> Maybe [Value]) -> Schema -> Schema
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)
-- >>> import Data.OpenApi.Internal.Utils