{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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.Lens (Lens', (&), (.~), (?~), (^.))
import Control.Monad
import Control.Monad.State.Lazy (StateT, evalStateT, runStateT)
import qualified Control.Monad.State.Lazy as State
import Control.Monad.Trans (lift)
import qualified Data.Aeson as Aeson
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
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 = StateT
  (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
-> HashMap Text Schema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (JSONCodec value
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go JSONCodec value
c') HashMap Text Schema
forall a. Monoid a => a
mempty
  where
    go :: ValueCodec input output -> StateT (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
    go :: ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go = \case
      ValueCodec input output
NullCodec ->
        NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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 -> Declare (Definitions Schema) NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Declare (Definitions Schema) NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall a b. (a -> b) -> a -> b
$ 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 -> Declare (Definitions Schema) NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Declare (Definitions Schema) NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall a b. (a -> b) -> a -> b
$ 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 <- DeclareT (Definitions Schema) Identity Schema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) Schema
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DeclareT (Definitions Schema) Identity Schema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) Schema)
-> DeclareT (Definitions Schema) Identity Schema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) Schema
forall a b. (a -> b) -> a -> b
$ 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
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go ValueCodec input1 output1
c
        Referenced NamedSchema
itemsSchemaRef <- NamedSchema
-> StateT
     (HashMap Text Schema)
     (Declare (Definitions Schema))
     (Referenced NamedSchema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
NamedSchema -> m (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
itemsSchema
        NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go JSONCodec v
c
        Referenced NamedSchema
itemsSchemaRef <- NamedSchema
-> StateT
     (HashMap Text Schema)
     (Declare (Definitions Schema))
     (Referenced NamedSchema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
NamedSchema -> m (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
itemsSchema
        NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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
OpenApiObject,
                _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
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go JSONCodec v
c
        Referenced NamedSchema
itemsSchemaRef <- NamedSchema
-> StateT
     (HashMap Text Schema)
     (Declare (Definitions Schema))
     (Referenced NamedSchema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
NamedSchema -> m (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
itemsSchema
        NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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
OpenApiObject,
                _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
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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
$
            let jsonVal :: Value
jsonVal = JSONCodec input -> input -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia JSONCodec input
valCodec input
val
             in Schema
forall a. Monoid a => a
mempty
                  { _schemaEnum :: Maybe [Value]
_schemaEnum = [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value
Item [Value]
jsonVal],
                    _schemaType :: Maybe OpenApiType
_schemaType = OpenApiType -> Maybe OpenApiType
forall a. a -> Maybe a
Just (OpenApiType -> Maybe OpenApiType)
-> OpenApiType -> Maybe OpenApiType
forall a b. (a -> b) -> a -> b
$ case Value
jsonVal of
                      Aeson.Object {} -> OpenApiType
OpenApiObject
                      Aeson.Array {} -> OpenApiType
OpenApiArray
                      Aeson.String {} -> OpenApiType
OpenApiString
                      Aeson.Number {} -> OpenApiType
OpenApiNumber
                      Aeson.Bool {} -> OpenApiType
OpenApiBoolean
                      Value
Aeson.Null -> OpenApiType
OpenApiNull
                  }
      BimapCodec oldOutput -> Either String output
_ input -> oldInput
_ Codec Value oldInput oldOutput
c -> Codec Value oldInput oldOutput
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go Codec Value oldInput oldOutput
c
      ObjectOfCodec Maybe Text
mname ObjectCodec input output
oc -> do
        [Schema]
ss <- ObjectCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall input output.
ObjectCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
goObject ObjectCodec input output
oc
        NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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 Union
u Codec Value input1 output1
c1 Codec Value input2 output2
c2 ->
        let orNull :: forall input output. ValueCodec input output -> StateT (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
            orNull :: ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
orNull ValueCodec input output
c = do
              NamedSchema
ns <- ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go ValueCodec input output
c
              NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall a b. (a -> b) -> a -> b
$ NamedSchema
ns NamedSchema -> (NamedSchema -> NamedSchema) -> NamedSchema
forall a b. a -> (a -> b) -> b
& (Schema -> Identity Schema) -> NamedSchema -> Identity NamedSchema
forall s a. HasSchema s a => Lens' s a
schema ((Schema -> Identity Schema)
 -> NamedSchema -> Identity NamedSchema)
-> ((Maybe Bool -> Identity (Maybe Bool))
    -> Schema -> Identity Schema)
-> (Maybe Bool -> Identity (Maybe Bool))
-> NamedSchema
-> Identity NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Identity (Maybe Bool)) -> Schema -> Identity Schema
forall s a. HasNullable s a => Lens' s a
nullable ((Maybe Bool -> Identity (Maybe Bool))
 -> NamedSchema -> Identity NamedSchema)
-> Bool -> NamedSchema -> NamedSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
         in case (Codec Value input1 output1
c1, Codec Value input2 output2
c2) of
              (Codec Value input1 output1
NullCodec, Codec Value input2 output2
c) -> Codec Value input2 output2
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
orNull Codec Value input2 output2
c
              (Codec Value input1 output1
c, Codec Value input2 output2
NullCodec) -> Codec Value input1 output1
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
orNull Codec Value input1 output1
c
              (Codec Value input1 output1, Codec Value input2 output2)
_ -> do
                NamedSchema
ns1 <- Codec Value input1 output1
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go Codec Value input1 output1
c1
                NamedSchema
ns2 <- Codec Value input2 output2
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go Codec Value input2 output2
c2
                Union
-> NamedSchema
-> NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Union -> NamedSchema -> NamedSchema -> m NamedSchema
combineSchemasOr Union
u NamedSchema
ns1 NamedSchema
ns2
      CommentCodec Text
t ValueCodec input output
c -> do
        NamedSchema Maybe Text
mName Schema
s <- ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go ValueCodec input output
c
        NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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
        HashMap Text Schema
seenSchemas <- StateT
  (HashMap Text Schema)
  (Declare (Definitions Schema))
  (HashMap Text Schema)
forall s (m :: * -> *). MonadState s m => m s
State.get
        case Text -> HashMap Text Schema -> Maybe Schema
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
n HashMap Text Schema
seenSchemas of
          Maybe Schema
Nothing -> do
            Definitions Schema
existingDeclaredSchemas <- StateT
  (HashMap Text Schema)
  (Declare (Definitions Schema))
  (Definitions Schema)
forall d (m :: * -> *). MonadDeclare d m => m d
look

            -- Insert a dummy schema to prevent an infinite loop in recursive data structures
            let dummySchema :: Schema
dummySchema = Schema
forall a. Monoid a => a
mempty
            let seenSchemas' :: HashMap Text Schema
seenSchemas' = Text -> Schema -> HashMap Text Schema -> HashMap Text Schema
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
n Schema
dummySchema HashMap Text Schema
seenSchemas

            -- Run in a new isolated Declare monad so that we can get the results and override
            -- the dummy before declaring it in our main Declare monad (Declare does not allow overriding itself)
            let (Definitions Schema
newDeclaredSchemas, (NamedSchema
namedSchema, HashMap Text Schema
newSeenSchemas)) = (Declare (Definitions Schema) (NamedSchema, HashMap Text Schema)
 -> Definitions Schema
 -> (Definitions Schema, (NamedSchema, HashMap Text Schema)))
-> Definitions Schema
-> Declare (Definitions Schema) (NamedSchema, HashMap Text Schema)
-> (Definitions Schema, (NamedSchema, HashMap Text Schema))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Declare (Definitions Schema) (NamedSchema, HashMap Text Schema)
-> Definitions Schema
-> (Definitions Schema, (NamedSchema, HashMap Text Schema))
forall d a. Declare d a -> d -> (d, a)
runDeclare Definitions Schema
existingDeclaredSchemas (Declare (Definitions Schema) (NamedSchema, HashMap Text Schema)
 -> (Definitions Schema, (NamedSchema, HashMap Text Schema)))
-> (StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
    -> Declare (Definitions Schema) (NamedSchema, HashMap Text Schema))
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
-> (Definitions Schema, (NamedSchema, HashMap Text Schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
 -> HashMap Text Schema
 -> Declare (Definitions Schema) (NamedSchema, HashMap Text Schema))
-> HashMap Text Schema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
-> Declare (Definitions Schema) (NamedSchema, HashMap Text Schema)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
-> HashMap Text Schema
-> Declare (Definitions Schema) (NamedSchema, HashMap Text Schema)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT HashMap Text Schema
seenSchemas' (StateT
   (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
 -> (Definitions Schema, (NamedSchema, HashMap Text Schema)))
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
-> (Definitions Schema, (NamedSchema, HashMap Text Schema))
forall a b. (a -> b) -> a -> b
$ ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go ValueCodec input output
c

            -- Override the dummy now we actually know what the result will be
            HashMap Text Schema
-> StateT (HashMap Text Schema) (Declare (Definitions Schema)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (HashMap Text Schema
 -> StateT (HashMap Text Schema) (Declare (Definitions Schema)) ())
-> HashMap Text Schema
-> StateT (HashMap Text Schema) (Declare (Definitions Schema)) ()
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> HashMap Text Schema -> HashMap Text Schema
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
n (NamedSchema -> Schema
_namedSchemaSchema NamedSchema
namedSchema) HashMap Text Schema
newSeenSchemas
            Definitions Schema
-> StateT (HashMap Text Schema) (Declare (Definitions Schema)) ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare (Definitions Schema
 -> StateT (HashMap Text Schema) (Declare (Definitions Schema)) ())
-> Definitions Schema
-> StateT (HashMap Text Schema) (Declare (Definitions Schema)) ()
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
namedSchema) Definitions Schema
newDeclaredSchemas
            NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall a b. (a -> b) -> a -> b
$ NamedSchema
namedSchema {_namedSchemaName :: Maybe Text
_namedSchemaName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n}
          Just Schema
s ->
            -- We've been here before recursively, just reuse the schema we've previously created
            NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema)
-> NamedSchema
-> StateT
     (HashMap Text Schema) (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 -> StateT (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
    goObject :: ObjectCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
goObject = \case
      RequiredKeyCodec Text
key ValueCodec input output
vs Maybe Text
mDoc -> do
        NamedSchema
ns <- ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go ValueCodec input output
vs
        Referenced NamedSchema
ref <- NamedSchema
-> StateT
     (HashMap Text Schema)
     (Declare (Definitions Schema))
     (Referenced NamedSchema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
NamedSchema -> m (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns
        [Schema]
-> StateT
     (HashMap Text 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
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go ValueCodec input1 output1
vs
        Referenced NamedSchema
ref <- NamedSchema
-> StateT
     (HashMap Text Schema)
     (Declare (Definitions Schema))
     (Referenced NamedSchema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
NamedSchema -> m (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns
        [Schema]
-> StateT
     (HashMap Text 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
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall input output.
ValueCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
go ValueCodec input input
vs
        Referenced NamedSchema
ref <- NamedSchema
-> StateT
     (HashMap Text Schema)
     (Declare (Definitions Schema))
     (Referenced NamedSchema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
NamedSchema -> m (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns
        let addDefaultToSchema :: Schema -> Schema
addDefaultToSchema Schema
propertySchema = Schema
propertySchema {_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}
        [Schema]
-> StateT
     (HashMap Text 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, Schema -> Schema
addDefaultToSchema (Schema -> Schema)
-> (NamedSchema -> Schema) -> NamedSchema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
              }
          ]
      OptionalKeyWithOmittedDefaultCodec Text
key ValueCodec input input
vs input
defaultValue Maybe Text
mDoc -> ObjectCodec input input
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall input output.
ObjectCodec input output
-> StateT
     (HashMap Text Schema) (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 (KeyMap Value) input input
OptionalKeyWithDefaultCodec Text
key ValueCodec input input
vs input
defaultValue Maybe Text
mDoc)
      PureCodec output
_ -> [Schema]
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      EitherCodec Union
u Codec (KeyMap Value) input1 output1
oc1 Codec (KeyMap Value) input2 output2
oc2 -> do
        [Schema]
s1s <- Codec (KeyMap Value) input1 output1
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall input output.
ObjectCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
goObject Codec (KeyMap Value) input1 output1
oc1
        [Schema]
s2s <- Codec (KeyMap Value) input2 output2
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall input output.
ObjectCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
goObject Codec (KeyMap 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])
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Union
-> NamedSchema
-> NamedSchema
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) NamedSchema
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Union -> NamedSchema -> NamedSchema -> m NamedSchema
combineSchemasOr
            Union
u
            (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)
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall input output.
ObjectCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
goObject ObjectCodec input (output1 -> output)
oc1
        [Schema]
ss2 <- ObjectCodec input output1
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall input output.
ObjectCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
goObject ObjectCodec input output1
oc2
        [Schema]
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Schema]
 -> StateT
      (HashMap Text Schema) (Declare (Definitions Schema)) [Schema])
-> [Schema]
-> StateT
     (HashMap Text 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 (KeyMap Value) oldInput oldOutput
oc -> Codec (KeyMap Value) oldInput oldOutput
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
forall input output.
ObjectCodec input output
-> StateT
     (HashMap Text Schema) (Declare (Definitions Schema)) [Schema]
goObject Codec (KeyMap 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 :: MonadDeclare (Definitions Schema) m => Union -> NamedSchema -> NamedSchema -> m NamedSchema
    combineSchemasOr :: Union -> NamedSchema -> NamedSchema -> m NamedSchema
combineSchemasOr Union
u 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)
-> m (Referenced NamedSchema) -> m (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedSchema -> m (Referenced NamedSchema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
NamedSchema -> m (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)
-> m (Referenced NamedSchema) -> m (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedSchema -> m (Referenced NamedSchema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
NamedSchema -> m (Referenced NamedSchema)
declareSpecificNamedSchemaRef NamedSchema
ns2
      let orLens :: Lens' Schema (Maybe [Referenced Schema])
          orLens :: (Maybe [Referenced Schema] -> f (Maybe [Referenced Schema]))
-> Schema -> f Schema
orLens = case Union
u of
            Union
PossiblyJointUnion -> (Maybe [Referenced Schema] -> f (Maybe [Referenced Schema]))
-> Schema -> f Schema
forall s a. HasAnyOf s a => Lens' s a
anyOf
            Union
DisjointUnion -> (Maybe [Referenced Schema] -> f (Maybe [Referenced Schema]))
-> Schema -> f Schema
forall s a. HasOneOf s a => Lens' s a
oneOf
      let prototype :: Schema
prototype =
            Schema
forall a. Monoid a => a
mempty
              { _schemaAdditionalProperties :: Maybe AdditionalProperties
_schemaAdditionalProperties = case Union
u of
                  Union
PossiblyJointUnion -> 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
                  Union
DisjointUnion -> Maybe AdditionalProperties
forall a. Maybe a
Nothing
              }
      NamedSchema -> m NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> m NamedSchema) -> NamedSchema -> m 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
s1 Schema
-> Getting (Maybe [Value]) Schema (Maybe [Value]) -> Maybe [Value]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Value]) Schema (Maybe [Value])
forall s a. HasEnum s a => Lens' s a
enum_, Schema
s2 Schema
-> Getting (Maybe [Value]) Schema (Maybe [Value]) -> Maybe [Value]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Value]) Schema (Maybe [Value])
forall s a. HasEnum s a => Lens' s a
enum_) of
          -- If both schemas are enums with the same type then combine their values
          (Just [Value]
s1enums, Just [Value]
s2enums)
            | Schema
s1 Schema
-> Getting (Maybe OpenApiType) Schema (Maybe OpenApiType)
-> Maybe OpenApiType
forall s a. s -> Getting a s a -> a
^. Getting (Maybe OpenApiType) Schema (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
type_ Maybe OpenApiType -> Maybe OpenApiType -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
s2 Schema
-> Getting (Maybe OpenApiType) Schema (Maybe OpenApiType)
-> Maybe OpenApiType
forall s a. s -> Getting a s a -> a
^. Getting (Maybe OpenApiType) Schema (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
type_ ->
                Schema
prototype
                  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]
s1enums [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value]
s2enums)
                  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)
-> Maybe OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Schema
s1 Schema
-> Getting (Maybe OpenApiType) Schema (Maybe OpenApiType)
-> Maybe OpenApiType
forall s a. s -> Getting a s a -> a
^. Getting (Maybe OpenApiType) Schema (Maybe OpenApiType)
forall s a. HasType s a => Lens' s a
type_
          (Maybe [Value], Maybe [Value])
_ ->
            case (Schema
s1 Schema
-> Getting
     (Maybe [Referenced Schema]) Schema (Maybe [Referenced Schema])
-> Maybe [Referenced Schema]
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe [Referenced Schema]) Schema (Maybe [Referenced Schema])
Lens' Schema (Maybe [Referenced Schema])
orLens, Schema
s2 Schema
-> Getting
     (Maybe [Referenced Schema]) Schema (Maybe [Referenced Schema])
-> Maybe [Referenced Schema]
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe [Referenced Schema]) Schema (Maybe [Referenced Schema])
Lens' Schema (Maybe [Referenced Schema])
orLens) of
              (Just [Referenced Schema]
s1s, Just [Referenced Schema]
s2s) -> Schema
prototype Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Referenced Schema] -> Identity (Maybe [Referenced Schema]))
-> Schema -> Identity Schema
Lens' Schema (Maybe [Referenced Schema])
orLens ((Maybe [Referenced Schema]
  -> Identity (Maybe [Referenced Schema]))
 -> Schema -> Identity Schema)
-> [Referenced Schema] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ([Referenced Schema]
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 Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Referenced Schema] -> Identity (Maybe [Referenced Schema]))
-> Schema -> Identity Schema
Lens' Schema (Maybe [Referenced Schema])
orLens ((Maybe [Referenced Schema]
  -> Identity (Maybe [Referenced Schema]))
 -> Schema -> Identity Schema)
-> [Referenced Schema] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ([Referenced Schema]
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 Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Referenced Schema] -> Identity (Maybe [Referenced Schema]))
-> Schema -> Identity Schema
Lens' Schema (Maybe [Referenced Schema])
orLens ((Maybe [Referenced Schema]
  -> Identity (Maybe [Referenced Schema]))
 -> Schema -> Identity Schema)
-> [Referenced Schema] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Referenced Schema
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 Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Referenced Schema] -> Identity (Maybe [Referenced Schema]))
-> Schema -> Identity Schema
Lens' Schema (Maybe [Referenced Schema])
orLens ((Maybe [Referenced Schema]
  -> Identity (Maybe [Referenced Schema]))
 -> Schema -> Identity Schema)
-> [Referenced Schema] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Item [Referenced Schema]
Referenced Schema
s1Ref, Item [Referenced Schema]
Referenced Schema
s2Ref]

declareSpecificNamedSchemaRef :: MonadDeclare (Definitions Schema) m => OpenAPI.NamedSchema -> m (Referenced NamedSchema)
declareSpecificNamedSchemaRef :: NamedSchema -> m (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)
-> m (Referenced Schema) -> m (Referenced NamedSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Schema -> m (Referenced Schema)
forall (m :: * -> *).
MonadDeclare (Definitions Schema) m =>
Maybe Text -> Schema -> m (Referenced Schema)
declareSpecificSchemaRef (NamedSchema -> Maybe Text
_namedSchemaName NamedSchema
namedSchema) (NamedSchema -> Schema
_namedSchemaSchema NamedSchema
namedSchema)

declareSpecificSchemaRef :: MonadDeclare (Definitions Schema) m => Maybe Text -> OpenAPI.Schema -> m (Referenced Schema)
declareSpecificSchemaRef :: Maybe Text -> Schema -> m (Referenced Schema)
declareSpecificSchemaRef Maybe Text
mName Schema
s =
  case Maybe Text
mName of
    Maybe Text
Nothing -> Referenced Schema -> m (Referenced Schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referenced Schema -> m (Referenced Schema))
-> Referenced Schema -> m (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) -> m 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 -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
known) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Definitions Schema -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare (Definitions Schema -> m ()) -> Definitions Schema -> m ()
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 -> m (Referenced Schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referenced Schema -> m (Referenced Schema))
-> Referenced Schema -> m (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref (Text -> Reference
Reference Text
n)