{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Autodocodec.OpenAPI.Schema where

import Autodocodec
import Control.Monad
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import Data.OpenApi as OpenAPI
import Data.OpenApi.Declare as OpenAPI
import Data.Proxy
import Data.Scientific
import Data.Text (Text)

-- | Use a type's 'codec' to implement 'declareNamedSchema'.
declareNamedSchemaViaCodec :: HasCodec value => Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaViaCodec :: Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaViaCodec Proxy value
proxy = JSONCodec value
-> Proxy value -> Declare (Definitions Schema) NamedSchema
forall value.
JSONCodec value
-> Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaVia JSONCodec value
forall value. HasCodec value => JSONCodec value
codec Proxy value
proxy

-- | Use a given 'codec' to implement 'declareNamedSchema'.
declareNamedSchemaVia :: JSONCodec value -> Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaVia :: JSONCodec value
-> Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaVia JSONCodec value
c' Proxy value
Proxy = JSONCodec value -> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go JSONCodec value
c'
  where
    go :: ValueCodec input output -> Declare (Definitions Schema) NamedSchema
    go :: ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go = \case
      ValueCodec input output
NullCodec ->
        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 Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
            Schema
forall a. Monoid a => a
mempty
              { _schemaType :: Maybe OpenApiType
_schemaType = OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiNull
              }
      BoolCodec Maybe Text
mname -> Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
mname (Schema -> NamedSchema)
-> DeclareT (Definitions Schema) Identity Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Bool -> DeclareT (Definitions Schema) Identity Schema
forall a.
ToSchema a =>
Proxy a -> DeclareT (Definitions Schema) Identity Schema
declareSchema (Proxy Bool
forall k (t :: k). Proxy t
Proxy :: Proxy Bool)
      StringCodec Maybe Text
mname -> Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
mname (Schema -> NamedSchema)
-> DeclareT (Definitions Schema) Identity Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Text -> DeclareT (Definitions Schema) Identity Schema
forall a.
ToSchema a =>
Proxy a -> DeclareT (Definitions Schema) Identity Schema
declareSchema (Proxy Text
forall k (t :: k). Proxy t
Proxy :: Proxy Text)
      NumberCodec Maybe Text
mname Maybe NumberBounds
mBounds -> do
        Schema
s <- Proxy Scientific -> DeclareT (Definitions Schema) Identity Schema
forall a.
ToSchema a =>
Proxy a -> DeclareT (Definitions Schema) Identity Schema
declareSchema (Proxy Scientific
forall k (t :: k). Proxy t
Proxy :: Proxy Scientific)
        let addNumberBounds :: NumberBounds -> Schema -> Schema
addNumberBounds NumberBounds {Scientific
numberBoundsLower :: NumberBounds -> Scientific
numberBoundsUpper :: NumberBounds -> Scientific
numberBoundsUpper :: Scientific
numberBoundsLower :: Scientific
..} Schema
s_ =
              Schema
s_
                { _schemaMinimum :: Maybe Scientific
_schemaMinimum = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
numberBoundsLower,
                  _schemaMaximum :: Maybe Scientific
_schemaMaximum = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
numberBoundsUpper
                }
        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 Maybe Text
mname (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ (Schema -> Schema)
-> (NumberBounds -> Schema -> Schema)
-> Maybe NumberBounds
-> Schema
-> Schema
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Schema -> Schema
forall a. a -> a
id NumberBounds -> Schema -> Schema
addNumberBounds Maybe NumberBounds
mBounds Schema
s
      ArrayOfCodec Maybe Text
mname ValueCodec input1 output1
c -> do
        NamedSchema
itemsSchema <- ValueCodec input1 output1
-> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go ValueCodec input1 output1
c
        Referenced NamedSchema
itemsSchemaRef <- NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
itemsSchema
        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 Maybe Text
mname (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
            Schema
forall a. Monoid a => a
mempty
              { _schemaItems :: Maybe OpenApiItems
_schemaItems = OpenApiItems -> Maybe OpenApiItems
forall a. a -> Maybe a
Just (OpenApiItems -> Maybe OpenApiItems)
-> OpenApiItems -> Maybe OpenApiItems
forall a b. (a -> b) -> a -> b
$ Referenced Schema -> OpenApiItems
OpenApiItemsObject (Referenced Schema -> OpenApiItems)
-> Referenced Schema -> OpenApiItems
forall a b. (a -> b) -> a -> b
$ NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> Referenced NamedSchema -> Referenced Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referenced NamedSchema
itemsSchemaRef,
                _schemaType :: Maybe OpenApiType
_schemaType = OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiArray
              }
      HashMapCodec JSONCodec v
c -> do
        NamedSchema
itemsSchema <- JSONCodec v -> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go JSONCodec v
c
        Referenced NamedSchema
itemsSchemaRef <- NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
itemsSchema
        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 Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
            Schema
forall a. Monoid a => a
mempty
              { _schemaAdditionalProperties :: Maybe AdditionalProperties
_schemaAdditionalProperties = AdditionalProperties -> Maybe AdditionalProperties
forall a. a -> Maybe a
Just (AdditionalProperties -> Maybe AdditionalProperties)
-> AdditionalProperties -> Maybe AdditionalProperties
forall a b. (a -> b) -> a -> b
$ Referenced Schema -> AdditionalProperties
AdditionalPropertiesSchema (Referenced Schema -> AdditionalProperties)
-> Referenced Schema -> AdditionalProperties
forall a b. (a -> b) -> a -> b
$ NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> Referenced NamedSchema -> Referenced Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referenced NamedSchema
itemsSchemaRef
              }
      MapCodec JSONCodec v
c -> do
        NamedSchema
itemsSchema <- JSONCodec v -> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go JSONCodec v
c
        Referenced NamedSchema
itemsSchemaRef <- NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
itemsSchema
        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 Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
            Schema
forall a. Monoid a => a
mempty
              { _schemaAdditionalProperties :: Maybe AdditionalProperties
_schemaAdditionalProperties = AdditionalProperties -> Maybe AdditionalProperties
forall a. a -> Maybe a
Just (AdditionalProperties -> Maybe AdditionalProperties)
-> AdditionalProperties -> Maybe AdditionalProperties
forall a b. (a -> b) -> a -> b
$ Referenced Schema -> AdditionalProperties
AdditionalPropertiesSchema (Referenced Schema -> AdditionalProperties)
-> Referenced Schema -> AdditionalProperties
forall a b. (a -> b) -> a -> b
$ NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> Referenced NamedSchema -> Referenced Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referenced NamedSchema
itemsSchemaRef
              }
      ValueCodec input output
ValueCodec ->
        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
            Maybe Text
forall a. Maybe a
Nothing
            Schema
forall a. Monoid a => a
mempty
              { _schemaAdditionalProperties :: Maybe AdditionalProperties
_schemaAdditionalProperties = AdditionalProperties -> Maybe AdditionalProperties
forall a. a -> Maybe a
Just (AdditionalProperties -> Maybe AdditionalProperties)
-> AdditionalProperties -> Maybe AdditionalProperties
forall a b. (a -> b) -> a -> b
$ Bool -> AdditionalProperties
AdditionalPropertiesAllowed Bool
True
              }
      EqCodec input
val JSONCodec input
valCodec ->
        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 Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
            Schema
forall a. Monoid a => a
mempty
              { _schemaEnum :: Maybe [Value]
_schemaEnum = [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [JSONCodec input -> input -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia JSONCodec input
valCodec input
val]
              }
      BimapCodec oldOutput -> Either String output
_ input -> oldInput
_ Codec Value oldInput oldOutput
c -> Codec Value oldInput oldOutput
-> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go Codec Value oldInput oldOutput
c
      ObjectOfCodec Maybe Text
mname ObjectCodec input output
oc -> do
        [Schema]
ss <- ObjectCodec input output -> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject ObjectCodec input output
oc
        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 Maybe Text
mname (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ [Schema] -> Schema
combineObjectSchemas [Schema]
ss
      EitherCodec Codec Value input1 output1
c1 Codec Value input2 output2
c2 -> do
        NamedSchema
ns1 <- Codec Value input1 output1
-> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go Codec Value input1 output1
c1
        NamedSchema
ns2 <- Codec Value input2 output2
-> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go Codec Value input2 output2
c2
        NamedSchema
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
combineSchemasOr NamedSchema
ns1 NamedSchema
ns2
      CommentCodec Text
t ValueCodec input output
c -> do
        NamedSchema Maybe Text
mName Schema
s <- ValueCodec input output -> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go ValueCodec input output
c
        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 Maybe Text
mName (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> Schema
addDoc Text
t Schema
s
      ReferenceCodec Text
n ValueCodec input output
c -> do
        Definitions Schema
d <- DeclareT (Definitions Schema) Identity (Definitions Schema)
forall d (m :: * -> *). MonadDeclare d m => m d
look
        case Text -> Definitions Schema -> Maybe Schema
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Text
n Definitions Schema
d of
          Maybe Schema
Nothing -> do
            -- Insert a dummy to prevent an infinite loop.
            let dummy :: Schema
dummy = Schema
forall a. Monoid a => a
mempty
            let (Definitions Schema
d', NamedSchema
ns) = Declare (Definitions Schema) NamedSchema
-> Definitions Schema -> (Definitions Schema, NamedSchema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (ValueCodec input output -> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go ValueCodec input output
c) (Text -> Schema -> Definitions Schema -> Definitions Schema
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert Text
n Schema
dummy Definitions Schema
d)
            -- Override the dummy once we actually know what the result will be.
            Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare (Definitions Schema -> DeclareT (Definitions Schema) Identity ())
-> Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> Definitions Schema -> Definitions Schema
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert Text
n (NamedSchema -> Schema
_namedSchemaSchema NamedSchema
ns) Definitions Schema
d'
            NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedSchema
ns
          Just Schema
s -> 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
n) Schema
s
    goObject :: ObjectCodec input output -> Declare (Definitions Schema) [Schema]
    goObject :: ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject = \case
      RequiredKeyCodec Text
key ValueCodec input output
vs Maybe Text
mDoc -> do
        NamedSchema
ns <- ValueCodec input output -> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go ValueCodec input output
vs
        Referenced NamedSchema
ref <- NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns
        [Schema] -> Declare (Definitions Schema) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [ Schema
forall a. Monoid a => a
mempty
              { _schemaRequired :: [Text]
_schemaRequired = [Text
Item [Text]
key],
                _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
_schemaProperties = [(Text
key, Maybe Text -> Schema -> Schema
addMDoc Maybe Text
mDoc (Schema -> Schema)
-> (NamedSchema -> Schema) -> NamedSchema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> Referenced NamedSchema -> Referenced Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referenced NamedSchema
ref)],
                _schemaType :: Maybe OpenApiType
_schemaType = OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiObject
              }
          ]
      OptionalKeyCodec Text
key ValueCodec input1 output1
vs Maybe Text
mDoc -> do
        NamedSchema
ns <- ValueCodec input1 output1
-> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go ValueCodec input1 output1
vs
        Referenced NamedSchema
ref <- NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns
        [Schema] -> Declare (Definitions Schema) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [ Schema
forall a. Monoid a => a
mempty
              { _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
_schemaProperties = [(Text
key, Maybe Text -> Schema -> Schema
addMDoc Maybe Text
mDoc (Schema -> Schema)
-> (NamedSchema -> Schema) -> NamedSchema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> Referenced NamedSchema -> Referenced Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referenced NamedSchema
ref)],
                _schemaType :: Maybe OpenApiType
_schemaType = OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiObject
              }
          ]
      OptionalKeyWithDefaultCodec Text
key ValueCodec input input
vs input
defaultValue Maybe Text
mDoc -> do
        NamedSchema
ns <- ValueCodec input input -> Declare (Definitions Schema) NamedSchema
forall input output.
ValueCodec input output -> Declare (Definitions Schema) NamedSchema
go ValueCodec input input
vs
        Referenced NamedSchema
ref <- NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns
        [Schema] -> Declare (Definitions Schema) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [ Schema
forall a. Monoid a => a
mempty
              { _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
_schemaProperties = [(Text
key, Maybe Text -> Schema -> Schema
addMDoc Maybe Text
mDoc (Schema -> Schema)
-> (NamedSchema -> Schema) -> NamedSchema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedSchema -> Schema
_namedSchemaSchema (NamedSchema -> Schema)
-> Referenced NamedSchema -> Referenced Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referenced NamedSchema
ref)],
                _schemaDefault :: Maybe Value
_schemaDefault = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ValueCodec input input -> input -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia ValueCodec input input
vs input
defaultValue,
                _schemaType :: Maybe OpenApiType
_schemaType = OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just OpenApiType
OpenApiObject
              }
          ]
      OptionalKeyWithOmittedDefaultCodec Text
key ValueCodec input input
vs input
defaultValue Maybe Text
mDoc -> ObjectCodec input input -> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject (Text
-> ValueCodec input input
-> input
-> Maybe Text
-> ObjectCodec input input
forall input.
Text
-> ValueCodec input input
-> input
-> Maybe Text
-> Codec (HashMap Text Value) input input
OptionalKeyWithDefaultCodec Text
key ValueCodec input input
vs input
defaultValue Maybe Text
mDoc)
      PureCodec output
_ -> [Schema] -> Declare (Definitions Schema) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      EitherCodec Codec (HashMap Text Value) input1 output1
oc1 Codec (HashMap Text Value) input2 output2
oc2 -> do
        [Schema]
s1s <- Codec (HashMap Text Value) input1 output1
-> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject Codec (HashMap Text Value) input1 output1
oc1
        [Schema]
s2s <- Codec (HashMap Text Value) input2 output2
-> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject Codec (HashMap Text Value) input2 output2
oc2
        (Schema -> [Schema] -> [Schema]
forall a. a -> [a] -> [a]
: []) (Schema -> [Schema])
-> (NamedSchema -> Schema) -> NamedSchema -> [Schema]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
<$> NamedSchema
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
combineSchemasOr
            (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing ([Schema] -> Schema
combineObjectSchemas [Schema]
s1s))
            (Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing ([Schema] -> Schema
combineObjectSchemas [Schema]
s2s))
      ApCodec ObjectCodec input (output1 -> output)
oc1 ObjectCodec input output1
oc2 -> do
        [Schema]
ss1 <- ObjectCodec input (output1 -> output)
-> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject ObjectCodec input (output1 -> output)
oc1
        [Schema]
ss2 <- ObjectCodec input output1 -> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject ObjectCodec input output1
oc2
        [Schema] -> Declare (Definitions Schema) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Schema] -> Declare (Definitions Schema) [Schema])
-> [Schema] -> Declare (Definitions Schema) [Schema]
forall a b. (a -> b) -> a -> b
$ [Schema]
ss1 [Schema] -> [Schema] -> [Schema]
forall a. [a] -> [a] -> [a]
++ [Schema]
ss2
      BimapCodec oldOutput -> Either String output
_ input -> oldInput
_ Codec (HashMap Text Value) oldInput oldOutput
oc -> Codec (HashMap Text Value) oldInput oldOutput
-> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject Codec (HashMap Text Value) oldInput oldOutput
oc
    addMDoc :: Maybe Text -> Schema -> Schema
    addMDoc :: Maybe Text -> Schema -> Schema
addMDoc = (Schema -> Schema)
-> (Text -> Schema -> Schema) -> Maybe Text -> Schema -> Schema
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Schema -> Schema
forall a. a -> a
id Text -> Schema -> Schema
addDoc
    addDoc :: Text -> Schema -> Schema
    addDoc :: Text -> Schema -> Schema
addDoc Text
doc Schema
s =
      Schema
s
        { _schemaDescription :: Maybe Text
_schemaDescription = case Schema -> Maybe Text
_schemaDescription Schema
s of
            Maybe Text
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
doc
            Just Text
doc' -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
doc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
doc'
        }
    combineObjectSchemas :: [Schema] -> Schema
    combineObjectSchemas :: [Schema] -> Schema
combineObjectSchemas = [Schema] -> Schema
forall a. Monoid a => [a] -> a
mconcat
    combineSchemasOr :: NamedSchema -> NamedSchema -> Declare (Definitions Schema) NamedSchema
    combineSchemasOr :: NamedSchema
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
combineSchemasOr NamedSchema
ns1 NamedSchema
ns2 = do
      let s1 :: Schema
s1 = NamedSchema -> Schema
_namedSchemaSchema NamedSchema
ns1
      let s2 :: Schema
s2 = NamedSchema -> Schema
_namedSchemaSchema NamedSchema
ns2
      Referenced Schema
s1Ref <- (NamedSchema -> Schema)
-> Referenced NamedSchema -> Referenced Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedSchema -> Schema
_namedSchemaSchema (Referenced NamedSchema -> Referenced Schema)
-> Declare (Definitions Schema) (Referenced NamedSchema)
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns1
      Referenced Schema
s2Ref <- (NamedSchema -> Schema)
-> Referenced NamedSchema -> Referenced Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedSchema -> Schema
_namedSchemaSchema (Referenced NamedSchema -> Referenced Schema)
-> Declare (Definitions Schema) (Referenced NamedSchema)
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns2
      let prototype :: Schema
prototype = Schema
forall a. Monoid a => a
mempty {_schemaAdditionalProperties :: Maybe AdditionalProperties
_schemaAdditionalProperties = AdditionalProperties -> Maybe AdditionalProperties
forall a. a -> Maybe a
Just (AdditionalProperties -> Maybe AdditionalProperties)
-> AdditionalProperties -> Maybe AdditionalProperties
forall a b. (a -> b) -> a -> b
$ Bool -> AdditionalProperties
AdditionalPropertiesAllowed Bool
True}
      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 Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ case (Schema -> Maybe [Referenced Schema]
_schemaAnyOf Schema
s1, Schema -> Maybe [Referenced Schema]
_schemaAnyOf Schema
s2) of
          (Just [Referenced Schema]
s1s, Just [Referenced Schema]
s2s) -> Schema
prototype {_schemaAnyOf :: Maybe [Referenced Schema]
_schemaAnyOf = [Referenced Schema] -> Maybe [Referenced Schema]
forall a. a -> Maybe a
Just ([Referenced Schema] -> Maybe [Referenced Schema])
-> [Referenced Schema] -> Maybe [Referenced Schema]
forall a b. (a -> b) -> a -> b
$ [Referenced Schema]
s1s [Referenced Schema] -> [Referenced Schema] -> [Referenced Schema]
forall a. [a] -> [a] -> [a]
++ [Referenced Schema]
s2s}
          (Just [Referenced Schema]
s1s, Maybe [Referenced Schema]
Nothing) -> Schema
prototype {_schemaAnyOf :: Maybe [Referenced Schema]
_schemaAnyOf = [Referenced Schema] -> Maybe [Referenced Schema]
forall a. a -> Maybe a
Just ([Referenced Schema] -> Maybe [Referenced Schema])
-> [Referenced Schema] -> Maybe [Referenced Schema]
forall a b. (a -> b) -> a -> b
$ [Referenced Schema]
s1s [Referenced Schema] -> [Referenced Schema] -> [Referenced Schema]
forall a. [a] -> [a] -> [a]
++ [Item [Referenced Schema]
Referenced Schema
s2Ref]}
          (Maybe [Referenced Schema]
Nothing, Just [Referenced Schema]
s2s) -> Schema
prototype {_schemaAnyOf :: Maybe [Referenced Schema]
_schemaAnyOf = [Referenced Schema] -> Maybe [Referenced Schema]
forall a. a -> Maybe a
Just ([Referenced Schema] -> Maybe [Referenced Schema])
-> [Referenced Schema] -> Maybe [Referenced Schema]
forall a b. (a -> b) -> a -> b
$ Referenced Schema
s1Ref Referenced Schema -> [Referenced Schema] -> [Referenced Schema]
forall a. a -> [a] -> [a]
: [Referenced Schema]
s2s}
          (Maybe [Referenced Schema]
Nothing, Maybe [Referenced Schema]
Nothing) -> Schema
prototype {_schemaAnyOf :: Maybe [Referenced Schema]
_schemaAnyOf = [Referenced Schema] -> Maybe [Referenced Schema]
forall a. a -> Maybe a
Just [Item [Referenced Schema]
Referenced Schema
s1Ref, Item [Referenced Schema]
Referenced Schema
s2Ref]}

declareSpecificNamedSchemaRef :: OpenAPI.NamedSchema -> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef :: NamedSchema
-> Declare (Definitions Schema) (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
namedSchema =
  (Schema -> NamedSchema)
-> Referenced Schema -> Referenced NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text -> Schema -> NamedSchema
NamedSchema (NamedSchema -> Maybe Text
_namedSchemaName NamedSchema
namedSchema))
    (Referenced Schema -> Referenced NamedSchema)
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
-> Declare (Definitions Schema) (Referenced NamedSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
-> Schema
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
declareSpecificSchemaRef (NamedSchema -> Maybe Text
_namedSchemaName NamedSchema
namedSchema) (NamedSchema -> Schema
_namedSchemaSchema NamedSchema
namedSchema)

declareSpecificSchemaRef :: Maybe Text -> OpenAPI.Schema -> Declare (Definitions Schema) (Referenced Schema)
declareSpecificSchemaRef :: Maybe Text
-> Schema
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
declareSpecificSchemaRef Maybe Text
mName Schema
s =
  case Maybe Text
mName of
    Maybe Text
Nothing -> Referenced Schema
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referenced Schema
 -> DeclareT (Definitions Schema) Identity (Referenced Schema))
-> Referenced Schema
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
s
    Just Text
n -> do
      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
n)
      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
$ Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare (Definitions Schema -> DeclareT (Definitions Schema) Identity ())
-> Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> Definitions Schema
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrdHashMap.singleton Text
n Schema
s
      Referenced Schema
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referenced Schema
 -> DeclareT (Definitions Schema) Identity (Referenced Schema))
-> Referenced Schema
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref (Text -> Reference
Reference Text
n)