diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -12,18 +12,18 @@ ```haskell data User = User { name :: Text - , lastLogin :: UTCTime + , lastLogin :: Maybe UTCTime } deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here instance HasJsonEncodingSpec User where type EncodingSpec User = JsonObject - '[ '("name", JsonString) - , '("last-login", JsonDateTime) + '[ Required "name" JsonString + , Optional "last-login" JsonDateTime ] toJSONStructure user = (Field @"name" (name user), - (Field @"last-login" (lastLogin user), + (fmap (Field @"last-login") (lastLogin user), ())) ``` @@ -43,8 +43,7 @@ } }, "required": [ - "name", - "last-login" + "name" ], "type": "object" } 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.2.1.1 +version: 0.3.0.0 synopsis: json-spec-openapi description: This package provides a way to produce @@ -14,18 +14,18 @@ > data User = User > { name :: Text - > , lastLogin :: UTCTime + > , lastLogin :: Maybe UTCTime > } > deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here > instance HasJsonEncodingSpec User where > type EncodingSpec User = > JsonObject - > '[ '("name", JsonString) - > , '("last-login", JsonDateTime) + > '[ Required "name" JsonString + > , Optional "last-login" JsonDateTime > ] > toJSONStructure user = > (Field @"name" (name user), - > (Field @"last-login" (lastLogin user), + > (fmap (Field @"last-login") (lastLogin user), > ())) Calling `Data.Aeson.encode (Data.OpenApi3.toSchema (Proxy :: Proxy User))` @@ -43,8 +43,7 @@ > } > }, > "required": [ - > "name", - > "last-login" + > "name" > ], > "type": "object" > } @@ -65,7 +64,7 @@ , aeson >= 2.2.1.0 && < 2.3 , base >= 4.19.0.0 && < 4.20 , insert-ordered-containers >= 0.2.5.3 && < 0.3 - , json-spec >= 0.2.1.3 && < 0.3 + , json-spec >= 0.3.0.0 && < 0.4 , lens >= 5.2.3 && < 5.3 , openapi3 >= 3.2.4 && < 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 @@ -25,18 +25,18 @@ > data User = User > { name :: Text - > , lastLogin :: UTCTime + > , lastLogin :: Maybe UTCTime > } > deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here > instance HasJsonEncodingSpec User where > type EncodingSpec User = > JsonObject - > '[ '("name", JsonString) - > , '("last-login", JsonDateTime) + > '[ Required "name" JsonString + > , Optional "last-login" JsonDateTime > ] > toJSONStructure user = > (Field @"name" (name user), - > (Field @"last-login" (lastLogin user), + > (fmap (Field @"last-login") (lastLogin user), > ())) Calling @'Data.Aeson.encode' ('Data.OpenApi3.toSchema' ('Proxy' :: 'Proxy' User))@ @@ -54,8 +54,7 @@ > } > }, > "required": [ - > "name", - > "last-login" + > "name" > ], > "type": "object" > } @@ -66,17 +65,17 @@ > data User = User > { name :: Text - > , lastLogin :: UTCTime + > , lastLogin :: Maybe UTCTime > } > instance HasJsonEncodingSpec User where > type EncodingSpec User = > JsonObject - > '[ '("name", JsonString) - > , '("last-login", JsonDateTime) + > '[ Required "name" JsonString + > , Optional "last-login" JsonDateTime > ] > toJSONStructure user = > (Field @"name" (name user), - > (Field @"last-login" (lastLogin user), + > (fmap (Field @"last-login") (lastLogin user), > ())) > instance ToSchema User where > declareNamedSchema _proxy = @@ -102,10 +101,11 @@ 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, JsonLet, JsonNullable, JsonNum, - JsonObject, JsonRef, JsonString, JsonTag)) +import Data.JsonSpec (FieldSpec(Optional, Required), + HasJsonDecodingSpec(DecodingSpec), HasJsonEncodingSpec(EncodingSpec), + Specification(JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt, + JsonLet, JsonNullable, JsonNum, JsonObject, JsonRef, JsonString, + JsonTag)) import Data.OpenApi (AdditionalProperties(AdditionalPropertiesAllowed), HasAdditionalProperties(additionalProperties), HasEnum(enum_), HasFormat(format), HasItems(items), HasOneOf(oneOf), @@ -277,27 +277,36 @@ mempty & set type_ (Just OpenApiObject) & set additionalProperties (Just (AdditionalPropertiesAllowed False)) -instance {- Schemaable ('JsonObject ( '(key, spec) : more )) -} +instance {- Schemaable ('JsonObject ( Optional key spec : more )) -} ( Schemaable ('JsonObject more) , Refable spec , KnownSymbol key ) => - Schemaable ('JsonObject ( '(key, spec) : more )) + Schemaable ('JsonObject ( Optional key spec : more )) where schemaable Proxy = do - let - propertyName :: Text - propertyName = sym @key - propertySchema <- refable (Proxy @spec) more <- schemaable (Proxy @('JsonObject more)) pure $ more & over properties - (set (at propertyName) (Just propertySchema)) - & over required (propertyName:) + (set (at (sym @key)) (Just propertySchema)) +instance {- Schemaable ('JsonObject ( Required key spec : more )) -} + ( Schemaable ('JsonObject more) + , Refable spec + , KnownSymbol key + ) + => + Schemaable (JsonObject ( Required key spec : more )) + where + schemaable Proxy = do + schema <- schemaable (Proxy @(JsonObject ( Optional key spec : more ))) + pure $ + schema + & over required (sym @key:) + instance (Schemaable spec) => Schemaable ('JsonArray spec) where schemaable Proxy = do elementSchema <- schemaable (Proxy @spec) diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -8,23 +8,25 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} module Main (main) where import Control.Lens (At(at), (&), set) 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, JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, - JsonRef, JsonString, JsonTag)) +import Data.JsonSpec (Field(Field, unField), FieldSpec(Optional, + Required), HasJsonDecodingSpec(DecodingSpec, fromJSONStructure), + HasJsonEncodingSpec(EncodingSpec, toJSONStructure), SpecJSON(SpecJSON), + Specification(JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt, + JsonLet, JsonNullable, JsonNum, JsonObject, JsonRef, JsonString, + JsonTag)) import Data.JsonSpec.OpenApi (EncodingSchema, 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), Maybe(Just), - Monoid(mempty), ($), Eq, IO, Show) +import Prelude (Applicative(pure), Bool(False), Functor(fmap), + 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 @@ -52,14 +54,14 @@ JsonEither ( JsonObject - '[ '("tag", JsonTag "a") - , '("content", JsonString) + '[ Required "tag" (JsonTag "a") + , Required "content" JsonString ] ) ( JsonObject - '[ '("tag", JsonTag "b") - , '("content", JsonString) + '[ Required "tag" (JsonTag "b") + , Required "content" JsonString ] ) )) @@ -109,8 +111,8 @@ actual = toOpenApiSchema (Proxy @( JsonObject '[ - '("Foo", JsonString), - '("Bar", JsonString) + Required "Foo" JsonString, + Required "Bar" JsonString ] )) @@ -149,8 +151,8 @@ toOpenApiSchema (Proxy @( JsonArray ( JsonObject '[ - '("Foo", JsonString), - '("Bar", JsonString) + Required "Foo" JsonString, + Required "Bar" JsonString ] ) )) @@ -213,6 +215,35 @@ in encode actual `shouldBe` encode expected + it "optional" $ + let + actual :: (Definitions OA.Schema, OA.Schema) + actual = + toOpenApiSchema (Proxy @( + JsonObject '[ + Required "foo" JsonString, + Optional "bar" JsonString + ] + )) + + expected :: (Definitions OA.Schema, OA.Schema) + expected = + ( 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"] + & set + OA.additionalProperties + (Just (OA.AdditionalPropertiesAllowed False)) + ) + in + encode actual `shouldBe` encode expected + it "date-time" $ let actual :: (Definitions OA.Schema, OA.Schema) @@ -237,7 +268,7 @@ ] ( JsonObject '[ - '("foo", JsonRef "thing") + Required "foo" (JsonRef "thing") ] ) )) @@ -285,11 +316,11 @@ actual = toOpenApiSchema (Proxy @( JsonObject '[ - '("foo", + Required "foo" ( JsonLet '[ '("thing", JsonString)] (JsonRef "thing") - ) + ) ] )) @@ -310,7 +341,7 @@ in actual `shouldBe` expected - describe "EncodingSpec" $ + describe "EncodingSchema" $ it "works" $ let actual :: OA.Schema @@ -325,7 +356,7 @@ & set (at "name") (Just (OA.Inline stringSchema)) & set (at "last-login") (Just (OA.Inline dateSchema)) ) - & set OA.required ["name", "last-login"] + & set OA.required ["name"] & set OA.additionalProperties (Just (OA.AdditionalPropertiesAllowed False)) @@ -334,28 +365,32 @@ encode actual `shouldBe` encode expected +{- + This is the example used in the docs. If you update it, then update + the docs as well. +-} data User = User { name :: Text - , lastLogin :: UTCTime + , lastLogin :: Maybe UTCTime } deriving stock (Show, Eq) - deriving ToSchema via (EncodingSchema User) + deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here deriving (ToJSON, FromJSON) via (SpecJSON User) instance HasJsonEncodingSpec User where type EncodingSpec User = JsonObject - '[ '("name", JsonString) - , '("last-login", JsonDateTime) + '[ Required "name" JsonString + , Optional "last-login" JsonDateTime ] toJSONStructure user = (Field @"name" (name user), - (Field @"last-login" (lastLogin user), + (fmap (Field @"last-login") (lastLogin user), ())) instance HasJsonDecodingSpec User where type DecodingSpec User = EncodingSpec User fromJSONStructure (Field @"name" name, - (Field @"last-login" lastLogin, + (fmap (unField @"last-login") -> lastLogin, ())) = pure User { name , lastLogin }