diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,60 +1,37 @@ # json-spec ## Motivation -This package provides a way to specify the shape of your JSON data at -the type level. The particular use cases we focus on are enabling (but -not providing in this package): -1. Auto-generating documentation to ensure it is correct. -2. Auto-generating client code in front-end languages to ensure it is correct. - -There are already tools available to achieve this, but they all have one -major drawback: they rely on generically derived Aeson instances. Some -people strongly object to using generically derived Aeson instances for -encoding/decoding http api data because of how brittle it is. It can be -surprisingly easy accidentally break your API without noticing because -you don't realize that a small change to some type somewhere affects -the API representation. Avoiding this requires very strict discipline -about how you organize and maintain your code. E.g. you will see a lot -of comments like - -> --| BEWARE, Changing any of the types in this file will change the API -> -- representation!! -> module My.API (...) where +The primary motivation is to allow you to avoid Aeson Generic instances +while still getting the possibility of auto-generated (and therefore +/correct/) documentation and code in your servant APIs. -But then the types in this api might reference types in in other modules -where it isn't as obvious that you might be changing the api when you -make an update. +Historically, the trade-off has been: -I have even seen people go so far as to mandate that _every_ type -appearing on the API must be in some similar "API" module. This usually -ends badly because you end up with a bunch of seemingly spurious (and -quite tedious) translations between between "business" types and almost -identical "API" types. +1. Use Generic instances, and therefore your API is brittle. Changes + to Deeply nested object might unexpectedly change (and break) your + API. You must structure your Haskell types exactly as they are + rendered into JSON, which may not always be "natural" and easy to + work with. In exchange, you get the ability to auto-derive matching + ToSchema instances along with various code generation tools that + all understand Aeson Generic instances. -The other option is to simply not use generically derived instances and -code all or some of your 'ToJSON'/'FromJSON' instances by hand. That -(sometimes) helps solve the problem of making it a little more obvious -when you are making a breaking api change. And it definitely helps with -the ability to update the haskell type for some business purpose while -keeping the encoding backwards compatible. +2. Hand-write your ToJSON and FromJSON instances, which means you + get to structure your Haskell types in the way that works best + for Haskell, while structuring your JSON in the way that works + best for your API. It also means you can more easily support "old" + decoding versions and more easily maintain backwards compatibility, + etc. In exchange, you have to to hand-write your ToSchema instances, + and code generation is basically out. -The problem now though is that you can't take advantage of any of the -above tooling without writing every instance by hand. Writing all the -individual instances by hand defeat's the purpose because you are back -to being unsure whether they are all in sync! +The goal of this library is to provide a way to hand-write the encoding +and decoding of your JSON using type-level 'Specification's, while +still allowing the use of tools that can interpret the specification +and auto-generate ToSchema instances and code. -The approach this library takes is to take a cue from `servant` and -provide a way to specify the JSON encoding at the type level. You -must manually specify the encoding, but you only have to do so once -(at the type level). Other tools can then inspect the type using either -type families or type classes to generate the appropriate artifacts or -behavior. Aeson integration (provided by this package) works by using a -type family to transform the spec into a new Haskell type whose structure -is analogous to the specification. You are then required to transform -your regular business value into a value of this "structural type" -(I strongly recommend using type holes to make this easier). Values of -the structural type will always encode into specification-complient JSON. +The tooling ecosystem that knows how to interpret 'Specification's +is still pretty new, but it at least includes OpenApi compatibility +(i.e. ToSchema instances) and Elm code generation. ## Example @@ -67,10 +44,10 @@ deriving (ToJSON, FromJSON) via (SpecJSON User) instance HasJsonEncodingSpec User where type EncodingSpec User = - JsonObject - '[ '("name", JsonString) - , '("last-login", JsonDateTime) - ] + JsonObject '[ + Required "name" JsonString, + Required "last-login" JsonDateTime + ] toJSONStructure user = (Field @"name" (name user), (Field @"last-login" (lastLogin user), diff --git a/json-spec.cabal b/json-spec.cabal --- a/json-spec.cabal +++ b/json-spec.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec -version: 0.2.3.0 +version: 0.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 @@ -54,3 +54,4 @@ , json-spec , bytestring >= 0.11.1.0 && < 0.12 , hspec >= 2.8.5 && < 2.12 + , om-show >= 0.1.2.9 && < 0.2 diff --git a/src/Data/JsonSpec.hs b/src/Data/JsonSpec.hs --- a/src/Data/JsonSpec.hs +++ b/src/Data/JsonSpec.hs @@ -16,10 +16,10 @@ > deriving (ToJSON, FromJSON) via (SpecJSON User) > instance HasJsonEncodingSpec User where > type EncodingSpec User = - > JsonObject - > '[ '("name", JsonString) - > , '("last-login", JsonDateTime) - > ] + > JsonObject '[ + > Required "name" JsonString, + > Required "last-login" JsonDateTime + > ] > toJSONStructure user = > (Field @"name" (name user), > (Field @"last-login" (lastLogin user), @@ -35,60 +35,37 @@ = Motivation - The particular use cases we focus on are enabling (but not providing - in this package): - - 1. Auto-generating documentation to ensure it is correct. - 2. Auto-generating client code in front-end languages to ensure it is correct. - - There are already tools available to achieve this, but they all have one - major drawback: they rely on generically derived Aeson instances. Some - people strongly object to using generically derived Aeson instances - for encoding/decoding http api data because of how brittle it is. It - can be surprisingly easy accidentally break your API without noticing - because you don't realize that a small change to some type somewhere - affects the API representation. Avoiding this requires very strict - discipline about how you organize and maintain your code. E.g. you - will see a lot of comments like + The primary motivation is to allow you to avoid Aeson Generic instances + while still getting the possibility of auto-generated (and therefore + /correct/) documentation and code in your servant APIs. - > --| BEWARE, Changing any of the types in this file will change the API - > -- representation!! - > module My.API (...) where + Historically, the trade-off has been: - But then the types in this api might reference types in in other modules - where it isn't as obvious that you might be changing the api when you - make an update. + 1. Use Generic instances, and therefore your API is brittle. Changes + to Deeply nested object might unexpectedly change (and break) your + API. You must structure your Haskell types exactly as they are + rendered into JSON, which may not always be "natural" and easy to + work with. In exchange, you get the ability to auto-derive matching + ToSchema instances along with various code generation tools that + all understand Aeson Generic instances. - I have even seen people go so far as to mandate that /every/ type - appearing on the API must be in some similar \"API\" module. This - usually ends badly because you end up with a bunch of seemingly spurious - (and quite tedious) translations between between \"business\" types and - almost identical \"API\" types. + 2. Hand-write your ToJSON and FromJSON instances, which means you + get to structure your Haskell types in the way that works best + for Haskell, while structuring your JSON in the way that works + best for your API. It also means you can more easily support "old" + decoding versions and more easily maintain backwards compatibility, + etc. In exchange, you have to to hand-write your ToSchema instances, + and code generation is basically out. - The other option is to simply not use generically derived instances - and code all or some of your 'ToJSON'/'FromJSON' instances by hand. That - (sometimes) helps solve the problem of making it a little more obvious - when you are making a breaking api change. And it definitely helps - with the ability to update the haskell type for some business purpose - while keeping the encoding backwards compatible. + The goal of this library is to provide a way to hand-write the encoding + and decoding of your JSON using type-level 'Specification's, while + still allowing the use of tools that can interpret the specification + and auto-generate ToSchema instances and code. - The problem now though is that you can't take advantage of any of the - above tooling without writing every instance by hand. Writing all the - individual instances by hand defeat's the purpose because you are back - to being unsure whether they are all in sync! + The tooling ecosystem that knows how to interpret 'Specification's + is still pretty new, but it at least includes OpenApi compatibility + (i.e. ToSchema instances) and Elm code generation. - The approach this library takes is to take a cue from `servant` and - provide a way to specify the JSON encoding at the type level. You - must manually specify the encoding, but you only have to do so once - (at the type level). Other tools can then inspect the type using - either type families or type classes to generate the appropriate - artifacts or behavior. Aeson integration (provided by this package) - works by using a type family to transform the spec into a new Haskell - type whose structure is analogous to the specification. You are then - required to transform your regular business value into a value of - this ''structural type'' (I strongly recommend using type holes to - make this easier). Values of the structural type will always encode - into specification-complient JSON. -} module Data.JsonSpec ( Specification(..), @@ -101,6 +78,7 @@ Rec(..), eitherDecode, StructureFromJSON, + FieldSpec(..) ) where @@ -109,10 +87,10 @@ fromJSONStructure), StructureFromJSON(reprParseJSON), eitherDecode) import Data.JsonSpec.Encode (HasJsonEncodingSpec(EncodingSpec, toJSONStructure), StructureToJSON(reprToJSON)) -import Data.JsonSpec.Spec (Field(Field), Rec(Rec, unRec), - Specification(JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt, - JsonLet, JsonNullable, JsonNum, JsonObject, JsonRef, JsonString, - JsonTag), Tag(Tag), JSONStructure) +import Data.JsonSpec.Spec (Field(Field, unField), FieldSpec(Optional, + Required), Rec(Rec, unRec), Specification(JsonArray, JsonBool, + JsonDateTime, JsonEither, JsonInt, JsonLet, JsonNullable, JsonNum, + JsonObject, JsonRef, JsonString, JsonTag), Tag(Tag), JSONStructure) import Prelude ((.), (<$>), (=<<)) diff --git a/src/Data/JsonSpec/Decode.hs b/src/Data/JsonSpec/Decode.hs --- a/src/Data/JsonSpec/Decode.hs +++ b/src/Data/JsonSpec/Decode.hs @@ -89,6 +89,16 @@ Just rawVal -> do val <- reprParseJSON rawVal pure (Field val, more) +instance (KnownSymbol key, StructureFromJSON val, StructureFromJSON more) => StructureFromJSON (Maybe (Field key val), more) where + reprParseJSON = + withObject "object" $ \o -> do + more <- reprParseJSON (Object o) + case KM.lookup (sym @key) o of + Nothing -> + pure (Nothing, more) + Just rawVal -> do + val <- reprParseJSON rawVal + pure (Just (Field val), more) instance (StructureFromJSON left, StructureFromJSON right) => StructureFromJSON (Either left right) where reprParseJSON v = (Left <$> reprParseJSON v) diff --git a/src/Data/JsonSpec/Encode.hs b/src/Data/JsonSpec/Encode.hs --- a/src/Data/JsonSpec/Encode.hs +++ b/src/Data/JsonSpec/Encode.hs @@ -22,8 +22,8 @@ import Data.Text (Text) import Data.Time (UTCTime) import GHC.TypeLits (KnownSymbol) -import Prelude (Either(Left, Right), Functor(fmap), Monoid(mempty), - (.), Bool, Int, Maybe, maybe) +import Prelude (Either(Left, Right), Functor(fmap), Maybe(Just, Nothing), + Monoid(mempty), (.), Bool, Int, maybe) import qualified Data.Aeson as A import qualified Data.Aeson.KeyMap as KM import qualified Data.Set as Set @@ -108,5 +108,14 @@ (sym @key) (reprToJSON val) (toJSONObject more) +instance (KnownSymbol key, StructureToJSON val, ToJSONObject more) => ToJSONObject (Maybe (Field key val), more) where + toJSONObject (mval, more) = + case mval of + Nothing -> toJSONObject more + Just (Field val) -> + KM.insert + (sym @key) + (reprToJSON val) + (toJSONObject more) diff --git a/src/Data/JsonSpec/Spec.hs b/src/Data/JsonSpec/Spec.hs --- a/src/Data/JsonSpec/Spec.hs +++ b/src/Data/JsonSpec/Spec.hs @@ -15,6 +15,7 @@ Field(..), Rec(..), JStruct, + FieldSpec(..), ) where @@ -36,7 +37,7 @@ See 'JSONStructure' for how these map into Haskell representations. -} data Specification - = JsonObject [(Symbol, Specification)] + = JsonObject [FieldSpec] {-^ An object with the specified properties, each having its own specification. This does not yet support optional properties, @@ -61,9 +62,9 @@ E.g.: > type SpecWithNullableField = - > JsonObject - > '[ '("nullableProperty", JsonNullable JsonString) - > ] + > JsonObject '[ + > Required "nullableProperty" (JsonNullable JsonString) + > ] -} | JsonEither Specification Specification {-^ @@ -78,24 +79,24 @@ > type EncodingSpec MyType = > JsonEither > ( - > JsonObject - > '[ '("tag", JsonTag "foo") - > , '("content", JsonString) - > ] + > JsonObject '[ + > Required "tag" (JsonTag "foo"), + > Required "content" JsonString + > ] > ) > ( > JsonEither > ( - > JsonObject - > '[ '("tag", JsonTag "bar") - > , '("content", JsonInt) - > ] + > JsonObject '[ + > Required "tag" (JsonTag "bar"), + > Required "content" JsonInt + > ] > ) > ( - > JsonObject - > '[ '("tag", JsonTag "baz") - > , '("content", JsonDateTime) - > ] + > JsonObject '[ + > Required "tag" (JsonTag "baz"), + > Required "content" JsonDateTime + > ] > ) > ) -} @@ -115,36 +116,51 @@ this repetitive definition: > type Triangle = - > JsonObject - > '[ '("vertex1", - > JsonObject '[('x', JsonInt), ('y', JsonInt), ('z', JsonInt)]) - > , '("vertex2", - > JsonObject '[('x', JsonInt), ('y', JsonInt), ('z', JsonInt)]) - > , '("vertex3", - > JsonObject '[('x', JsonInt), ('y', JsonInt), ('z', JsonInt)]) - > ] + > JsonObject '[ + > Required "vertex1" (JsonObject '[ + > Required "x" JsonInt, + > Required "y" JsonInt, + > Required "z" JsonInt + > ]), + > Required "vertex2" (JsonObject '[ + > Required "x" JsonInt, + > Required "y" JsonInt, + > Required "z" JsonInt + > ]), + > Required "vertex3" (JsonObject '[ + > Required "x" JsonInt), + > Required "y" JsonInt), + > Required "z" JsonInt) + > ]) + > ] Can be written more concisely as: > type Triangle = - > JsonLet '[("Vertex", - > JsonObject '[('x', JsonInt), ('y', JsonInt), ('z', JsonInt)]) - > ] - > (JsonObject - > '[ '("vertex1", JsonRef "Vertex") - > , '("vertex2", JsonRef "Vertex") - > , '("vertex3", JsonRef "Vertex") + > JsonLet + > '[ + > '("Vertex", JsonObject '[ + > ('x', JsonInt), + > ('y', JsonInt), + > ('z', JsonInt) > ]) + > ] + > (JsonObject '[ + > Required "vertex1" JsonRef "Vertex", + > Required "vertex2" JsonRef "Vertex", + > Required "vertex3" JsonRef "Vertex" + > ]) Another use is to define recursive types: > type LabelledTree = - > JsonLet '[ '("LabelledTree", - > JsonObject - > '[ '("label", JsonString) - > , '("children", JsonArray (JsonRef "LabelledTree")) - > ]) - > ] + > JsonLet + > '[ + > '("LabelledTree", JsonObject '[ + > Required "label", JsonString, + > Required "children" (JsonArray (JsonRef "LabelledTree")) + > ]) + > ] > (JsonRef "LabelledTree") -} | JsonRef Symbol @@ -154,6 +170,12 @@ -} +{-| Specify a field in an object. -} +data FieldSpec + = Required Symbol Specification {-^ The field is required -} + | Optional Symbol Specification {-^ The field is optionsl -} + + {- | @'JSONStructure' spec@ is the Haskell type used to contain the JSON data that will be encoded or decoded according to the provided @spec@. @@ -210,11 +232,16 @@ :: Type where JStruct env (JsonObject '[]) = () - JStruct env (JsonObject ( '(key, s) : more )) = + JStruct env (JsonObject ( Required key s : more )) = ( Field key (JStruct env s), JStruct env (JsonObject more) ) + JStruct env (JsonObject ( Optional key s : more )) = + ( + Maybe (Field key (JStruct env s)), + JStruct env (JsonObject more) + ) JStruct env JsonString = Text JStruct env JsonNum = Scientific JStruct env JsonInt = Int @@ -282,7 +309,7 @@ {-| Structural representation of an object field. -} -newtype Field (key :: Symbol) t = Field t +newtype Field (key :: Symbol) t = Field {unField :: t} deriving stock (Show, Eq) diff --git a/test/jsonspec.hs b/test/jsonspec.hs --- a/test/jsonspec.hs +++ b/test/jsonspec.hs @@ -8,26 +8,29 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wwarn #-} {- Because of GHC-69797 -} module Main (main) where - +import Control.Monad (join) import Data.Aeson (FromJSON, ToJSON) import Data.ByteString.Lazy (ByteString) -import Data.JsonSpec (Field(Field), HasJsonDecodingSpec(DecodingSpec, - fromJSONStructure), HasJsonEncodingSpec(EncodingSpec, toJSONStructure), - Rec(Rec, unRec), SpecJSON(SpecJSON), Specification(JsonArray, JsonBool, - JsonDateTime, JsonEither, JsonInt, JsonLet, JsonNullable, JsonNum, - JsonObject, JsonRef, JsonString, JsonTag), Tag(Tag), eitherDecode) +import Data.JsonSpec (Field(Field, unField), FieldSpec(Optional, + Required), HasJsonDecodingSpec(DecodingSpec, fromJSONStructure), + HasJsonEncodingSpec(EncodingSpec, toJSONStructure), Rec(Rec, unRec), + SpecJSON(SpecJSON), Specification(JsonArray, JsonBool, JsonDateTime, + JsonEither, JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, + JsonRef, JsonString, JsonTag), Tag(Tag), eitherDecode) import Data.Proxy (Proxy(Proxy)) import Data.Scientific (Scientific) import Data.Text (Text) import Data.Time (UTCTime(UTCTime)) -import Prelude (Applicative(pure), Bool(False, True), Either(Left, Right), - Enum(toEnum), Maybe(Just, Nothing), Monad((>>=)), Traversable(traverse), - ($), (.), Eq, IO, Int, Show, String, realToFrac) +import OM.Show (ShowJ(ShowJ)) +import Prelude (Applicative(pure), Bool(False, True), Either(Left, + Right), Enum(toEnum), Functor(fmap), Maybe(Just, Nothing), Monad((>>=)), + Traversable(traverse), ($), (.), Eq, IO, Int, Show, String, realToFrac) import Test.Hspec (describe, hspec, it, shouldBe) import qualified Data.Aeson as A @@ -112,6 +115,47 @@ in actual `shouldBe` expected + describe "optionality" $ do + let + obj :: TestOptionality + obj = + TestOptionality + { toFoo = Nothing + , toBar = Nothing + , toBaz = Nothing + , toQux = 1 + } + + it "encodes" $ + let + actual :: ByteString + actual = A.encode obj + + expected :: ByteString + expected = "{\"bar\":null,\"baz\":null,\"qux\":1}" + in + actual `shouldBe` expected + + it "decodes missing fields" $ + let + actual :: Either String TestOptionality + actual = A.eitherDecode "{\"bar\":null,\"qux\":1}" + + expected :: Either String TestOptionality + expected = Right obj + in + actual `shouldBe` expected + + it "decodes explicit null" $ + let + actual :: Either String TestOptionality + actual = A.eitherDecode "{\"bar\":null,\"baz\":null,\"qux\":1}" + + expected :: Either String TestOptionality + expected = Right obj + in + actual `shouldBe` expected + describe "let" $ do it "decodes let" $ let @@ -244,7 +288,7 @@ :: Either String (Field "foo" Text, - (Field "bar" Scientific, + (Maybe (Field "bar" Scientific), (Field "baz" (Field "foo" Text, (Field "bar" Int, @@ -260,7 +304,7 @@ :: Either String (Field "foo" Text, - (Field "bar" Scientific, + (Maybe (Field "bar" Scientific), (Field "baz" (Field "foo" Text, (Field "bar" Int, @@ -271,7 +315,7 @@ expected = Right (Field @"foo" "foo", - (Field @"bar" 1.0, + (Just (Field @"bar" 1.0), (Field @"baz" (Field @"foo" "foo2", (Field @"bar" 0, @@ -286,7 +330,7 @@ sampleTestObject = TestObj { foo = "foo" - , bar = 1 + , bar = Just 1 , baz = TestSubObj { foo2 = "foo2" @@ -301,7 +345,7 @@ sampleTestObjectWithNull= TestObj { foo = "foo" - , bar = 1 + , bar = Just 1 , baz = TestSubObj { foo2 = "foo2" @@ -323,14 +367,14 @@ type EncodingSpec TestSum = JsonEither (JsonObject '[ - '("tag", JsonTag "a"), - '("content", JsonObject [ - '("int-field", JsonInt), - '("txt-field", JsonString) + Required "tag" (JsonTag "a"), + Required "content" (JsonObject [ + Required "int-field" JsonInt, + Required "txt-field" JsonString ]) ]) (JsonObject '[ - '("tag", JsonTag "b") + Required "tag" (JsonTag "b") ]) toJSONStructure = \case TestA i t -> @@ -366,7 +410,7 @@ data TestObj = TestObj { foo :: Text - , bar :: Scientific + , bar :: Maybe Scientific , baz :: TestSubObj , qux :: Maybe Int , qoo :: Bool @@ -378,15 +422,15 @@ type EncodingSpec TestObj = JsonObject '[ - '("foo", JsonString), - '("bar", JsonNum), - '("baz", EncodingSpec TestSubObj), - '("qux", JsonNullable JsonInt), - '("qoo", JsonBool) + Required "foo" JsonString, + Optional "bar" JsonNum, + Required "baz" (EncodingSpec TestSubObj), + Required "qux" (JsonNullable JsonInt), + Required "qoo" JsonBool ] toJSONStructure TestObj { foo , bar , baz, qux, qoo } = (Field @"foo" foo, - (Field @"bar" (realToFrac bar), + (fmap (Field @"bar" . realToFrac) bar, (Field @"baz" (toJSONStructure baz), (Field @"qux" qux, (Field @"qoo" qoo, @@ -395,14 +439,14 @@ type DecodingSpec TestObj = EncodingSpec TestObj fromJSONStructure (Field @"foo" foo, - (Field @"bar" bar, + (fmap (unField @"bar") -> bar, (Field @"baz" rawBaz, (Field @"qux" qux, (Field @"qoo" qoo, ()))))) = do baz <- fromJSONStructure rawBaz - pure $ TestObj { foo, bar, baz, qux, qoo } + pure TestObj { foo, bar, baz, qux, qoo } data TestSubObj = TestSubObj @@ -413,8 +457,8 @@ instance HasJsonEncodingSpec TestSubObj where type EncodingSpec TestSubObj = JsonObject - '[ '("foo", JsonString) - , '("bar", JsonInt) + '[ Required "foo" JsonString + , Required "bar" JsonInt ] toJSONStructure TestSubObj { foo2 , bar2 } = (Field @"foo" foo2, @@ -439,8 +483,8 @@ instance HasJsonEncodingSpec User where type EncodingSpec User = JsonObject - '[ '("name", JsonString) - , '("last-login", JsonDateTime) + '[ Required "name" JsonString + , Required "last-login" JsonDateTime ] toJSONStructure user = (Field @"name" (name user), @@ -466,9 +510,9 @@ instance HasJsonEncodingSpec Vertex where type EncodingSpec Vertex = JsonObject - '[ '("x", JsonInt) - , '("y", JsonInt) - , '("z", JsonInt) + '[ Required "x" JsonInt + , Required "y" JsonInt + , Required "z" JsonInt ] toJSONStructure Vertex {x, y, z} = (Field @"x" x, @@ -498,9 +542,9 @@ JsonLet '[ '("Vertex", EncodingSpec Vertex) ] (JsonObject - '[ '("vertex1", JsonRef "Vertex") - , '("vertex2", JsonRef "Vertex") - , '("vertex3", JsonRef "Vertex") + '[ Required "vertex1" (JsonRef "Vertex") + , Required "vertex2" (JsonRef "Vertex") + , Required "vertex3" (JsonRef "Vertex") ]) toJSONStructure Triangle {vertex1, vertex2, vertex3} = (Field @"vertex1" (toJSONStructure vertex1), @@ -532,8 +576,8 @@ JsonLet '[ '("LabelledTree", JsonObject - '[ '("label", JsonString) - , '("children", JsonArray (JsonRef "LabelledTree")) + '[ Required "label" JsonString + , Required "children" (JsonArray (JsonRef "LabelledTree")) ] ) ] @@ -554,5 +598,42 @@ = do children <- traverse (fromJSONStructure . unRec) children_ pure LabelledTree { label , children } + + +data TestOptionality = TestOptionality + { toFoo :: Maybe Int + , toBar :: Maybe Int + , toBaz :: Maybe Int + , toQux :: Int + } + deriving (ToJSON, FromJSON) via (SpecJSON TestOptionality) + deriving (Show) via (ShowJ TestOptionality) + deriving stock (Eq) +instance HasJsonEncodingSpec TestOptionality where + type EncodingSpec TestOptionality = + JsonObject + '[ Optional "foo" JsonInt + , Required "bar" (JsonNullable JsonInt) + , Optional "baz" (JsonNullable JsonInt) + , Required "qux" JsonInt + ] + + toJSONStructure TestOptionality { toFoo , toBar , toBaz , toQux } = + (fmap (Field @"foo") toFoo, + (Field @"bar" toBar, + ((Just . Field @"baz") toBaz, -- when encoding, prefer explicit null for testing. + (Field @"qux" toQux, + ())))) +instance HasJsonDecodingSpec TestOptionality where + type DecodingSpec TestOptionality = EncodingSpec TestOptionality + + fromJSONStructure + (fmap (unField @"foo") -> toFoo, + (Field @"bar" toBar, + (join . fmap (unField @"baz") -> toBaz, + (Field @"qux" toQux, + ())))) + = + pure TestOptionality { toFoo , toBar , toBaz , toQux }