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

module Autodocodec.Swagger.Schema where

import Autodocodec
import Control.Monad
import Data.Foldable (toList)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import Data.List
import Data.Proxy
import Data.Scientific
import Data.Swagger as Swagger
import Data.Swagger.Declare as Swagger
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
              { _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema =
                  ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty
                    { _paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerNull
                    }
              }
      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_
                { _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema =
                    (Schema -> ParamSchema 'SwaggerKindSchema
_schemaParamSchema Schema
s_)
                      { _paramSchemaMinimum :: Maybe Scientific
_paramSchemaMinimum = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
numberBoundsLower,
                        _paramSchemaMaximum :: Maybe Scientific
_paramSchemaMaximum = 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
      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,
                _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema =
                  ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty
                    { _paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject
                    }
              }
      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,
                _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema =
                  ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty
                    { _paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject
                    }
              }
      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
              }
      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
              { _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema =
                  ParamSchema Any
forall a. Monoid a => a
mempty
                    { _paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray,
                      _paramSchemaItems :: Maybe (SwaggerItems 'SwaggerKindSchema)
_paramSchemaItems = SwaggerItems 'SwaggerKindSchema
-> Maybe (SwaggerItems 'SwaggerKindSchema)
forall a. a -> Maybe a
Just (SwaggerItems 'SwaggerKindSchema
 -> Maybe (SwaggerItems 'SwaggerKindSchema))
-> SwaggerItems 'SwaggerKindSchema
-> Maybe (SwaggerItems 'SwaggerKindSchema)
forall a b. (a -> b) -> a -> b
$ Referenced Schema -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsObject (Referenced Schema -> SwaggerItems 'SwaggerKindSchema)
-> Referenced Schema -> SwaggerItems 'SwaggerKindSchema
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
                    }
              }
      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
      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
              { _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema = ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty {_paramSchemaEnum :: Maybe [Value]
_paramSchemaEnum = [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
      EitherCodec Union
u 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
        let s1 :: Schema
s1 = NamedSchema -> Schema
_namedSchemaSchema NamedSchema
ns1
        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
        let s2 :: Schema
s2 = NamedSchema -> Schema
_namedSchemaSchema NamedSchema
ns2
        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
$ Union -> Schema -> Schema -> Schema
combineSchemaOr Union
u Schema
s1 Schema
s2
      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)],
                _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema = ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty {_paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject}
              }
          ]
      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)],
                _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema = ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty {_paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject}
              }
          ]
      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)],
                _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema =
                  ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty
                    { _paramSchemaDefault :: Maybe Value
_paramSchemaDefault = 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,
                      _paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject
                    }
              }
          ]
      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 (KeyMap 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 Union
u Codec (KeyMap Value) input1 output1
oc1 Codec (KeyMap Value) input2 output2
oc2 -> do
        [Schema]
ss1 <- Codec (KeyMap Value) input1 output1
-> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject Codec (KeyMap Value) input1 output1
oc1
        [Schema]
ss2 <- Codec (KeyMap Value) input2 output2
-> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject Codec (KeyMap Value) input2 output2
oc2
        [Schema] -> Declare (Definitions Schema) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Union -> Schema -> Schema -> Schema
combineSchemaOr Union
u ([Schema] -> Schema
combineObjectSchemas [Schema]
ss1) ([Schema] -> Schema
combineObjectSchemas [Schema]
ss2)]
      DiscriminatedUnionCodec Text
pn input -> (Text, ObjectCodec input ())
_ HashMap Text (Text, ObjectCodec Void output)
m -> do
        let mkSchema :: Text
-> (Text, ObjectCodec Void output)
-> DeclareT (Definitions Schema) Identity Schema
mkSchema Text
dName (Text
_, ObjectCodec Void output
oc) =
              ([Schema] -> Schema)
-> Declare (Definitions Schema) [Schema]
-> DeclareT (Definitions Schema) Identity Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Schema] -> Schema
combineObjectSchemas (Declare (Definitions Schema) [Schema]
 -> DeclareT (Definitions Schema) Identity Schema)
