packages feed

json-spec-openapi 1.3.0.1 → 2.0.0.0

raw patch · 5 files changed

+326/−185 lines, 5 filesdep ~json-specPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: json-spec

API changes (from Hackage documentation)

- Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Defs defs more, Data.JsonSpec.OpenApi.Inlineable defs spec, GHC.Internal.TypeLits.KnownSymbol name) => Data.JsonSpec.OpenApi.Defs defs ('(name, spec) : more)
- Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Defs newDefs newDefs, Data.JsonSpec.OpenApi.Refable (Data.JsonSpec.OpenApi.Concat newDefs defs) spec) => Data.JsonSpec.OpenApi.Refable defs ('Data.JsonSpec.Spec.JsonLet newDefs spec)
- Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Inlineable (Data.JsonSpec.OpenApi.Concat newDefs defs) spec, Data.JsonSpec.OpenApi.Defs (Data.JsonSpec.OpenApi.Concat newDefs defs) newDefs) => Data.JsonSpec.OpenApi.Inlineable defs ('Data.JsonSpec.Spec.JsonLet newDefs spec)
- Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Schemaable (Data.JsonSpec.Decode.DecodingSpec a), GHC.Internal.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), GHC.Internal.Data.Typeable.Internal.Typeable a) => Data.OpenApi.Internal.Schema.ToSchema (Data.JsonSpec.OpenApi.EncodingSchema a)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Defs (Data.JsonSpec.OpenApi.BindingsToFrame newDefs) newDefs, Data.JsonSpec.OpenApi.Refable (Data.JsonSpec.OpenApi.Concat (Data.JsonSpec.OpenApi.BindingsToFrame newDefs) defs) spec) => Data.JsonSpec.OpenApi.Refable defs ('Data.JsonSpec.Spec.JsonLet newDefs spec)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Defs defs more, Data.JsonSpec.OpenApi.Inlineable '[] spec, GHC.Internal.TypeLits.KnownSymbol name) => Data.JsonSpec.OpenApi.Defs defs ('Data.JsonSpec.Spec.ModuleBind name ('Data.JsonSpec.Spec.Module spec) : more)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Defs defs more, Data.JsonSpec.OpenApi.Inlineable defs spec, GHC.Internal.TypeLits.KnownSymbol name) => Data.JsonSpec.OpenApi.Defs defs ('Data.JsonSpec.Spec.TypeBind name spec : more)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Inlineable (Data.JsonSpec.OpenApi.Concat (Data.JsonSpec.OpenApi.BindingsToFrame newDefs) defs) spec, Data.JsonSpec.OpenApi.Defs (Data.JsonSpec.OpenApi.Concat (Data.JsonSpec.OpenApi.BindingsToFrame newDefs) defs) newDefs) => Data.JsonSpec.OpenApi.Inlineable defs ('Data.JsonSpec.Spec.JsonLet newDefs spec)
+ Data.JsonSpec.OpenApi: instance (Data.JsonSpec.OpenApi.Schemaable ('Data.JsonSpec.Spec.JsonModule (Data.JsonSpec.Spec.DecodingSpec a)), GHC.Internal.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.Spec.JsonModule (Data.JsonSpec.Spec.EncodingSpec a)), GHC.Internal.Data.Typeable.Internal.Typeable a) => Data.OpenApi.Internal.Schema.ToSchema (Data.JsonSpec.OpenApi.EncodingSchema a)
+ Data.JsonSpec.OpenApi: instance Data.JsonSpec.OpenApi.Inlineable '[] spec => Data.JsonSpec.OpenApi.Inlineable defs ('Data.JsonSpec.Spec.JsonModule ('Data.JsonSpec.Spec.Module spec))

Files

CHANGELOG.md view
@@ -2,6 +2,13 @@  All notable changes to this project will be documented in this file. +## 2.0.0.0++- Bumped the epoch major version to align with `json-spec` 2.0.0.0.+- Adapted to `json-spec` 2.0.0.0, including support for modules, module+  bindings (`::=`), type bindings (`:=`), and closed scoping during+  schema generation and symbol renaming.+ ## 1.3.0.1  - Support `aeson` 2.3.
json-spec-openapi.cabal view
@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                json-spec-openapi-version:             1.3.0.1+version:             2.0.0.0 synopsis:            json-spec-openapi description:   This package provides a way to produce@@ -19,14 +19,11 @@   >   deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here   > instance HasJsonEncodingSpec User where   >   type EncodingSpec User =-  >     JsonObject-  >       '[ Required "name" JsonString-  >        , Optional "last-login" JsonDateTime-  >        ]-  >   toJSONStructure user =-  >     (Field @"name" (name user),-  >     (fmap (Field @"last-login") (lastLogin user),-  >     ()))+  >     'Module+  >       (JsonObject+  >         '[ Required "name" JsonString+  >          , Optional "last-login" JsonDateTime+  >          ])    Calling `Data.Aeson.encode (Data.OpenApi3.toSchema (Proxy :: Proxy User))`   will produce the following Schema:@@ -64,7 +61,7 @@   build-depends:     , aeson                     >= 2.2.1.0  && < 2.4     , base                      >= 4.19.2.0 && < 4.23-    , json-spec                 >= 1.4.0.0  && < 1.5+    , json-spec                 >= 2.0.0.0  && < 2.1     , lens                      >= 5.2.3    && < 5.4     , openapi3                  >= 3.2.5    && < 3.3     , text                      >= 2.1      && < 2.2
src/Data/JsonSpec/OpenApi.hs view
@@ -32,14 +32,11 @@   >   deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here   > instance HasJsonEncodingSpec User where   >   type EncodingSpec User =-  >     JsonObject-  >       '[ Required "name" JsonString-  >        , Optional "last-login" JsonDateTime-  >        ]-  >   toJSONStructure user =-  >     (Field @"name" (name user),-  >     (fmap (Field @"last-login") (lastLogin user),-  >     ()))+  >     'Module+  >       (JsonObject+  >         '[ Required "name" JsonString+  >          , Optional "last-login" JsonDateTime+  >          ])    Calling @'Data.Aeson.encode' ('Data.OpenApi3.toSchema' ('Proxy' :: 'Proxy' User))@   will produce the following Schema:@@ -71,21 +68,18 @@   >   }   > instance HasJsonEncodingSpec User where   >   type EncodingSpec User =-  >     JsonObject-  >       '[ Required "name" JsonString-  >        , Optional "last-login" JsonDateTime-  >        ]-  >   toJSONStructure user =-  >     (Field @"name" (name user),-  >     (fmap (Field @"last-login") (lastLogin user),-  >     ()))+  >     'Module+  >       (JsonObject+  >         '[ Required "name" JsonString+  >          , Optional "last-login" JsonDateTime+  >          ])   > instance ToSchema User where   >   declareNamedSchema _proxy =   >       pure $   >         NamedSchema   >           Nothing   >           (-  >             toOpenApiSchema (EncodingSpec User)+  >             toOpenApiSchema (Proxy @(EncodingSpec User))   >               & set   >                   additionalProperties   >                   (Just (AdditionalPropertiesAllowed True))@@ -109,14 +103,14 @@   Example (you may need @-XFlexibleInstances@ for the instance):    > data AnnotatedUser = AnnotatedUser { name_ :: Text, age_ :: Int }-  >   deriving (ToJSON, FromJSON) via (SpecJSON AnnotatedUser)+  >   deriving (ToJSON, FromJSON) via (SpecJson AnnotatedUser)   > instance SchemaModifier AnnotatedUser where   >   modifySchema s = s & set description (Just \"A user with name and age\")   > instance HasJsonEncodingSpec AnnotatedUser where   >   type EncodingSpec AnnotatedUser =-  >     JsonAnnotated '[ '(\"schema-modifier\", AnnotatedUser) ]-  >       (JsonObject '[ Required \"name\" JsonString, Required \"age\" JsonInt ])-  >   toJSONStructure (AnnotatedUser n a) = (Field @"name" n, (Field @"age" a, ()))+  >     'Module+  >       (JsonAnnotated '[ '(\"schema-modifier\", AnnotatedUser) ]+  >         (JsonObject '[ Required \"name\" JsonString, Required \"age\" JsonInt ]))    The type in @\"schema-modifier\"@ must have a 'SchemaModifier'   instance or you get a type error; it is not ignored.@@ -135,12 +129,13 @@ import Data.Aeson (ToJSON(toJSON)) import Data.Functor.Identity (Identity(runIdentity)) import Data.JsonSpec-  ( FieldSpec(Optional, Required), HasJsonDecodingSpec(DecodingSpec)-  , HasJsonEncodingSpec(EncodingSpec)+  ( BindingSpec(ModuleBind, TypeBind), FieldSpec(Optional, Required)+  , HasJsonDecodingSpec(DecodingSpec), HasJsonEncodingSpec(EncodingSpec)+  , Module(Module)   , Specification     ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonDict, JsonEither-    , JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef-    , JsonString, JsonTag+    , JsonInt, JsonLet, JsonModule, JsonNullable, JsonNum, JsonObject, JsonRaw+    , JsonRef, JsonString, JsonTag     )   ) import Data.JsonSpec.OpenApi.Rename (Rename)@@ -173,9 +168,9 @@ 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-  something you should have to worry about.+  Convert a 'Specification' or closed 'Module' 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@@ -187,7 +182,7 @@     of the form:        > JsonLet '[-      >   '("foo", ...)+      >   "foo" := ...       > ] (       >   JsonRef "foo"       > )@@ -199,7 +194,7 @@        > toOpenApiSchema (Proxy @(       >     JsonLet-      >       '[ '("foo", JsonString) ]+      >       '[ "foo" := JsonString ]       >       (JsonRef "foo")       >   )) @@ -207,7 +202,7 @@        > toOpenApiSchema (Proxy @(       >     JsonLet-      >       '[ '("foo", JsonString) ]+      >       '[ "foo" := JsonString ]       >       JsonString       >   )) @@ -223,7 +218,7 @@       >     toOpenApiSchema       >       (Proxy @(       >         JsonObject '[-      >           ("bar", JsonRef "not-defined")+      >           Required "bar" (JsonRef "not-defined")       >         ]       >       ))       > in@@ -260,6 +255,7 @@ instance (Inlineable '[] spec) => Schemaable spec where   schemaable = inlineable @'[] @spec + class     Inlineable       (defs :: [ (Symbol, Specification) ])@@ -378,15 +374,17 @@       mempty       & set type_ (Just OpenApiObject) instance {- Inlineable defs (JsonLet newDefs spec) -}-    ( Inlineable (Concat newDefs defs) spec-    , Defs (Concat newDefs defs) newDefs+    ( Inlineable (Concat (BindingsToFrame newDefs) defs) spec+    , Defs (Concat (BindingsToFrame newDefs) defs) newDefs     )   =>     Inlineable defs (JsonLet newDefs spec)   where     inlineable = do-      mkDefs @(Concat newDefs defs) @newDefs-      inlineable @(Concat newDefs defs) @spec+      mkDefs @(Concat (BindingsToFrame newDefs) defs) @newDefs+      inlineable @(Concat (BindingsToFrame newDefs) defs) @spec+instance (Inlineable '[] spec) => Inlineable defs (JsonModule ('Module spec)) where+  inlineable = inlineable @'[] @spec instance {- Inlineable defs (JsonRef target) -}     ( Deref defs defs target     )@@ -446,15 +444,15 @@ instance {-# overlappable #-} (Inlineable defs a) => Refable defs a where   refable = fmap Inline (inlineable @defs @a) instance-    ( Defs newDefs newDefs-    , Refable (Concat newDefs defs) spec+    ( Defs (BindingsToFrame newDefs) newDefs+    , Refable (Concat (BindingsToFrame newDefs) defs) spec     )   =>     Refable defs (JsonLet newDefs spec)   where     refable = do-      mkDefs @newDefs @newDefs-      refable @(Concat newDefs defs) @spec+      mkDefs @(BindingsToFrame newDefs) @newDefs+      refable @(Concat (BindingsToFrame newDefs) defs) @spec instance (KnownSymbol name) => Refable defs (JsonRef name) where   refable =     pure (ref (sym @name))@@ -500,25 +498,37 @@ class     Defs       (allDefs :: [(Symbol, Specification)])-      (defs :: [(Symbol, Specification)])+      (defs :: [BindingSpec])   where     mkDefs       :: (MonadDeclare (Definitions Schema) m)       => m () instance Defs defs '[] where   mkDefs = pure ()-instance {- Defs defs ( '(name, spec) ': more) -}+instance {- Defs defs (TypeBind name spec ': more) -}     ( Defs defs more     , Inlineable defs spec     , KnownSymbol name     )   =>-    Defs defs ( '(name, spec) ': more)+    Defs defs (TypeBind name spec ': more)   where     mkDefs = do       schema <- inlineable @defs @spec       declare (HMI.singleton (sym @name) schema)       mkDefs @defs @more+instance {- Defs defs (ModuleBind name ('Module spec) ': more) -}+    ( Defs defs more+    , Inlineable '[] spec+    , KnownSymbol name+    )+  =>+    Defs defs (ModuleBind name ('Module spec) ': more)+  where+    mkDefs = do+      schema <- inlineable @'[] @spec+      declare (HMI.singleton (sym @name) schema)+      mkDefs @defs @more   {-|@@ -535,14 +545,16 @@ newtype EncodingSchema a =   EncodingSchema {unEncodingSchema :: a} instance-    ( Schemaable (EncodingSpec a)+    ( Schemaable (JsonModule (EncodingSpec a))     , Typeable a     )   =>     ToSchema (EncodingSchema a)   where     declareNamedSchema _ = do-      let (declarations, schema) = toOpenApiSchema (Proxy @(EncodingSpec a))+      let+        (declarations, schema) =+          toOpenApiSchema (Proxy @(JsonModule (EncodingSpec a)))       declare declarations       pure (NamedSchema Nothing schema) @@ -561,14 +573,16 @@ newtype DecodingSchema a =   DecodingSchema {unDecodingSchema :: a} instance-    ( Schemaable (DecodingSpec a)+    ( Schemaable (JsonModule (DecodingSpec a))     , Typeable a     )   =>     ToSchema (DecodingSchema a)   where     declareNamedSchema _ = do-      let (declarations, schema) = toOpenApiSchema (Proxy @(DecodingSpec a))+      let+        (declarations, schema) =+          toOpenApiSchema (Proxy @(JsonModule (DecodingSpec a)))       declare declarations       pure (NamedSchema Nothing schema) @@ -587,6 +601,15 @@ ref = OA.Ref . Reference  +{-| Lower 'BindingSpec's to the env-frame representation. -}+type family BindingsToFrame (bs :: [BindingSpec]) :: [(Symbol, Specification)] where+  BindingsToFrame '[] = '[]+  BindingsToFrame (TypeBind n s : more) =+    '(n, s) : BindingsToFrame more+  BindingsToFrame (ModuleBind n s : more) =+    '(n, JsonModule s) : BindingsToFrame more++ type family     Concat       (a :: [(Symbol, Specification)])@@ -646,8 +669,9 @@   Example (you may need @-XFlexibleInstances@ for the instance):    > type EncodingSpec AnnotatedUser =-  >   JsonAnnotated '[ '(\"schema-modifier\", AnnotatedUser) ]-  >     (JsonObject ...)+  >   'Module+  >     (JsonAnnotated '[ '(\"schema-modifier\", AnnotatedUser) ]+  >       (JsonObject ...))   > instance SchemaModifier AnnotatedUser where   >   modifySchema schema = schema & set description (Just \"A user\") -}
src/Data/JsonSpec/OpenApi/Rename.hs view
@@ -9,14 +9,16 @@ ) where  import Data.JsonSpec-  ( FieldSpec(Optional, Required)+  ( BindingSpec(ModuleBind, TypeBind), FieldSpec(Optional, Required)+  , Module(Module)   , Specification     ( JsonArray, JsonBool, JsonDateTime, JsonDict, JsonEither, JsonInt, JsonLet-    , JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString, JsonTag+    , JsonModule, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef+    , JsonString, JsonTag     )   ) import GHC.TypeError (ErrorMessage((:$$:)))-import GHC.TypeLits (type (+), AppendSymbol, Nat, Symbol)+import GHC.TypeLits (AppendSymbol, Nat, Symbol, type (+)) import qualified GHC.TypeError as TE  {-|@@ -46,17 +48,20 @@    For instance, this 'Specification' will fail to rename properly:   > JsonLet-  >   '[ '("foo", JsonString)-  >    , '("foo.1", JsonString)+  >   '[ "foo" := JsonString+  >    , "foo.1" := JsonString   >    ]   >    ( JsonObject   >        '[ "field1" ::: JsonRef "foo"-  >         , "field2" ::: JsonLet '[ '("foo", JsonInt)] (JsonRef "foo")+  >         , "field2" ::: JsonLet '[ "foo" := JsonInt] (JsonRef "foo")   >         ]   >    )    because the "foo" in "field2" will be renamed to "foo.1", causing a   new conflict with the existing "foo.1".++  Closed 'ModuleBind' / 'JsonModule' bodies are renamed with a fresh+  active environment, matching their closed scoping rules. -} type family Rename (spec :: Specification) :: Specification where   Rename spec =@@ -132,6 +137,9 @@         defs         spec +    FoldRename global active (JsonModule ('Module spec)) =+      MapJsonModule (FoldRename global (A '[]) spec)+     FoldRename global (A active) (JsonRef name) =       '(JsonRef (LookupNewName name active), global) @@ -246,14 +254,18 @@ type family     UpdateGlobals       (global :: Global)-      (  defs :: [(Symbol, Specification)])+      (  defs :: [BindingSpec])       :: Global   where     UpdateGlobals global '[] = global-    UpdateGlobals (G global) ( '(name, spec) : more) =+    UpdateGlobals (G global) (TypeBind name _spec : more) =       UpdateGlobals         (G (IncrementName global name))         more+    UpdateGlobals (G global) (ModuleBind name _m : more) =+      UpdateGlobals+        (G (IncrementName global name))+        more   type family@@ -273,7 +285,7 @@     RenameLet       (global :: Global) -- updated       (active :: Active)-      (defs :: [(Symbol, Specification)])+      (defs :: [BindingSpec])       (spec :: Specification)       :: (Specification, Global)   where@@ -289,7 +301,7 @@     RenameLet2       (global :: Global) -- updated       (active :: Active) -- updated-      (defs :: [(Symbol, Specification)])+      (defs :: [BindingSpec])       (spec :: Specification)   where     RenameLet2 global active defs spec =@@ -304,7 +316,7 @@     RenameLet3       (global :: Global)       (active :: Active)-      (  defs :: [(Symbol, Specification)])+      (  defs :: [BindingSpec])       (  spec :: Specification)       :: (Specification, Global)   where@@ -317,7 +329,7 @@  type family     RenameLet4-      (     r :: (Global, [(Symbol, Specification)]))+      (     r :: (Global, [BindingSpec]))       (active :: Active)       (  spec :: Specification)       :: (Specification, Global)@@ -331,7 +343,7 @@ type family     RenameLet5       (r :: (Specification, Global))-      (defs :: [(Symbol, Specification)])+      (defs :: [BindingSpec])       :: (Specification, Global)   where     RenameLet5 '(spec, global) defs =@@ -342,15 +354,20 @@     UpdateActives       (global :: Global) -- already updated       (active :: Active)-      (  defs :: [(Symbol, Specification)])+      (  defs :: [BindingSpec])       :: Active   where     UpdateActives global active '[] = active-    UpdateActives global (A active) ( '(name, spec) : more) =+    UpdateActives global (A active) (TypeBind name _spec : more) =       UpdateActives         global         (A (SetActive global active name))         more+    UpdateActives global (A active) (ModuleBind name _m : more) =+      UpdateActives+        global+        (A (SetActive global active name))+        more   type family@@ -390,8 +407,8 @@     ReflectDefs       (global :: Global)       (active :: Active)-      (  defs :: [(Symbol, Specification)])-      :: (Global, [(Symbol, Specification)])+      (  defs :: [BindingSpec])+      :: (Global, [BindingSpec])   where     ReflectDefs global active defs =       FoldReflectDefs '(global, '[]) active defs@@ -399,48 +416,79 @@  type family     FoldReflectDefs-      (acc :: (Global, [(Symbol, Specification)]))+      (acc :: (Global, [BindingSpec]))       (active :: Active)-      (defs :: [(Symbol, Specification)])-      :: (Global, [(Symbol, Specification)])+      (defs :: [BindingSpec])+      :: (Global, [BindingSpec])   where     FoldReflectDefs acc active '[] = acc     FoldReflectDefs         '(global, acc)         active-        ( '(name, spec) : more )+        (TypeBind name spec : more)       =-        FoldReflectDefs2+        FoldReflectTypeBind           (FoldRename global active spec)           active           name           acc           more+    FoldReflectDefs+        '(global, acc)+        active+        (ModuleBind name ('Module spec) : more)+      =+        FoldReflectModuleBind+          (FoldRename global (A '[]) spec)+          active+          name+          acc+          more   type family-    FoldReflectDefs2+    FoldReflectTypeBind       (  spec :: (Specification, Global))       (active :: Active)       (  name :: Symbol)-      (   acc :: [(Symbol, Specification)])-      (  more :: [(Symbol, Specification)])-      :: (Global, [(Symbol, Specification)])+      (   acc :: [BindingSpec])+      (  more :: [BindingSpec])+      :: (Global, [BindingSpec])   where-    FoldReflectDefs2 '(spec, global) active name acc more =-      FoldReflectDefs '(global, '(name, spec) : acc) active more+    FoldReflectTypeBind '(spec, global) active name acc more =+      FoldReflectDefs '(global, TypeBind name spec : acc) active more  +type family+    FoldReflectModuleBind+      (  spec :: (Specification, Global))+      (active :: Active)+      (  name :: Symbol)+      (   acc :: [BindingSpec])+      (  more :: [BindingSpec])+      :: (Global, [BindingSpec])+  where+    FoldReflectModuleBind '(spec, global) active name acc more =+      FoldReflectDefs+        '(global, ModuleBind name ('Module spec) : acc)+        active+        more++ {-| Update the LHS of the definitions, to match the already updated globals -} type family     RenameDefs       (global :: Global)-      (  defs :: [(Symbol, Specification)])-      :: [(Symbol, Specification)]+      (  defs :: [BindingSpec])+      :: [BindingSpec]   where     RenameDefs globals '[] = '[]-    RenameDefs (G globals) ( '(name, spec) : more) =-      '(LookupNewName name globals, spec) : RenameDefs (G globals) more+    RenameDefs (G globals) (TypeBind name spec : more) =+      TypeBind (LookupNewName name globals) spec+        : RenameDefs (G globals) more+    RenameDefs (G globals) (ModuleBind name m : more) =+      ModuleBind (LookupNewName name globals) m+        : RenameDefs (G globals) more   type family@@ -585,6 +633,15 @@       :: (Specification, Global)   where     MapSpec f '(a, b) = '(f a, b)+++type family+    MapJsonModule+      (a :: (Specification, Global))+      :: (Specification, Global)+  where+    MapJsonModule '(spec, global) =+      '(JsonModule ('Module spec), global)   type family
test/test.hs view
@@ -17,16 +17,19 @@ import Control.Lens (At(at), (&), set) import Data.Aeson (ToJSON(toJSON), FromJSON) import Data.JsonSpec-  ( Field(Field), FieldSpec(Optional, Required)-  , HasJsonDecodingSpec(DecodingSpec, fromJSONStructure)-  , HasJsonEncodingSpec(EncodingSpec, toJSONStructure), SpecJSON(SpecJSON)+  ( FieldSpec(Optional, Required), HasJsonDecodingSpec(DecodingSpec)+  , HasJsonEncodingSpec(EncodingSpec), Module(Module)   , Specification     ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonDict, JsonEither-    , JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef-    , JsonString, JsonTag+    , JsonInt, JsonLet, JsonModule, JsonNullable, JsonNum, JsonObject, JsonRaw+    , JsonRef, JsonString, JsonTag     )-  , (:::), (::?), unField+  , type (:::), type (::=), type (::?), type (:=)   )+import Data.JsonSpec.Codec.Tuple+  ( Field(Field), SpecJson(SpecJson), TupleDecoding(fromJsonStructure)+  , TupleEncoding(toJsonStructure), unField+  ) import Data.JsonSpec.OpenApi   ( SchemaModifier(modifySchema), EncodingSchema, Rename, toOpenApiSchema   )@@ -314,7 +317,7 @@             actual =               toOpenApiSchema (Proxy @(                 JsonLet '[-                  '("thing", JsonString)+                  "thing" := JsonString                 ]                 (                   JsonObject '[@@ -346,12 +349,8 @@             actual =               toOpenApiSchema (Proxy @(                 JsonLet-                 '[ '( "thing1"-                     , JsonString-                     )-                  , '( "thing2"-                     , JsonRef "thing1"-                     )+                 '[ "thing1" := JsonString+                  , "thing2" := JsonRef "thing1"                   ]                   (                     JsonRef "thing2"@@ -375,8 +374,8 @@           actual =             toOpenApiSchema (Proxy @(               JsonLet '[-                '("foo", JsonNum),-                '("bar", JsonString)+                "foo" := JsonNum,+                "bar" := JsonString               ]               (JsonRef "bar")             ))@@ -397,7 +396,7 @@               JsonObject '[                 Required "foo" (                   JsonLet-                    '[ '("thing", JsonString)]+                    '[ "thing" := JsonString ]                     (JsonRef "thing")                 )               ]@@ -504,18 +503,14 @@           actual =             toOpenApiSchema (Proxy @(               JsonLet-                '[ '( "foo"-                    , JsonObject+                '[ "foo" := JsonObject                         '[ "recfoo" ::: JsonArray (JsonRef "bar")                          , "valfoo" ::: JsonInt                          ]-                    )-                 , '( "bar"-                    , JsonObject+                 , "bar" := JsonObject                         '[ "recbar" ::: JsonArray (JsonRef "foo")                          , "valbar" ::: JsonString                          ]-                    )                  ]                  (JsonRef "bar")             ))@@ -536,14 +531,10 @@           actual =             toOpenApiSchema (Proxy @(Rename (               JsonLet-                '[ '("foo"-                    , JsonLet-                        '[ '( "foo"-                            , JsonString-                            )+                '[ "foo" := JsonLet+                        '[ "foo" := JsonString                          ]                          (JsonRef "foo")-                    )                  ]                  (JsonRef "foo")             )))@@ -582,11 +573,8 @@           actual =             toOpenApiSchema (Proxy @(Rename (               JsonLet-                '[ '("foo"-                    , JsonLet-                        '[ '( "foo"-                            , JsonString-                            )+                '[ "foo" := JsonLet+                        '[ "foo" := JsonString                          ]                          (                            JsonObject@@ -594,10 +582,7 @@                               , ("field2" ::? JsonRef "bar")                               ]                          )-                    )-                 , '( "bar"-                    , JsonString-                    )+                 , "bar" := JsonString                  ]                  (JsonRef "foo")             )))@@ -657,28 +642,26 @@           actual =             toOpenApiSchema (Proxy @(Rename (               JsonLet-                '[ '( "foo"-                    , JsonLet-                        '[ '("foo", JsonString) ]+                '[ "foo" := JsonLet+                        '[ "foo" := JsonString ]                          (                            JsonObject                             '[ "field1" ::: JsonRef "foo"                              , "field2" ::: JsonLet-                                             '[ '("foo", JsonInt) ]+                                             '[ "foo" := JsonInt ]                                               (JsonRef "foo")                              , "field3" ::: JsonLet-                                             '[ '("foo", JsonBool) ]+                                             '[ "foo" := JsonBool ]                                               (JsonRef "foo")                              ]                           )-                    )                  ]                  (                    JsonObject                      '[ "field1" ::: JsonRef "foo"                       , "field2" ::: JsonLet-                                      '[ '("foo", JsonNullable JsonString) ]+                                      '[ "foo" := JsonNullable JsonString ]                                        (JsonRef "foo")                       ]                  )@@ -686,12 +669,67 @@         in           Aeson.encode actual `shouldBe` Aeson.encode expected +      it "closed module binding" $+        let+          taxSchema :: OA.Schema+          taxSchema =+            mempty+              & set OA.type_ (Just OA.OpenApiObject)+              & set OA.properties (+                  mempty+                    & set (at "rate") (Just (OA.Ref (OA.Reference "Rate")))+                )+              & set OA.required ["rate"]+              & set+                  OA.additionalProperties+                  (Just (OA.AdditionalPropertiesAllowed False))++          expected :: (Definitions OA.Schema, OA.Schema)+          expected =+            ( HMI.fromList+                [ ("Id", stringSchema)+                , ("Rate", numSchema)+                , ("Tax", taxSchema)+                ]+            , mempty+                & set OA.type_ (Just OA.OpenApiObject)+                & set OA.properties (+                    mempty+                      & set (at "id") (Just (OA.Ref (OA.Reference "Id")))+                      & set (at "tax") (Just (OA.Ref (OA.Reference "Tax")))+                  )+                & set OA.required ["id", "tax"]+                & set+                    OA.additionalProperties+                    (Just (OA.AdditionalPropertiesAllowed False))+            )++          actual :: (Definitions OA.Schema, OA.Schema)+          actual =+            toOpenApiSchema (Proxy @(+              JsonLet+                '[ "Id" := JsonString+                 , "Tax" ::=+                     'Module+                       (JsonLet+                         '[ "Rate" := JsonNum ]+                         (JsonObject '[ "rate" ::: JsonRef "Rate" ]))+                 ]+                (JsonObject+                  '[ "id" ::: JsonRef "Id"+                   , "tax" ::: JsonRef "Tax"+                   ])+            ))+        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))+          actual = toOpenApiSchema (Proxy @(JsonModule (EncodingSpec AnnotatedUser))) +           expected :: (Definitions OA.Schema, OA.Schema)           expected =             ( mempty@@ -714,8 +752,9 @@       it "JsonAnnotated with empty list is no-op" $         let           actual :: (Definitions OA.Schema, OA.Schema)-          actual = toOpenApiSchema (Proxy @(EncodingSpec EmptyAnnotatedUser))+          actual = toOpenApiSchema (Proxy @(JsonModule (EncodingSpec EmptyAnnotatedUser))) +           expected :: (Definitions OA.Schema, OA.Schema)           expected =             ( mempty@@ -737,8 +776,9 @@       it "JsonAnnotated with Symbol-valued \"schema-modifier\" is ignored (no-op)" $         let           actual :: (Definitions OA.Schema, OA.Schema)-          actual = toOpenApiSchema (Proxy @(EncodingSpec SymbolSchemaModifierUser))+          actual = toOpenApiSchema (Proxy @(JsonModule (EncodingSpec SymbolSchemaModifierUser))) +           expected :: (Definitions OA.Schema, OA.Schema)           expected =             ( mempty@@ -760,8 +800,9 @@       it "JsonAnnotated with Type-valued list but no \"schema-modifier\" key is no-op" $         let           actual :: (Definitions OA.Schema, OA.Schema)-          actual = toOpenApiSchema (Proxy @(EncodingSpec OtherTypeAnnotationUser))+          actual = toOpenApiSchema (Proxy @(JsonModule (EncodingSpec OtherTypeAnnotationUser))) +           expected :: (Definitions OA.Schema, OA.Schema)           expected =             ( mempty@@ -814,20 +855,23 @@   }   deriving stock (Show, Eq)   deriving ToSchema via (EncodingSchema User) -- <-- ToSchema instance defined here-  deriving (ToJSON, FromJSON) via (SpecJSON User)+  deriving (ToJSON, FromJSON) via (SpecJson User) instance HasJsonEncodingSpec User where   type EncodingSpec User =-    JsonObject-      '[ Required "name" JsonString-       , Optional "last-login" JsonDateTime-       ]-  toJSONStructure user =+    'Module+      (JsonObject+        '[ Required "name" JsonString+         , Optional "last-login" JsonDateTime+         ])+instance TupleEncoding User where+  toJsonStructure user =     (Field @"name" (name user),     (fmap (Field @"last-login") (lastLogin user),     ())) instance HasJsonDecodingSpec User where   type DecodingSpec User = EncodingSpec User-  fromJSONStructure+instance TupleDecoding User where+  fromJsonStructure       (Field @"name" name,       (fmap (unField @"last-login") ->  lastLogin,       ()))@@ -841,26 +885,29 @@   ,  auAge :: Int   }   deriving stock (Show, Eq)-  deriving (ToJSON, FromJSON) via (SpecJSON AnnotatedUser)+  deriving (ToJSON, FromJSON) via (SpecJson AnnotatedUser) instance SchemaModifier AnnotatedUser where   modifySchema schema =     schema & set OA.description (Just "A user with a name and age") instance HasJsonEncodingSpec AnnotatedUser where   type EncodingSpec AnnotatedUser =-    JsonAnnotated-      '[ '("schema-modifier", AnnotatedUser)-       ]-      (JsonObject-        '[ Required "name" JsonString-         , Required "age" JsonInt-         ])-  toJSONStructure AnnotatedUser { auName, auAge } =+    'Module+      (JsonAnnotated+        '[ '("schema-modifier", AnnotatedUser)+         ]+        (JsonObject+          '[ Required "name" JsonString+           , Required "age" JsonInt+           ]))+instance TupleEncoding AnnotatedUser where+  toJsonStructure AnnotatedUser { auName, auAge } =     (Field @"name" auName,     (Field @"age" auAge,     ())) instance HasJsonDecodingSpec AnnotatedUser where   type DecodingSpec AnnotatedUser = EncodingSpec AnnotatedUser-  fromJSONStructure+instance TupleDecoding AnnotatedUser where+  fromJsonStructure       (Field @"name" auName,       (Field @"age" auAge,       ()))@@ -874,22 +921,25 @@   ,  eauAge :: Int   }   deriving stock (Show, Eq)-  deriving (ToJSON, FromJSON) via (SpecJSON EmptyAnnotatedUser)+  deriving (ToJSON, FromJSON) via (SpecJson EmptyAnnotatedUser) instance HasJsonEncodingSpec EmptyAnnotatedUser where   type EncodingSpec EmptyAnnotatedUser =-    JsonAnnotated-      '[]-      (JsonObject-        '[ Required "name" JsonString-         , Required "age" JsonInt-         ])-  toJSONStructure EmptyAnnotatedUser { eauName, eauAge } =+    'Module+      (JsonAnnotated+        '[]+        (JsonObject+          '[ Required "name" JsonString+           , Required "age" JsonInt+           ]))+instance TupleEncoding EmptyAnnotatedUser where+  toJsonStructure EmptyAnnotatedUser { eauName, eauAge } =     (Field @"name" eauName,     (Field @"age" eauAge,     ())) instance HasJsonDecodingSpec EmptyAnnotatedUser where   type DecodingSpec EmptyAnnotatedUser = EncodingSpec EmptyAnnotatedUser-  fromJSONStructure+instance TupleDecoding EmptyAnnotatedUser where+  fromJsonStructure       (Field @"name" eauName,       (Field @"age" eauAge,       ()))@@ -903,23 +953,26 @@   ,  ssmAge :: Int   }   deriving stock (Show, Eq)-  deriving (ToJSON, FromJSON) via (SpecJSON SymbolSchemaModifierUser)+  deriving (ToJSON, FromJSON) via (SpecJson SymbolSchemaModifierUser) instance HasJsonEncodingSpec SymbolSchemaModifierUser where   type EncodingSpec SymbolSchemaModifierUser =-    JsonAnnotated-      '[ '("schema-modifier", "ignored-symbol-value")-       ]-      (JsonObject-        '[ Required "name" JsonString-         , Required "age" JsonInt-         ])-  toJSONStructure SymbolSchemaModifierUser { ssmName, ssmAge } =+    'Module+      (JsonAnnotated+        '[ '("schema-modifier", "ignored-symbol-value")+         ]+        (JsonObject+          '[ Required "name" JsonString+           , Required "age" JsonInt+           ]))+instance TupleEncoding SymbolSchemaModifierUser where+  toJsonStructure SymbolSchemaModifierUser { ssmName, ssmAge } =     (Field @"name" ssmName,     (Field @"age" ssmAge,     ())) instance HasJsonDecodingSpec SymbolSchemaModifierUser where   type DecodingSpec SymbolSchemaModifierUser = EncodingSpec SymbolSchemaModifierUser-  fromJSONStructure+instance TupleDecoding SymbolSchemaModifierUser where+  fromJsonStructure       (Field @"name" ssmName,       (Field @"age" ssmAge,       ()))@@ -934,23 +987,26 @@   ,  otaAge :: Int   }   deriving stock (Show, Eq)-  deriving (ToJSON, FromJSON) via (SpecJSON OtherTypeAnnotationUser)+  deriving (ToJSON, FromJSON) via (SpecJson OtherTypeAnnotationUser) instance HasJsonEncodingSpec OtherTypeAnnotationUser where   type EncodingSpec OtherTypeAnnotationUser =-    JsonAnnotated-      '[ '("other-key", OtherAnnotation)-       ]-      (JsonObject-        '[ Required "name" JsonString-         , Required "age" JsonInt-         ])-  toJSONStructure OtherTypeAnnotationUser { otaName, otaAge } =+    'Module+      (JsonAnnotated+        '[ '("other-key", OtherAnnotation)+         ]+        (JsonObject+          '[ Required "name" JsonString+           , Required "age" JsonInt+           ]))+instance TupleEncoding OtherTypeAnnotationUser where+  toJsonStructure OtherTypeAnnotationUser { otaName, otaAge } =     (Field @"name" otaName,     (Field @"age" otaAge,     ())) instance HasJsonDecodingSpec OtherTypeAnnotationUser where   type DecodingSpec OtherTypeAnnotationUser = EncodingSpec OtherTypeAnnotationUser-  fromJSONStructure+instance TupleDecoding OtherTypeAnnotationUser where+  fromJsonStructure       (Field @"name" otaName,       (Field @"age" otaAge,       ()))