json-spec 1.2.0.0 → 1.3.0.0

raw patch · 4 files changed

+130/−39 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +56/−0
• json-spec.cabal +4/−3
• src/Data/JsonSpec/Spec.hs +55/−23
• test/jsonspec.hs +15/−13

@@ -0,0 +1,56 @@+# Changelog++## Unreleased++## 1.3.0.0++### JsonEither now takes a type-level list++`JsonEither` now accepts a type-level list of specs (`JsonEither '[a, b, c]`)+instead of two arguments (`JsonEither a b`), so sum types with many branches+no longer require a binary tree of nested `JsonEither`s. The structural type+for `JsonEither` is nested `Either`: two or more branches map to+`Either (JStruct env a) (Either (JStruct env b) ...)`; a single branch maps+to `JStruct env spec` (no sum wrapper). Use `Left`/`Right` for construction+and pattern matching.++#### Migration guide++**Specs (example: four alternatives)**++Before:++```+JsonEither (JsonEither (JsonEither specA specB) specC) specD+```++After:++```+JsonEither '[specA, specB, specC, specD]+```++**Patterns/construction**++**Note:** The only difference in the pattern/construction may be how+the `Either`s are nested. The two examples below represent the same+four alternatives with different `Left`/`Right` nesting; the JSON and+types are equivalent.++Before (four branches):++```+Left (Left (Left val))+Left (Left (Right val))+Left (Right val)+Right val+```++After (same nesting with `Left`/`Right`; one branch = no wrapper):++```+Left val+Right (Left val)+Right (Right (Left val))+Right (Right (Right val))+```

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                json-spec-version:             1.2.0.0+version:             1.3.0.0 synopsis:            Type-level JSON specification maintainer:          rick@owensmurray.com description:         See the README at: https://github.com/owensmurray/json-spec#json-spec@@ -9,9 +9,10 @@ license-file:        LICENSE author:              Rick Owens category:            JSON-copyright:           2025 Owens Murray, LLC.+copyright:           2026 Owens Murray, LLC. build-type:          Simple-extra-source-files:+extra-doc-files:+  CHANGELOG.md   README.md   LICENSE 

@@ -33,7 +33,8 @@ import Data.Time (UTCTime) import GHC.Records (HasField(getField)) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)-import Prelude (Maybe(Just, Nothing), ($), Bool, Either, Eq, Int, Show)+import qualified GHC.TypeError as GE+import Prelude (Either, Maybe(Just, Nothing), ($), Bool, Eq, Int, Show)   {-|@@ -74,11 +75,19 @@       >     Required "nullableProperty" (JsonNullable JsonString)       >   ]     -}-  JsonEither :: Specification -> Specification -> Specification+  JsonEither :: [Specification] -> Specification     {-^-      One of two different specifications. Corresponds to json-schema-      "oneOf". Useful for encoding sum types. E.g:+      One of several different specifications. Corresponds to json-schema+      "oneOf". Useful for encoding sum types. +      Takes a type-level list of specs. In the structural representation+      ('JStruct'), `JsonEither` maps to nested `Either`: two or more+      branches become @Either (JStruct env a) (Either (JStruct env b) ...)@;+      a single branch maps to @JStruct env spec@ (no sum wrapper). Use+      `Left`/`Right` for construction and pattern matching.++      Example:+       > data MyType       >   = Foo Text       >   | Bar Int@@ -86,27 +95,37 @@       > instance HasJsonEncodingSpec MyType where       >   type EncodingSpec MyType =       >     JsonEither-      >       (+      >       '[       >         JsonObject '[       >           Required "tag" (JsonTag "foo"),       >           Required "content" JsonString+      >         ],+      >         JsonObject '[+      >           Required "tag" (JsonTag "bar"),+      >           Required "content" JsonInt+      >         ],+      >         JsonObject '[+      >           Required "tag" (JsonTag "baz"),+      >           Required "content" JsonDateTime       >         ]-      >       )-      >       (-      >         JsonEither-      >           (-      >             JsonObject '[-      >               Required "tag" (JsonTag "bar"),-      >               Required "content" JsonInt-      >             ]-      >           )-      >           (-      >             JsonObject '[-      >               Required "tag" (JsonTag "baz"),-      >               Required "content" JsonDateTime-      >             ]-      >           )-      >       )+      >       ]+      >+      >   toJSONStructure = \case+      >     Foo t ->+      >       Left+      >         ( Field @"tag" (Tag @"foo")+      >         , (Field @"content" t, ())+      >         )+      >     Bar i ->+      >       Right (Left+      >         ( Field @"tag" (Tag @"bar")+      >         , (Field @"content" i, ())+      >         )+      >     Baz dt ->+      >       Right (Right+      >         ( Field @"tag" (Tag @"baz")+      >         , (Field @"content" dt, ())+      >         )     -}   JsonTag :: Symbol -> Specification     {-^ A constant string value -}@@ -290,6 +309,19 @@   PushAll (e : more) b = PushAll more (e : b)  +{-|+  Structural type for `JsonEither`: nested `Either` for two or more branches,+  or the lone branch type for a singleton list. Empty list is disallowed.+-}+type family EitherJStruct (env :: Env) (specs :: [Specification]) :: Type where+  EitherJStruct _env '[] =+    GE.TypeError (GE.Text "JsonEither requires at least one branch")+  EitherJStruct env '[spec] =+    JStruct env spec+  EitherJStruct env (a ': b ': more) =+    Either (JStruct env a) (EitherJStruct env (b ': more))++ type family   JStruct     (env :: Env)@@ -312,8 +344,8 @@     JStruct env JsonInt = Int     JStruct env (JsonArray spec) = [JStruct env spec]     JStruct env JsonBool = Bool-    JStruct env (JsonEither left right) =-      Either (JStruct env left) (JStruct env right)+    JStruct env (JsonEither specs) =+      EitherJStruct env specs     JStruct env (JsonTag tag) = Tag tag     JStruct env JsonDateTime = UTCTime     JStruct env (JsonNullable spec) = Maybe (JStruct env spec)

@@ -6,8 +6,8 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeAbstractions #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}@@ -19,7 +19,6 @@   be disabled individually, but then we re-enable the specific warnings   we most care about. -}-{-# OPTIONS_GHC -Wwarn #-} {-# OPTIONS_GHC -Werror=missing-import-lists #-}  module Main (main) where@@ -37,7 +36,8 @@     , JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString     , JsonTag     )-  , Tag(Tag), (:::), (::?), eitherDecode, encode, unField+  , Tag(Tag), (:::), (::?), eitherDecode+  , encode, unField   ) import Data.Proxy (Proxy(Proxy)) import Data.Scientific (Scientific)@@ -690,16 +690,18 @@ instance HasJsonEncodingSpec TestSum where   type EncodingSpec TestSum =     JsonEither-      (JsonObject '[-        Required "tag" (JsonTag "a"),-        Required "content" (JsonObject [-          Required "int-field" JsonInt,-          Required "txt-field" JsonString-        ])-      ])-      (JsonObject '[-        Required "tag" (JsonTag "b")-      ])+      '[+        JsonObject '[+          Required "tag" (JsonTag "a"),+          Required "content" (JsonObject [+            Required "int-field" JsonInt,+            Required "txt-field" JsonString+          ])+        ],+        JsonObject '[+          Required "tag" (JsonTag "b")+        ]+      ]   toJSONStructure = \case     TestA i t ->       Left