-> Declare (Definitions Schema) [Schema]
-> DeclareT (Definitions Schema) Identity Schema
forall a b. (a -> b) -> a -> b
$ ObjectCodec Void Text -> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> Declare (Definitions Schema) [Schema]
goObject (ObjectCodec Void Text -> Declare (Definitions Schema) [Schema])
-> ObjectCodec Void Text -> Declare (Definitions Schema) [Schema]
forall a b. (a -> b) -> a -> b
$ ObjectCodec Void output
oc ObjectCodec Void output
-> ObjectCodec Void Text -> ObjectCodec Void Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ValueCodec Text Text -> ObjectCodec Text Text
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
pn ValueCodec Text Text
textCodec ObjectCodec Text Text -> (Void -> Text) -> ObjectCodec Void Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Text -> Void -> Text
forall a b. a -> b -> a
const Text
dName)
        HashMap Text Schema
ss <- (Text
 -> (Text, ObjectCodec Void output)
 -> DeclareT (Definitions Schema) Identity Schema)
-> HashMap Text (Text, ObjectCodec Void output)
-> DeclareT (Definitions Schema) Identity (HashMap Text Schema)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey Text
-> (Text, ObjectCodec Void output)
-> DeclareT (Definitions Schema) Identity Schema
mkSchema HashMap Text (Text, ObjectCodec Void output)
m
        let combined :: Schema
combined = case HashMap Text Schema -> [Schema]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashMap Text Schema
ss of
              [] -> Schema
forall a. Monoid a => a
mempty
              (Schema
s : [Schema]
ss') -> (Schema -> Schema -> Schema) -> Schema -> [Schema] -> Schema
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Union -> Schema -> Schema -> Schema
combineSchemaOr Union
DisjointUnion) Schema
s [Schema]
ss'
        [Schema] -> Declare (Definitions Schema) [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item [Schema]
Schema
combined]
      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 (KeyMap Value) oldInput oldOutput
oc -> Codec (KeyMap Value) oldInput oldOutput
-> Declare (Definitions Schema) [Schema]
forall input output.
ObjectCodec input output -> 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
    combineSchemaOr :: Union -> Schema -> Schema -> Schema
    combineSchemaOr :: Union -> Schema -> Schema -> Schema
combineSchemaOr Union
u Schema
s1 Schema
s2 =
      let ps1 :: ParamSchema 'SwaggerKindSchema
ps1 = Schema -> ParamSchema 'SwaggerKindSchema
_schemaParamSchema Schema
s1
          ps2 :: ParamSchema 'SwaggerKindSchema
ps2 = Schema -> ParamSchema 'SwaggerKindSchema
_schemaParamSchema Schema
s2
          -- Swagger 2 doesn't support sum types so we have to work around that here.
          --
          -- We support a few cases:
          --
          --   * Enum: If both of them have the enum field set
          --   * Two obects: If both of them have the object type set.
          --
          -- If none of these cases match, we just take an overapproximation of
          -- the schema: one which lets any value through.
          overApproximation :: Schema
overApproximation =
            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
              }
       in case (,) ([Value] -> [Value] -> ([Value], [Value]))
