json-spec-openapi 1.0.1.3 → 1.1.0.0

raw patch · 3 files changed

+125/−12 lines, 3 filesdep ~json-specPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: json-spec

API changes (from Hackage documentation)

Files

• json-spec-openapi.cabal +3/−3
• src/Data/JsonSpec/OpenApi.hs +57/−5
• test/test.hs +65/−4

@@ -1,11 +1,11 @@ cabal-version:       3.0 name:                json-spec-openapi-version:             1.0.1.3+version:             1.1.0.0 synopsis:            json-spec-openapi description:   This package provides a way to produce   [openapi3](https://hackage.haskell.org/package/openapi3) documentation from a-  [json-spec](https://hackage.haskell.org/package/json-spec-0.1.0.0)+  [json-spec](https://hackage.haskell.org/package/json-spec-1.2.0.0)   specification.    = Example@@ -64,7 +64,7 @@     , aeson                     >= 2.2.1.0  && < 2.3     , base                      >= 4.19.0.0 && < 4.22     , insert-ordered-containers >= 0.2.5.3  && < 0.3-    , json-spec                 >= 0.5.0.0  && < 1.2+    , json-spec                 >= 1.2.0.0  && < 1.3     , lens                      >= 5.2.3    && < 5.4     , openapi3                  >= 3.2.4    && < 3.3     , text                      >= 2.1      && < 2.2

@@ -108,15 +108,16 @@   ( FieldSpec(Optional, Required), HasJsonDecodingSpec(DecodingSpec)   , HasJsonEncodingSpec(EncodingSpec)   , Specification-    ( JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt, JsonLet-    , JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString, JsonTag+    ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt+    , JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString+    , JsonTag     )   ) import Data.JsonSpec.OpenApi.Rename (Rename) import Data.OpenApi   ( AdditionalProperties(AdditionalPropertiesAllowed)-  , HasAdditionalProperties(additionalProperties), HasEnum(enum_)-  , HasFormat(format), HasItems(items), HasOneOf(oneOf)+  , HasAdditionalProperties(additionalProperties), HasDescription(description)+  , HasEnum(enum_), HasFormat(format), HasItems(items), HasOneOf(oneOf)   , HasProperties(properties), HasRequired(required), HasType(type_)   , NamedSchema(NamedSchema), OpenApiItems(OpenApiItemsObject)   , OpenApiType@@ -134,7 +135,7 @@ import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Prelude   ( Applicative(pure), Bool(False), Functor(fmap), Maybe(Just, Nothing)-  , Monoid(mempty), ($), (.)+  , Monoid(mempty), ($), (.), id   ) import qualified Data.HashMap.Strict.InsOrd as HMI import qualified Data.OpenApi as OA@@ -357,6 +358,16 @@     Inlineable defs (JsonRef target)   where     inlineable = deref @defs @defs @target+instance {- Inlineable defs (JsonAnnotated annotations spec) -}+    ( Inlineable defs spec+    , ApplyAnnotations annotations+    )+  =>+    Inlineable defs (JsonAnnotated annotations spec)+  where+    inlineable = do+      schema <- inlineable @defs @spec+      pure (applyAnnotations @annotations schema)   {-|@@ -523,5 +534,46 @@   where     Concat '[] b = b     Concat (a : more) b = a : Concat more b+++{-|+  Look up a key in a list of annotation pairs. Returns 'Just value if found,+  'Nothing otherwise.+-}+type family+    LookupAnnotation+      (key :: Symbol)+      (annotations :: [(Symbol, Symbol)])+      :: Maybe Symbol+  where+    LookupAnnotation key '[] = 'Nothing+    LookupAnnotation key ( '(key, value) ': more ) = 'Just value+    LookupAnnotation key ( '(other, value) ': more ) = LookupAnnotation key more+++{-|+  Apply annotations to a schema. Currently only "description" is supported;+  all other annotations are ignored.+-}+class ApplyAnnotations (annotations :: [(Symbol, Symbol)]) where+  applyAnnotations :: Schema -> Schema+instance+    (ApplyDescription (LookupAnnotation "description" annotations))+  =>+    ApplyAnnotations annotations+  where+    applyAnnotations = applyDescription @(LookupAnnotation "description" annotations)+++{-|+  Helper class for applying a description annotation to a schema.+-}+class ApplyDescription (desc :: Maybe Symbol) where+  applyDescription :: Schema -> Schema+instance ApplyDescription 'Nothing where+  applyDescription = id+instance (KnownSymbol desc) => ApplyDescription ('Just desc) where+  applyDescription schema =+    schema & set description (Just (sym @desc))  

@@ -20,8 +20,9 @@   , HasJsonDecodingSpec(DecodingSpec, fromJSONStructure)   , HasJsonEncodingSpec(EncodingSpec, toJSONStructure), SpecJSON(SpecJSON)   , Specification-    ( JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt, JsonLet-    , JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString, JsonTag+    ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt+    , JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString+    , JsonTag     )   , (:::), (::?), unField   )@@ -31,8 +32,8 @@ import Data.Text (Text) import Data.Time (UTCTime) import Prelude-  ( Applicative(pure), Bool(False), Functor(fmap), Maybe(Just), Monoid(mempty)-  , ($), (.), Eq, IO, Show+  ( Applicative(pure), Bool(False), Eq, Functor(fmap), Int, IO, Maybe(Just)+  , Monoid(mempty), Show, ($), (.)   ) import Test.Hspec (describe, hspec, it, shouldBe) import qualified Data.Aeson as Aeson@@ -666,6 +667,31 @@         in           Aeson.encode actual `shouldBe` Aeson.encode expected +    describe "annotated" $ do+      it "JsonAnnotated wrapping object (EncodingSpec AnnotatedUser)" $+        let+          actual :: (Definitions OA.Schema, OA.Schema)+          actual = toOpenApiSchema (Proxy @(EncodingSpec AnnotatedUser))++          expected :: (Definitions OA.Schema, OA.Schema)+          expected =+            ( mempty+            , mempty+                & set OA.type_ (Just OA.OpenApiObject)+                & set OA.description (Just "A user with a name and age")+                & set OA.properties (+                    mempty+                      & set (at "name") (Just (OA.Inline stringSchema))+                      & set (at "age") (Just (OA.Inline intSchema))+                  )+                & set OA.required ["name", "age"]+                & set+                    OA.additionalProperties+                    (Just (OA.AdditionalPropertiesAllowed False))+            )+        in+          actual `shouldBe` expected+     describe "EncodingSchema" $       it "works" $         let@@ -721,12 +747,47 @@       pure User { name , lastLogin }  +{- Annotated test: EncodingSpec uses JsonAnnotated. -}+data AnnotatedUser = AnnotatedUser+  { auName :: Text+  ,  auAge :: Int+  }+  deriving stock (Show, Eq)+  deriving (ToJSON, FromJSON) via (SpecJSON AnnotatedUser)+instance HasJsonEncodingSpec AnnotatedUser where+  type EncodingSpec AnnotatedUser =+    JsonAnnotated+      '[ '("description", "A user with a name and age")+       , '("example", "{\"name\": \"alice\", \"age\": 30}")+       ]+      (JsonObject+        '[ Required "name" JsonString+         , Required "age" JsonInt+         ])+  toJSONStructure AnnotatedUser { auName, auAge } =+    (Field @"name" auName,+    (Field @"age" auAge,+    ()))+instance HasJsonDecodingSpec AnnotatedUser where+  type DecodingSpec AnnotatedUser = EncodingSpec AnnotatedUser+  fromJSONStructure+      (Field @"name" auName,+      (Field @"age" auAge,+      ()))+    =+      pure AnnotatedUser { auName, auAge }++ stringSchema :: OA.Schema stringSchema = mempty & set OA.type_ (Just OA.OpenApiString)   numSchema :: OA.Schema numSchema = mempty & set OA.type_ (Just OA.OpenApiNumber)+++intSchema :: OA.Schema+intSchema = mempty & set OA.type_ (Just OA.OpenApiInteger)   boolSchema :: OA.Schema