diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,11 @@ All notable changes to this project will be documented in this file. +## 1.3.0.0 + +- Support `JsonDict` from `json-spec` 1.4, generating OpenAPI object schemas + with typed `additionalProperties`. + ## 1.2.0.4 - Relaxed the upper bound on `time` to allow `time-1.15`. 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: 1.2.0.4 +version: 1.3.0.0 synopsis: json-spec-openapi description: This package provides a way to produce @@ -64,7 +64,7 @@ build-depends: , aeson >= 2.2.1.0 && < 2.3 , base >= 4.19.2.0 && < 4.23 - , json-spec >= 1.3.0.0 && < 1.4 + , json-spec >= 1.4.0.0 && < 1.5 , lens >= 5.2.3 && < 5.4 , openapi3 >= 3.2.5 && < 3.3 , text >= 2.1 && < 2.2 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 @@ -131,7 +131,6 @@ SchemaModifier(..), ) where - import Control.Lens (At(at), (&), over, set) import Data.Aeson (ToJSON(toJSON)) import Data.Functor.Identity (Identity(runIdentity)) @@ -139,16 +138,17 @@ ( FieldSpec(Optional, Required), HasJsonDecodingSpec(DecodingSpec) , HasJsonEncodingSpec(EncodingSpec) , Specification - ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt - , JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString - , JsonTag + ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonDict, JsonEither + , JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef + , JsonString, JsonTag ) ) import Data.JsonSpec.OpenApi.Rename (Rename) +import Data.Kind (Type) import Data.OpenApi - ( AdditionalProperties(AdditionalPropertiesAllowed) - , HasAdditionalProperties(additionalProperties) - , HasEnum(enum_), HasFormat(format), HasItems(items), HasOneOf(oneOf) + ( AdditionalProperties(AdditionalPropertiesAllowed, AdditionalPropertiesSchema) + , HasAdditionalProperties(additionalProperties), HasEnum(enum_) + , HasFormat(format), HasItems(items), HasOneOf(oneOf) , HasProperties(properties), HasRequired(required), HasType(type_) , NamedSchema(NamedSchema), OpenApiItems(OpenApiItemsObject) , OpenApiType @@ -161,19 +161,17 @@ import Data.OpenApi.Declare (DeclareT(runDeclareT), MonadDeclare(declare)) import Data.String (IsString(fromString)) import Data.Text (Text) -import Data.Kind (Type) import Data.Typeable (Proxy(Proxy), Typeable) import GHC.TypeError (ErrorMessage((:$$:), (:<>:)), Unsatisfiable, unsatisfiable) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Prelude - ( Applicative(pure, (<*>)), Bool(False), Functor(fmap), Maybe(Just, Nothing) + ( Applicative((<*>), pure), Bool(False), Functor(fmap), Maybe(Just, Nothing) , Monoid(mempty), ($), (.), (<$>), id ) import qualified Data.HashMap.Strict.InsOrd.Compat as HMI import qualified Data.OpenApi as OA import qualified GHC.TypeError as TE - {-| Convert a 'Specification' into an OpenApi 'Schema'. The type class 'Schemaable' is an internal and opaque implementation detail and not @@ -341,6 +339,19 @@ mempty & set type_ (Just OpenApiArray) & set items (Just (OpenApiItemsObject elementSchema)) +instance {- Inlineable defs (JsonDict spec) -} + (Refable defs spec) + => + Inlineable defs (JsonDict spec) + where + inlineable = do + valueSchema <- refable @defs @spec + pure $ + mempty + & set type_ (Just OpenApiObject) + & set + additionalProperties + (Just (AdditionalPropertiesSchema valueSchema)) instance Inlineable defs JsonBool where inlineable = pure $ diff --git a/src/Data/JsonSpec/OpenApi/Rename.hs b/src/Data/JsonSpec/OpenApi/Rename.hs --- a/src/Data/JsonSpec/OpenApi/Rename.hs +++ b/src/Data/JsonSpec/OpenApi/Rename.hs @@ -11,7 +11,7 @@ import Data.JsonSpec ( FieldSpec(Optional, Required) , Specification - ( JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt, JsonLet + ( JsonArray, JsonBool, JsonDateTime, JsonDict, JsonEither, JsonInt, JsonLet , JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString, JsonTag ) ) @@ -19,7 +19,6 @@ import GHC.TypeLits (type (+), AppendSymbol, Nat, Symbol) import qualified GHC.TypeError as TE - {-| Resolve OpenApi name conflicts. @@ -116,6 +115,9 @@ FoldRename global active (JsonArray spec) = MapSpec JsonArray (FoldRename global active spec) + + FoldRename global active (JsonDict spec) = + MapSpec JsonDict (FoldRename global active spec) FoldRename global active (JsonObject fields) = RenameObject global active fields diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -21,29 +21,28 @@ , HasJsonDecodingSpec(DecodingSpec, fromJSONStructure) , HasJsonEncodingSpec(EncodingSpec, toJSONStructure), SpecJSON(SpecJSON) , Specification - ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt - , JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString - , JsonTag + ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonDict, JsonEither + , JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef + , JsonString, JsonTag ) , (:::), (::?), unField ) import Data.JsonSpec.OpenApi - ( EncodingSchema, Rename, SchemaModifier(modifySchema), toOpenApiSchema + ( SchemaModifier(modifySchema), EncodingSchema, Rename, toOpenApiSchema ) import Data.OpenApi (Definitions, ToSchema) import Data.Proxy (Proxy(Proxy)) import Data.Text (Text) import Data.Time (UTCTime) import Prelude - ( Applicative(pure), Bool(False), Eq, Functor(fmap), Int, IO, Maybe(Just) - , Monoid(mempty), Show, ($), (.) + ( Applicative(pure), Bool(False), Functor(fmap), Maybe(Just), Monoid(mempty) + , ($), (.), Eq, IO, Int, Show ) import Test.Hspec (describe, hspec, it, shouldBe) import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict.InsOrd.Compat as HMI import qualified Data.OpenApi as OA - main :: IO () main = hspec $ do @@ -210,6 +209,26 @@ )) ) + in + actual `shouldBe` expected + + it "dict" $ + let + actual :: (Definitions OA.Schema, OA.Schema) + actual = + toOpenApiSchema (Proxy @(JsonDict JsonInt)) + + expected :: (Definitions OA.Schema, OA.Schema) + expected = + ( mempty + , mempty + & set OA.type_ (Just OA.OpenApiObject) + & set + OA.additionalProperties + (Just ( + OA.AdditionalPropertiesSchema (OA.Inline intSchema) + )) + ) in actual `shouldBe` expected