-> Maybe [Value] -> Maybe ([Value] -> ([Value], [Value]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParamSchema 'SwaggerKindSchema -> Maybe [Value]
forall (t :: SwaggerKind *). ParamSchema t -> Maybe [Value]
_paramSchemaEnum ParamSchema 'SwaggerKindSchema
ps1 Maybe ([Value] -> ([Value], [Value]))
-> Maybe [Value] -> Maybe ([Value], [Value])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParamSchema 'SwaggerKindSchema -> Maybe [Value]
forall (t :: SwaggerKind *). ParamSchema t -> Maybe [Value]
_paramSchemaEnum ParamSchema 'SwaggerKindSchema
ps2 of
            (Just ([Value]
es1, [Value]
es2)) ->
              Schema
forall a. Monoid a => a
mempty
                { _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema =
                    ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty
                      { _paramSchemaEnum :: Maybe [Value]
_paramSchemaEnum = [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value]) -> [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ [Value]
es1 [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value]
es2,
                        _paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType =
                          case (,) (SwaggerType 'SwaggerKindSchema
 -> SwaggerType 'SwaggerKindSchema
 -> (SwaggerType 'SwaggerKindSchema,
     SwaggerType 'SwaggerKindSchema))
-> Maybe (SwaggerType 'SwaggerKindSchema)
-> Maybe
     (SwaggerType 'SwaggerKindSchema
      -> (SwaggerType 'SwaggerKindSchema,
          SwaggerType 'SwaggerKindSchema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParamSchema 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall (t :: SwaggerKind *). ParamSchema t -> Maybe (SwaggerType t)
_paramSchemaType ParamSchema 'SwaggerKindSchema
ps1 Maybe
  (SwaggerType 'SwaggerKindSchema
   -> (SwaggerType 'SwaggerKindSchema,
       SwaggerType 'SwaggerKindSchema))
-> Maybe (SwaggerType 'SwaggerKindSchema)
-> Maybe
     (SwaggerType 'SwaggerKindSchema, SwaggerType 'SwaggerKindSchema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParamSchema 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall (t :: SwaggerKind *). ParamSchema t -> Maybe (SwaggerType t)
_paramSchemaType ParamSchema 'SwaggerKindSchema
ps2 of
                            Just (SwaggerType 'SwaggerKindSchema
t1, SwaggerType 'SwaggerKindSchema
t2)
                              | SwaggerType 'SwaggerKindSchema
t1 SwaggerType 'SwaggerKindSchema
-> SwaggerType 'SwaggerKindSchema -> Bool
forall a. Eq a => a -> a -> Bool
== SwaggerType 'SwaggerKindSchema
t2 -> SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
t1
                              | Bool
otherwise -> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. Maybe a
Nothing
                            Maybe
  (SwaggerType 'SwaggerKindSchema, SwaggerType 'SwaggerKindSchema)
Nothing -> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. Maybe a
Nothing
                      }
                }
            Maybe ([Value], [Value])
Nothing ->
              case (,) (SwaggerType 'SwaggerKindSchema
 -> SwaggerType 'SwaggerKindSchema
 -> (SwaggerType 'SwaggerKindSchema,
     SwaggerType 'SwaggerKindSchema))
-> Maybe (SwaggerType 'SwaggerKindSchema)
-> Maybe
     (SwaggerType 'SwaggerKindSchema
      -> (SwaggerType 'SwaggerKindSchema,
          SwaggerType 'SwaggerKindSchema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParamSchema 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall (t :: SwaggerKind *). ParamSchema t -> Maybe (SwaggerType t)
_paramSchemaType ParamSchema 'SwaggerKindSchema
ps1 Maybe
  (SwaggerType 'SwaggerKindSchema
   -> (SwaggerType 'SwaggerKindSchema,
       SwaggerType 'SwaggerKindSchema))
-> Maybe (SwaggerType 'SwaggerKindSchema)
-> Maybe
     (SwaggerType 'SwaggerKindSchema, SwaggerType 'SwaggerKindSchema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParamSchema 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall (t :: SwaggerKind *). ParamSchema t -> Maybe (SwaggerType t)
_paramSchemaType ParamSchema 'SwaggerKindSchema
ps2 of
                Just (SwaggerType 'SwaggerKindSchema
SwaggerObject, SwaggerType 'SwaggerKindSchema
SwaggerObject) ->
                  Schema
forall a. Monoid a => a
mempty
                    { _schemaRequired :: [Text]
_schemaRequired = Schema -> [Text]
_schemaRequired Schema
s1 [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Schema -> [Text]
_schemaRequired Schema
s2,
                      _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
_schemaProperties = InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
forall k v.
(Eq k, Hashable k) =>
InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.union (Schema -> InsOrdHashMap Text (Referenced Schema)
_schemaProperties Schema
s1) (Schema -> InsOrdHashMap Text (Referenced Schema)
_schemaProperties Schema
s2),
                      _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema = ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty {_paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
SwaggerObject}
                    }
                Just (SwaggerType 'SwaggerKindSchema
a, SwaggerType 'SwaggerKindSchema
b)
                  | SwaggerType 'SwaggerKindSchema
a SwaggerType 'SwaggerKindSchema
-> SwaggerType 'SwaggerKindSchema -> Bool
forall a. Eq a => a -> a -> Bool
== SwaggerType 'SwaggerKindSchema
b -> Schema
forall a. Monoid a => a
mempty {_schemaParamSchema :: ParamSchema 'SwaggerKindSchema
_schemaParamSchema = ParamSchema 'SwaggerKindSchema
forall a. Monoid a => a
mempty {_paramSchemaType :: Maybe (SwaggerType 'SwaggerKindSchema)
_paramSchemaType = SwaggerType 'SwaggerKindSchema
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall a. a -> Maybe a
Just SwaggerType 'SwaggerKindSchema
a}}
                  | Bool
otherwise -> Schema
overApproximation
                Maybe
  (SwaggerType 'SwaggerKindSchema, SwaggerType 'SwaggerKindSchema)
_ -> Schema
overApproximation

declareSpecificNamedSchemaRef :: Swagger.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 -> Swagger.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)