diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -58,29 +58,31 @@ ## Example -> data User = User -> { name :: Text -> , lastLogin :: UTCTime -> } -> deriving stock (Show, Eq) -> deriving (ToJSON, FromJSON) via (SpecJSON User) -> instance HasJsonEncodingSpec User where -> type EncodingSpec User = -> JsonObject -> '[ '("name", JsonString) -> , '("last-login", JsonDateTime) -> ] -> toJSONStructure user = -> (Field @"name" (name user), -> (Field @"last-login" (lastLogin user), -> ())) -> instance HasJsonDecodingSpec User where -> type DecodingSpec User = EncodingSpec User -> fromJSONStructure -> (Field @"name" name, -> (Field @"last-login" lastLogin, -> ())) -> = -> pure User { name , lastLogin } +```haskell +data User = User + { name :: Text + , lastLogin :: UTCTime + } + deriving stock (Show, Eq) + deriving (ToJSON, FromJSON) via (SpecJSON User) +instance HasJsonEncodingSpec User where + type EncodingSpec User = + JsonObject + '[ '("name", JsonString) + , '("last-login", JsonDateTime) + ] + toJSONStructure user = + (Field @"name" (name user), + (Field @"last-login" (lastLogin user), + ())) +instance HasJsonDecodingSpec User where + type DecodingSpec User = EncodingSpec User + fromJSONStructure + (Field @"name" name, + (Field @"last-login" lastLogin, + ())) + = + pure User { name , lastLogin } +``` For more examples, take a look at the test suite. diff --git a/json-spec.cabal b/json-spec.cabal --- a/json-spec.cabal +++ b/json-spec.cabal @@ -1,109 +1,9 @@ cabal-version: 3.0 name: json-spec -version: 0.2.2.0 +version: 0.2.3.0 synopsis: Type-level JSON specification maintainer: rick@owensmurray.com -description: = 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 - - 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. - - 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. - - 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 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 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. - - = Example - - > data User = User - > { name :: Text - > , lastLogin :: UTCTime - > } - > deriving stock (Show, Eq) - > deriving (ToJSON, FromJSON) via (SpecJSON User) - > instance HasJsonEncodingSpec User where - > type EncodingSpec User = - > JsonObject - > '[ '("name", JsonString) - > , '("last-login", JsonDateTime) - > ] - > toJSONStructure user = - > (Field @"name" (name user), - > (Field @"last-login" (lastLogin user), - > ())) - > instance HasJsonDecodingSpec User where - > type DecodingSpec User = EncodingSpec User - > fromJSONStructure - > (Field @"name" name, - > (Field @"last-login" lastLogin, - > ())) - > = - > pure User { name , lastLogin } - +description: See the README at: https://github.com/owensmurray/json-spec#json-spec homepage: https://github.com/owensmurray/json-spec license: MIT license-file: LICENSE 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 @@ -27,7 +27,7 @@ import GHC.TypeLits (KnownSymbol) import Prelude (Applicative(pure), Either(Left, Right), Eq((==)), Functor(fmap), Maybe(Just, Nothing), MonadFail(fail), Semigroup((<>)), - Traversable(traverse), ($), (.), (<$>), Int, String) + Traversable(traverse), ($), (.), (<$>), Bool, Int, String) import qualified Data.Aeson.KeyMap as KM import qualified Data.Vector as Vector @@ -78,6 +78,8 @@ instance StructureFromJSON () where reprParseJSON = withObject "empty object" $ \_ -> pure () +instance StructureFromJSON Bool where + reprParseJSON = parseJSON instance (KnownSymbol key, StructureFromJSON val, StructureFromJSON more) => StructureFromJSON (Field key val, more) where reprParseJSON = withObject "object" $ \o -> do 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 @@ -23,7 +23,7 @@ import Data.Time (UTCTime) import GHC.TypeLits (KnownSymbol) import Prelude (Either(Left, Right), Functor(fmap), Monoid(mempty), - (.), Int, Maybe, maybe) + (.), Bool, Int, Maybe, maybe) import qualified Data.Aeson as A import qualified Data.Aeson.KeyMap as KM import qualified Data.Set as Set @@ -57,6 +57,8 @@ reprToJSON :: a -> Value instance StructureToJSON () where reprToJSON () = A.object [] +instance StructureToJSON Bool where + reprToJSON = toJSON instance StructureToJSON Text where reprToJSON = toJSON instance StructureToJSON Scientific where diff --git a/test/jsonspec.hs b/test/jsonspec.hs --- a/test/jsonspec.hs +++ b/test/jsonspec.hs @@ -16,12 +16,18 @@ import Data.Aeson (FromJSON, ToJSON) import Data.ByteString.Lazy (ByteString) -import Data.JsonSpec -import Data.Proxy +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.Proxy (Proxy(Proxy)) import Data.Scientific (Scientific) import Data.Text (Text) import Data.Time (UTCTime(UTCTime)) -import Prelude +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 Test.Hspec (describe, hspec, it, shouldBe) import qualified Data.Aeson as A @@ -35,7 +41,7 @@ actual :: ByteString actual = A.encode $ sampleTestObject expected :: ByteString - expected = "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":100}" + expected = "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qoo\":true,\"qux\":100}" in actual `shouldBe` expected @@ -44,7 +50,7 @@ actual :: Either String TestObj actual = A.eitherDecode - "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":100}" + "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":100,\"qoo\":true}" expected :: Either String TestObj expected = Right sampleTestObject in @@ -208,7 +214,7 @@ actual :: ByteString actual = A.encode $ sampleTestObjectWithNull expected :: ByteString - expected = "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null}" + expected = "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qoo\":false,\"qux\":null}" in actual `shouldBe` expected @@ -217,7 +223,7 @@ actual :: Either String TestObj actual = A.eitherDecode - "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null}" + "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null,\"qoo\":false}" expected :: Either String TestObj expected = Right sampleTestObjectWithNull in @@ -244,10 +250,11 @@ (Field "bar" Int, ())), (Field "qux" (Maybe Int), - ())))) + (Field "qoo" Bool, + ()))))) actual = A.eitherDecode - "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null}" + "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null,\"qoo\":false}" >>= eitherDecode (Proxy @(EncodingSpec TestObj)) expected :: Either @@ -259,7 +266,8 @@ (Field "bar" Int, ())), (Field "qux" (Maybe Int), - ())))) + (Field "qoo" Bool, + ()))))) expected = Right (Field @"foo" "foo", @@ -269,7 +277,8 @@ (Field @"bar" 0, ())), (Field @"qux" Nothing, - ())))) + (Field @"qoo" False, + ()))))) in actual `shouldBe` expected @@ -284,6 +293,7 @@ , bar2 = 0 } , qux = Just 100 + , qoo = True } @@ -299,6 +309,7 @@ } , qux = Nothing + , qoo = False } @@ -358,6 +369,7 @@ , bar :: Scientific , baz :: TestSubObj , qux :: Maybe Int + , qoo :: Bool } deriving stock (Show, Eq) deriving ToJSON via (SpecJSON TestObj) @@ -369,14 +381,16 @@ '("foo", JsonString), '("bar", JsonNum), '("baz", EncodingSpec TestSubObj), - '("qux", JsonNullable JsonInt) + '("qux", JsonNullable JsonInt), + '("qoo", JsonBool) ] - toJSONStructure TestObj { foo , bar , baz, qux } = + toJSONStructure TestObj { foo , bar , baz, qux, qoo } = (Field @"foo" foo, (Field @"bar" (realToFrac bar), (Field @"baz" (toJSONStructure baz), (Field @"qux" qux, - ())))) + (Field @"qoo" qoo, + ()))))) instance HasJsonDecodingSpec TestObj where type DecodingSpec TestObj = EncodingSpec TestObj fromJSONStructure @@ -384,10 +398,11 @@ (Field @"bar" bar, (Field @"baz" rawBaz, (Field @"qux" qux, - ())))) + (Field @"qoo" qoo, + ()))))) = do baz <- fromJSONStructure rawBaz - pure $ TestObj { foo, bar, baz, qux } + pure $ TestObj { foo, bar, baz, qux, qoo } data TestSubObj = TestSubObj