diff --git a/json-spec-openapi.cabal b/json-spec-openapi.cabal --- a/json-spec-openapi.cabal +++ b/json-spec-openapi.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec-openapi -version: 0.1.0.3 +version: 0.2.0.0 synopsis: json-spec-openapi description: This package provides a way to produce @@ -62,12 +62,13 @@ common dependencies build-depends: - , aeson >= 2.2.1.0 && < 2.3 - , base >= 4.19.0.0 && < 4.20 - , json-spec >= 0.2.1.3 && < 0.3 - , lens >= 5.2.3 && < 5.3 - , openapi3 >= 3.2.4 && < 3.3 - , text >= 2.1 && < 2.2 + , aeson >= 2.2.1.0 && < 2.3 + , base >= 4.19.0.0 && < 4.20 + , insert-ordered-containers >= 0.2.5 && < 0.3 + , json-spec >= 0.2.1.3 && < 0.3 + , lens >= 5.2.3 && < 5.3 + , openapi3 >= 3.2.4 && < 3.3 + , text >= 2.1 && < 2.2 common warnings ghc-options: diff --git a/src/Data/JsonSpec/OpenApi.hs b/src/Data/JsonSpec/OpenApi.hs --- a/src/Data/JsonSpec/OpenApi.hs +++ b/src/Data/JsonSpec/OpenApi.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -92,6 +93,7 @@ -} module Data.JsonSpec.OpenApi ( toOpenApiSchema, + Schemaable, EncodingSchema(..), DecodingSchema(..), ) where @@ -99,115 +101,293 @@ import Control.Lens (At(at), (&), over, set) import Data.Aeson (ToJSON(toJSON)) +import Data.Functor.Identity (Identity(runIdentity)) import Data.JsonSpec (HasJsonDecodingSpec(DecodingSpec), HasJsonEncodingSpec(EncodingSpec), Specification(JsonArray, JsonBool, - JsonDateTime, JsonEither, JsonInt, JsonNum, JsonObject, JsonString, - JsonTag)) + JsonDateTime, JsonEither, JsonInt, JsonLet, JsonNum, JsonObject, + JsonRef, JsonString, JsonTag)) import Data.OpenApi (AdditionalProperties(AdditionalPropertiesAllowed), HasAdditionalProperties(additionalProperties), HasEnum(enum_), HasFormat(format), HasItems(items), HasOneOf(oneOf), HasProperties(properties), HasRequired(required), HasType(type_), NamedSchema(NamedSchema), OpenApiItems(OpenApiItemsObject), - OpenApiType(OpenApiArray, OpenApiBoolean, OpenApiInteger, - OpenApiNumber, OpenApiObject, OpenApiString), Referenced(Inline), - ToSchema(declareNamedSchema), Schema) + OpenApiType(OpenApiArray, OpenApiBoolean, OpenApiInteger, OpenApiNumber, + OpenApiObject, OpenApiString), Reference(Reference), Referenced(Inline, + Ref), ToSchema(declareNamedSchema), Definitions, Schema) +import Data.OpenApi.Declare (DeclareT(runDeclareT), MonadDeclare(declare)) import Data.String (IsString(fromString)) import Data.Text (Text) import Data.Typeable (Proxy(Proxy), Typeable) -import GHC.TypeLits (KnownSymbol, symbolVal) -import Prelude (Applicative(pure), Bool(False), Maybe(Just, Nothing), - Monoid(mempty), ($)) +import GHC.TypeError (ErrorMessage((:$$:), (:<>:)), Unsatisfiable, + unsatisfiable) +import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) +import Prelude (Applicative(pure), Bool(False), Functor(fmap), Maybe(Just, + Nothing), Monoid(mempty), ($), (.)) +import qualified Data.HashMap.Strict.InsOrd as HMI +import qualified GHC.TypeError as TE {-| - Convert a 'Specification' into an OpenAPI 'Schema'. The type class - 'Internal' is an internal and opaque implementation detail and not - something you should have to worry about. It /should/ already have an - instance for every possible 'Specification' that can be constructed. If - it does not, then that is a bug. Please report it! :-) + Convert a 'Specification' into an OpenApi 'Schema'. The type class + 'Schemaable' is an internal and opaque implementation detail and not + something you should have to worry about. + + It should already have an instance for every 'Specification' that can + be turned into a 'Schema'. If it does not, then that is a bug. Please + report it! :-) + + The limitations of this function are: + + * It behaves in a possibly unexpected way when given a top level schema + of the form: + + > JsonLet '[ + > '("foo", ...) + > ] ( + > JsonRef "foo" + > ) + + 'toOpenApiSchema' returns a 'Schema', not a @'Referenced' 'Schema'@. + Therefore, if the \"top level\" of the 'Specification' is a 'JsonRef', + then we will try to dereference and inline the referenced schema. In + other words, + + > toOpenApiSchema (Proxy @( + > JsonLet + > '[ '("foo", JsonString) ] + > (JsonRef "foo") + > )) + + will behave as if you had called + + > toOpenApiSchema (Proxy @( + > JsonLet + > '[ '("foo", JsonString) ] + > JsonString + > )) + + However, if the reference is undefined, then you will get a custom + type error explaining what the problem is. + + * With the exception of the above point, we do not check to make sure + that every referenced used in the returned 'Schema' actually contains + a definition. So for instance this will \"work\": + + > let + > (defs, schema) = + > toOpenApiSchema + > (Proxy @( + > JsonObject '[ + > ("bar", JsonRef "not-defined") + > ] + > )) + > in + > ... + + This will compile, and will not throw any runtime errors directly, + but depending on how you /use/ @defs@ and @schema@ (like, for + instance, generating an OpenApi specification) you will probably + encounter a runtime error complaining that "not-defined" hasn't + been defined. -} toOpenApiSchema - :: (Internal spec) + :: (Schemaable spec) => Proxy (spec :: Specification) - -> Schema -toOpenApiSchema = internal + -> (Definitions Schema, Schema) +toOpenApiSchema spec = + runIdentity (runDeclareT (schemaable spec) mempty) -class Internal (spec :: Specification) where - {-| - Given a `Specification`, produce an OpenApi schema equivalent to - the specification. Usually you will want to use this in conjunction with - `HasJsonEncodingSpec` or `HasJsonDecodingSpec`. +{-| + Specifications that can be turned into OpenApi Schemas or a reference + to a schema. +-} +class Refable (spec :: Specification) where + refable + :: (MonadDeclare (Definitions Schema) m) + => Proxy spec + -> m (Referenced Schema) +instance (KnownSymbol name) => Refable (JsonRef name) where + refable Proxy = + pure (ref (sym @name)) +instance + ( Defs defs + , KnownSymbol name + ) + => + Refable (JsonLet defs (JsonRef name)) + where + refable Proxy = do + mkDefs (Proxy @defs) + refable (Proxy @(JsonRef name)) +instance {-# overlaps #-} (Schemaable a) => Refable a where + refable = fmap Inline . schemaable - Example: - > data MyType = ... - > instance HasJsonEncodingSpec MyType where - > type EncodingSpec MyType = ... - > - > schema :: Schema - > schema = toOpenApiSchema (Proxy :: Proxy (EncodingSpec MyType)) - - -} - internal :: Proxy spec -> Schema -instance (KnownSymbol tag) => Internal ('JsonTag tag) where - internal _ = - mempty & set enum_ (Just [toJSON (sym @tag :: Text)]) +{-| + Specifications that can be turned into OpenApi 'Schema's. -instance Internal 'JsonString where - internal _ = - mempty & set type_ (Just OpenApiString) -instance (Internal left, Internal right) => Internal ('JsonEither left right) where - internal _ = - mempty - & set oneOf (Just - [ Inline (internal (Proxy @left)) - , Inline (internal (Proxy @right)) - ] - ) -instance Internal 'JsonNum where - internal _ = - mempty & set type_ (Just OpenApiNumber) -instance Internal 'JsonInt where - internal _ = - mempty & set type_ (Just OpenApiInteger) -instance Internal ('JsonObject '[]) where - internal _ = - mempty - & set type_ (Just OpenApiObject) - & set additionalProperties (Just (AdditionalPropertiesAllowed False)) -instance (KnownSymbol key, Internal spec, Internal ('JsonObject more)) => Internal ('JsonObject ( '(key, spec) : more )) where - internal _ = - let - propertyName :: Text - propertyName = sym @key + This is intended to be an opaque implementation detail. The only + reason it is exported is because there are some cases where you might + need to be able to spell this constraint in code that builds off of + this package. +-} +class Schemaable (spec :: Specification) where + schemaable + :: (MonadDeclare (Definitions Schema) m) + => Proxy spec + -> m Schema +instance (KnownSymbol tag) => Schemaable ('JsonTag tag) where + schemaable Proxy = + pure $ + mempty & set enum_ (Just [toJSON (sym @tag :: Text)]) +instance Schemaable 'JsonString where + schemaable Proxy = + pure $ + mempty & set type_ (Just OpenApiString) +instance {- Schemaable ('JsonEither left right) -} + ( Schemaable left + , Schemaable right + ) + => + Schemaable ('JsonEither left right) + where + schemaable Proxy = do + schemaLeft <- schemaable (Proxy @left) + schemaRight <- schemaable (Proxy @right) + pure $ + mempty + & set oneOf (Just + [ Inline schemaLeft + , Inline schemaRight + ] + ) +instance Schemaable 'JsonNum where + schemaable Proxy = + pure $ + mempty & set type_ (Just OpenApiNumber) +instance Schemaable 'JsonInt where + schemaable Proxy = + pure $ + mempty & set type_ (Just OpenApiInteger) +instance Schemaable ('JsonObject '[]) where + schemaable Proxy = + pure $ + mempty + & set type_ (Just OpenApiObject) + & set additionalProperties (Just (AdditionalPropertiesAllowed False)) +instance {- Schemaable ('JsonObject ( '(key, spec) : more )) -} + ( Schemaable ('JsonObject more) + , Refable spec + , KnownSymbol key + ) + => + Schemaable ('JsonObject ( '(key, spec) : more )) + where + schemaable Proxy = do + let + propertyName :: Text + propertyName = sym @key - propertySchema :: Schema - propertySchema = internal (Proxy @spec) - in - internal (Proxy @('JsonObject more)) - & over properties (set (at propertyName) (Just (Inline propertySchema))) - & over required (propertyName:) -instance (Internal spec) => Internal ('JsonArray spec) where - internal _ = - let - elementSchema :: Schema - elementSchema = internal (Proxy @spec) - in + propertySchema <- refable (Proxy @spec) + more <- schemaable (Proxy @('JsonObject more)) + pure $ + more + & over + properties + (set (at propertyName) (Just propertySchema)) + & over required (propertyName:) +instance (Schemaable spec) => Schemaable ('JsonArray spec) where + schemaable Proxy = do + elementSchema <- schemaable (Proxy @spec) + pure $ mempty & set type_ (Just OpenApiArray) & set items (Just (OpenApiItemsObject (Inline elementSchema))) -instance Internal 'JsonBool where - internal _ = - mempty & set type_ (Just OpenApiBoolean) +instance Schemaable 'JsonBool where + schemaable Proxy = + pure $ + mempty & set type_ (Just OpenApiBoolean) +instance Schemaable 'JsonDateTime where + schemaable Proxy = + pure $ + mempty + & set type_ (Just OpenApiString) + & set format (Just "date-time") +instance + Unsatisfiable ( + T "`JsonRef \"" :<>: T target :<>: T "\"` is not defined.\n" + :$$: T "You are trying to use a JsonRef as the \"top level\" " + :$$: T "schema. We try to satisfy this request by looking up " + :$$: T "the reference and inlining it. However in this case you " + :$$: T "are trying to reference a schema which is not defined, " + :$$: T "so this won't work.\n" + ) + => + Schemaable (JsonLet '[] (JsonRef target)) + where + schemaable = unsatisfiable +instance {- Schemaable (JsonLet ( '(target, def) ': more) (JsonRef target)) -} + {-# overlaps #-} + ( KnownSymbol target + , Schemaable def + , Schemaable (JsonLet more def) + ) + => + Schemaable (JsonLet ( '(target, def) ': more) (JsonRef target)) + where + schemaable Proxy = do + defSchema <- schemaable (Proxy @def) + declare (HMI.singleton (sym @target) defSchema) + schemaable (Proxy @(JsonLet more def)) +instance {- Schemaable (JsonLet ( '(name, def) ': more) (JsonRef target)) -} + {-# overlaps #-} + ( KnownSymbol name + , Schemaable def + , Schemaable (JsonLet more (JsonRef target)) + ) + => + Schemaable (JsonLet ( '(name, def) ': more) (JsonRef target)) + where + schemaable Proxy = do + defSchema <- schemaable (Proxy @def) + declare (HMI.singleton (sym @name) defSchema) + schemaable (Proxy @(JsonLet more (JsonRef target))) +instance {- Schemaable (JsonLet defs spec) -} + {-# overlaps #-} + ( Defs defs + , Schemaable spec + ) + => + Schemaable (JsonLet defs spec) + where + schemaable Proxy = do + mkDefs (Proxy @defs) + schemaable (Proxy @spec) -instance Internal 'JsonDateTime where - internal _ = - mempty - & set type_ (Just OpenApiString) - & set format (Just "date-time") +{-| Go through and make a declaration for each item in a JsonLet. -} +class Defs (defs :: [(Symbol, Specification)]) where + mkDefs + :: (MonadDeclare (Definitions Schema) m) + => Proxy defs + -> m () +instance Defs '[] where + mkDefs Proxy = pure () +instance + ( Defs more + , Schemaable spec + , KnownSymbol name + ) + => + Defs ( '(name, spec) ': more) + where + mkDefs Proxy = do + schema <- schemaable (Proxy @spec) + declare (HMI.singleton (sym @name) schema) + mkDefs (Proxy @more) + {-| Helper for defining `ToSchema` instances based on `HasJsonEncodingSpec` using @deriving via@. @@ -221,9 +401,17 @@ -} newtype EncodingSchema a = EncodingSchema {unEncodingSchema :: a} -instance (Typeable a, Internal (EncodingSpec a)) => ToSchema (EncodingSchema a) where - declareNamedSchema _ = - pure (NamedSchema Nothing (toOpenApiSchema (Proxy @(EncodingSpec a)))) +instance + ( Schemaable (EncodingSpec a) + , Typeable a + ) + => + ToSchema (EncodingSchema a) + where + declareNamedSchema _ = do + let (declarations, schema) = toOpenApiSchema (Proxy @(EncodingSpec a)) + declare declarations + pure (NamedSchema Nothing schema) {-| @@ -239,9 +427,17 @@ -} newtype DecodingSchema a = DecodingSchema {unDecodingSchema :: a} -instance (Typeable a, Internal (DecodingSpec a)) => ToSchema (DecodingSchema a) where - declareNamedSchema _ = - pure (NamedSchema Nothing (toOpenApiSchema (Proxy @(DecodingSpec a)))) +instance + ( Schemaable (DecodingSpec a) + , Typeable a + ) + => + ToSchema (DecodingSchema a) + where + declareNamedSchema _ = do + let (declarations, schema) = toOpenApiSchema (Proxy @(DecodingSpec a)) + declare declarations + pure (NamedSchema Nothing schema) {- | Shorthand for demoting type-level strings. -} @@ -252,5 +448,13 @@ ) => b sym = fromString $ symbolVal (Proxy @a) + + +ref :: Text -> Referenced a +ref = Ref . Reference + + +{-| Shorthand for building custom type errors. -} +type T (msg :: Symbol) = TE.Text msg diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -12,19 +12,20 @@ module Main (main) where import Control.Lens (At(at), (&), set) -import Data.Aeson (FromJSON, ToJSON, encode, toJSON) +import Data.Aeson (ToJSON(toJSON), FromJSON, encode) import Data.JsonSpec (Field(Field), HasJsonDecodingSpec(DecodingSpec, fromJSONStructure), HasJsonEncodingSpec(EncodingSpec, toJSONStructure), SpecJSON(SpecJSON), Specification(JsonArray, JsonBool, JsonDateTime, - JsonEither, JsonNum, JsonObject, JsonString, JsonTag)) + JsonEither, JsonLet, JsonNum, JsonObject, JsonRef, JsonString, JsonTag)) import Data.JsonSpec.OpenApi (EncodingSchema, toOpenApiSchema) -import Data.OpenApi (ToSchema) +import Data.OpenApi (Definitions, ToSchema) import Data.Proxy (Proxy(Proxy)) import Data.Text (Text) import Data.Time (UTCTime) import Prelude (Applicative(pure), Bool(False), Maybe(Just), Monoid(mempty), ($), Eq, IO, Show) import Test.Hspec (describe, hspec, it, shouldBe) +import qualified Data.HashMap.Strict.InsOrd as HMI import qualified Data.OpenApi as OA @@ -34,18 +35,17 @@ describe "toOpenApiSchema" $ do it "string" $ let - actual :: OA.Schema - actual = - toOpenApiSchema (Proxy @JsonString) + actual :: (Definitions OA.Schema, OA.Schema) + actual = toOpenApiSchema (Proxy @JsonString) - expected :: OA.Schema - expected = stringSchema + expected :: (Definitions OA.Schema, OA.Schema) + expected = (mempty, stringSchema) in actual `shouldBe` expected it "sum" $ let - actual :: OA.Schema + actual :: (Definitions OA.Schema, OA.Schema) actual = toOpenApiSchema (Proxy @( JsonEither @@ -63,47 +63,48 @@ ) )) - expected :: OA.Schema + expected :: (Definitions OA.Schema, OA.Schema) expected = - mempty - & set OA.oneOf (Just - [ OA.Inline $ - mempty - & set OA.type_ (Just OA.OpenApiObject) - & set OA.properties ( - mempty - & set (at "tag") (Just (OA.Inline ( - mempty & set OA.enum_ (Just [toJSON ("a" :: Text)]) - ))) - & set (at "content") (Just (OA.Inline stringSchema)) - ) - & set OA.required ["tag", "content"] - & set - OA.additionalProperties - (Just (OA.AdditionalPropertiesAllowed False)) - , OA.Inline $ - mempty - & set OA.type_ (Just OA.OpenApiObject) - & set OA.properties ( - mempty - & set (at "tag") (Just (OA.Inline ( - mempty & set OA.enum_ (Just [toJSON ("b" :: Text)]) - ))) - & set (at "content") (Just (OA.Inline stringSchema)) - ) - & set OA.required ["tag", "content"] - & set - OA.additionalProperties - (Just (OA.AdditionalPropertiesAllowed False)) - ] - ) + ( mempty + , mempty + & set OA.oneOf (Just + [ OA.Inline $ + mempty + & set OA.type_ (Just OA.OpenApiObject) + & set OA.properties ( + mempty + & set (at "tag") (Just (OA.Inline ( + mempty & set OA.enum_ (Just [toJSON ("a" :: Text)]) + ))) + & set (at "content") (Just (OA.Inline stringSchema)) + ) + & set OA.required ["tag", "content"] + & set + OA.additionalProperties + (Just (OA.AdditionalPropertiesAllowed False)) + , OA.Inline $ + mempty + & set OA.type_ (Just OA.OpenApiObject) + & set OA.properties ( + mempty + & set (at "tag") (Just (OA.Inline ( + mempty & set OA.enum_ (Just [toJSON ("b" :: Text)]) + ))) + & set (at "content") (Just (OA.Inline stringSchema)) + ) + & set OA.required ["tag", "content"] + & set + OA.additionalProperties + (Just (OA.AdditionalPropertiesAllowed False)) + ] + ) + ) in actual `shouldBe` expected - it "object" $ let - actual :: OA.Schema + actual :: (Definitions OA.Schema, OA.Schema) actual = toOpenApiSchema (Proxy @( JsonObject '[ @@ -112,36 +113,37 @@ ] )) - expected :: OA.Schema + expected :: (Definitions OA.Schema, OA.Schema) expected = - mempty - & set OA.type_ (Just OA.OpenApiObject) - & set OA.properties ( - mempty - & set (at "Foo") (Just (OA.Inline stringSchema)) - & set (at "Bar") (Just (OA.Inline stringSchema)) - ) - & set OA.required ["Foo", "Bar"] - & set - OA.additionalProperties - (Just (OA.AdditionalPropertiesAllowed False)) + ( mempty + , mempty + & set OA.type_ (Just OA.OpenApiObject) + & set OA.properties ( + mempty + & set (at "Foo") (Just (OA.Inline stringSchema)) + & set (at "Bar") (Just (OA.Inline stringSchema)) + ) + & set OA.required ["Foo", "Bar"] + & set + OA.additionalProperties + (Just (OA.AdditionalPropertiesAllowed False)) + ) in actual `shouldBe` expected it "num" $ let - actual :: OA.Schema - actual = - toOpenApiSchema (Proxy @JsonNum) + actual :: (Definitions OA.Schema, OA.Schema) + actual = toOpenApiSchema (Proxy @JsonNum) - expected :: OA.Schema - expected = numSchema + expected :: (Definitions OA.Schema, OA.Schema) + expected = (mempty, numSchema) in actual `shouldBe` expected it "complex array" $ let - actual :: OA.Schema + actual :: (Definitions OA.Schema, OA.Schema) actual = toOpenApiSchema (Proxy @( JsonArray ( @@ -152,53 +154,140 @@ ) )) - expected :: OA.Schema + expected :: (Definitions OA.Schema, OA.Schema) expected = - let - elementSchema :: OA.Schema - elementSchema = + ( mempty + , let + elementSchema :: OA.Schema + elementSchema = + mempty + & set OA.type_ (Just OA.OpenApiObject) + & set OA.properties ( + mempty + & set (at "Foo") (Just (OA.Inline stringSchema)) + & set (at "Bar") (Just (OA.Inline stringSchema)) + ) + & set OA.required ["Foo", "Bar"] + & set + OA.additionalProperties + (Just (OA.AdditionalPropertiesAllowed False)) + in mempty - & set OA.type_ (Just OA.OpenApiObject) - & set OA.properties ( - mempty - & set (at "Foo") (Just (OA.Inline stringSchema)) - & set (at "Bar") (Just (OA.Inline stringSchema)) - ) - & set OA.required ["Foo", "Bar"] - & set - OA.additionalProperties - (Just (OA.AdditionalPropertiesAllowed False)) - in - mempty - & set OA.type_ (Just OA.OpenApiArray) - & set OA.items (Just (OA.OpenApiItemsObject (OA.Inline elementSchema))) + & set OA.type_ (Just OA.OpenApiArray) + & set OA.items (Just (OA.OpenApiItemsObject (OA.Inline elementSchema))) + ) in actual `shouldBe` expected it "bool" $ let - actual :: OA.Schema + actual :: (Definitions OA.Schema, OA.Schema) actual = toOpenApiSchema (Proxy @JsonBool) - expected :: OA.Schema - expected = boolSchema + expected :: (Definitions OA.Schema, OA.Schema) + expected = (mempty, boolSchema) in actual `shouldBe` expected it "date-time" $ let - actual :: OA.Schema + actual :: (Definitions OA.Schema, OA.Schema) actual = toOpenApiSchema (Proxy @JsonDateTime) - expected :: OA.Schema + expected :: (Definitions OA.Schema, OA.Schema) expected = - stringSchema - & set OA.format (Just "date-time") + ( mempty + , stringSchema & set OA.format (Just "date-time") + ) in actual `shouldBe` expected + + it "let expression" $ + let + actual :: (Definitions OA.Schema, OA.Schema) + actual = + toOpenApiSchema (Proxy @( + JsonLet '[ + '("thing", JsonString) + ] + ( + JsonObject '[ + '("foo", JsonRef "thing") + ] + ) + )) + + expected :: (Definitions OA.Schema, OA.Schema) + expected = + ( HMI.singleton "thing" stringSchema + , mempty + & set OA.type_ (Just OA.OpenApiObject) + & set OA.properties ( + mempty + & set (at "foo") (Just (OA.Ref (OA.Reference "thing"))) + ) + & set OA.required ["foo"] + & set + OA.additionalProperties + (Just (OA.AdditionalPropertiesAllowed False)) + ) + in + actual `shouldBe` expected + + it "top level reference" $ + let + actual :: (Definitions OA.Schema, OA.Schema) + actual = + toOpenApiSchema (Proxy @( + JsonLet '[ + '("foo", JsonNum), + '("bar", JsonString) + ] + (JsonRef "bar") + )) + + expected :: (Definitions OA.Schema, OA.Schema) + expected = + ( HMI.fromList [("foo", numSchema), ("bar", stringSchema)] + , stringSchema + ) + in + actual `shouldBe` expected + + it "lower level reference" $ + let + actual :: (Definitions OA.Schema, OA.Schema) + actual = + toOpenApiSchema (Proxy @( + JsonObject '[ + '("foo", + JsonLet + '[ '("thing", JsonString)] + (JsonRef "thing") + ) + ] + )) + + expected :: (Definitions OA.Schema, OA.Schema) + expected = + ( HMI.singleton "thing" stringSchema + , mempty + & set OA.type_ (Just OA.OpenApiObject) + & set OA.properties ( + mempty + & set (at "foo") (Just (OA.Ref (OA.Reference "thing"))) + ) + & set OA.required ["foo"] + & set + OA.additionalProperties + (Just (OA.AdditionalPropertiesAllowed False)) + ) + in + actual `shouldBe` expected + describe "EncodingSpec" $ it "works" $ let