packages feed

json-spec-openapi 0.1.0.3 → 0.2.0.0

raw patch · 3 files changed

+475/−181 lines, 3 filesdep +insert-ordered-containersPVP ok

version bump matches the API change (PVP)

Dependencies added: insert-ordered-containers

API changes (from Hackage documentation)

- Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Internal left, Data.JsonSpec.OpenApi.Internal right) => Data.JsonSpec.OpenApi.Internal ('Data.JsonSpec.Spec.JsonEither left right)
- Data.JsonSpec.OpenApi: instance (Data.Typeable.Internal.Typeable a, Data.JsonSpec.OpenApi.Internal (Data.JsonSpec.Decode.DecodingSpec a)) => Data.OpenApi.Internal.Schema.ToSchema (Data.JsonSpec.OpenApi.DecodingSchema a)
- Data.JsonSpec.OpenApi: instance (Data.Typeable.Internal.Typeable a, Data.JsonSpec.OpenApi.Internal (Data.JsonSpec.Encode.EncodingSpec a)) => Data.OpenApi.Internal.Schema.ToSchema (Data.JsonSpec.OpenApi.EncodingSchema a)
- Data.JsonSpec.OpenApi: instance (GHC.TypeLits.KnownSymbol key, Data.JsonSpec.OpenApi.Internal spec, Data.JsonSpec.OpenApi.Internal ('Data.JsonSpec.Spec.JsonObject more)) => Data.JsonSpec.OpenApi.Internal ('Data.JsonSpec.Spec.JsonObject ('(key, spec) : more))
- Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Internal 'Data.JsonSpec.Spec.JsonBool
- Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Internal 'Data.JsonSpec.Spec.JsonDateTime
- Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Internal 'Data.JsonSpec.Spec.JsonInt
- Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Internal 'Data.JsonSpec.Spec.JsonNum
- Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Internal 'Data.JsonSpec.Spec.JsonString
- Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Internal ('Data.JsonSpec.Spec.JsonObject '[])
- Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Internal spec => Data.JsonSpec.OpenApi.Internal ('Data.JsonSpec.Spec.JsonArray spec)
- Data.JsonSpec.OpenApi: instance GHC.TypeLits.KnownSymbol tag => Data.JsonSpec.OpenApi.Internal ('Data.JsonSpec.Spec.JsonTag tag)
+ Data.JsonSpec.OpenApi: class Schemaable (spec :: Specification)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Defs defs, Data.JsonSpec.OpenApi.Schemaable spec) => Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonLet defs spec)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Defs defs, GHC.TypeLits.KnownSymbol name) => Data.JsonSpec.OpenApi.Refable ('Data.JsonSpec.Spec.JsonLet defs ('Data.JsonSpec.Spec.JsonRef name))
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Defs more, Data.JsonSpec.OpenApi.Schemaable spec, GHC.TypeLits.KnownSymbol name) => Data.JsonSpec.OpenApi.Defs ('(name, spec) : more)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonObject more), Data.JsonSpec.OpenApi.Refable spec, GHC.TypeLits.KnownSymbol key) => Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonObject ('(key, spec) : more))
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Schemaable (Data.JsonSpec.Decode.DecodingSpec a), Data.Typeable.Internal.Typeable a) => Data.OpenApi.Internal.Schema.ToSchema (Data.JsonSpec.OpenApi.DecodingSchema a)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Schemaable (Data.JsonSpec.Encode.EncodingSpec a), Data.Typeable.Internal.Typeable a) => Data.OpenApi.Internal.Schema.ToSchema (Data.JsonSpec.OpenApi.EncodingSchema a)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Schemaable left, Data.JsonSpec.OpenApi.Schemaable right) => Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonEither left right)
+ Data.JsonSpec.OpenApi: instance (GHC.TypeLits.KnownSymbol name, Data.JsonSpec.OpenApi.Schemaable def, Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonLet more ('Data.JsonSpec.Spec.JsonRef target))) => Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonLet ('(name, def) : more) ('Data.JsonSpec.Spec.JsonRef target))
+ Data.JsonSpec.OpenApi: instance (GHC.TypeLits.KnownSymbol target, Data.JsonSpec.OpenApi.Schemaable def, Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonLet more def)) => Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonLet ('(target, def) : more) ('Data.JsonSpec.Spec.JsonRef target))
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Defs '[]
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Schemaable 'Data.JsonSpec.Spec.JsonBool
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Schemaable 'Data.JsonSpec.Spec.JsonDateTime
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Schemaable 'Data.JsonSpec.Spec.JsonInt
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Schemaable 'Data.JsonSpec.Spec.JsonNum
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Schemaable 'Data.JsonSpec.Spec.JsonString
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonObject '[])
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Schemaable a => Data.JsonSpec.OpenApi.Refable a
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Schemaable spec => Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonArray spec)
+ Data.JsonSpec.OpenApi: instance GHC.TypeError.Unsatisfiable (((((((Data.JsonSpec.OpenApi.T "`JsonRef \"" 'GHC.TypeError.:<>: Data.JsonSpec.OpenApi.T target) 'GHC.TypeError.:<>: Data.JsonSpec.OpenApi.T "\"` is not defined.\n") 'GHC.TypeError.:$$: Data.JsonSpec.OpenApi.T "You are trying to use a JsonRef as the \"top level\" ") 'GHC.TypeError.:$$: Data.JsonSpec.OpenApi.T "schema. We try to satisfy this request by looking up ") 'GHC.TypeError.:$$: Data.JsonSpec.OpenApi.T "the reference and inlining it. However in this case you ") 'GHC.TypeError.:$$: Data.JsonSpec.OpenApi.T "are trying to reference a schema which is not defined, ") 'GHC.TypeError.:$$: Data.JsonSpec.OpenApi.T "so this won't work.\n") => Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonLet '[] ('Data.JsonSpec.Spec.JsonRef target))
+ Data.JsonSpec.OpenApi: instance GHC.TypeLits.KnownSymbol name => Data.JsonSpec.OpenApi.Refable ('Data.JsonSpec.Spec.JsonRef name)
+ Data.JsonSpec.OpenApi: instance GHC.TypeLits.KnownSymbol tag => Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonTag tag)
- Data.JsonSpec.OpenApi: toOpenApiSchema :: forall (spec :: Specification). Internal spec => Proxy spec -> Schema
+ Data.JsonSpec.OpenApi: toOpenApiSchema :: forall (spec :: Specification). Schemaable spec => Proxy spec -> (Definitions Schema, Schema)

Files

json-spec-openapi.cabal view
@@ -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:
src/Data/JsonSpec/OpenApi.hs view
@@ -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  
test/test.hs view
@@ -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