json-spec 0.3.0.1 → 0.4.0.0
raw patch · 6 files changed
+140/−53 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.JsonSpec: JsonRaw :: Specification
+ Data.JsonSpec: encode :: forall (spec :: Specification). StructureToJSON (JSONStructure spec) => Proxy spec -> JSONStructure spec -> Value
Files
- json-spec.cabal +1/−1
- src/Data/JsonSpec.hs +4/−2
- src/Data/JsonSpec/Decode.hs +2/−0
- src/Data/JsonSpec/Encode.hs +15/−1
- src/Data/JsonSpec/Spec.hs +8/−4
- test/jsonspec.hs +110/−45
json-spec.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec-version: 0.3.0.1+version: 0.4.0.0 synopsis: Type-level JSON specification maintainer: rick@owensmurray.com description: See the README at: https://github.com/owensmurray/json-spec#json-spec
src/Data/JsonSpec.hs view
@@ -77,6 +77,7 @@ JSONStructure, Rec(..), eitherDecode,+ encode, StructureFromJSON, FieldSpec(..) ) where@@ -86,11 +87,12 @@ import Data.JsonSpec.Decode (HasJsonDecodingSpec(DecodingSpec, fromJSONStructure), StructureFromJSON(reprParseJSON), eitherDecode) import Data.JsonSpec.Encode (HasJsonEncodingSpec(EncodingSpec,- toJSONStructure), StructureToJSON(reprToJSON))+ toJSONStructure), StructureToJSON(reprToJSON), encode) 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)+ JsonObject, JsonRaw, JsonRef, JsonString, JsonTag), Tag(Tag),+ JSONStructure) import Prelude ((.), (<$>), (=<<))
src/Data/JsonSpec/Decode.hs view
@@ -69,6 +69,8 @@ -} class StructureFromJSON a where reprParseJSON :: Value -> Parser a+instance StructureFromJSON Value where+ reprParseJSON = pure instance StructureFromJSON Text where reprParseJSON = withText "string" pure instance StructureFromJSON Scientific where
src/Data/JsonSpec/Encode.hs view
@@ -11,19 +11,21 @@ module Data.JsonSpec.Encode ( HasJsonEncodingSpec(..), StructureToJSON(..),+ encode, ) where import Data.Aeson (ToJSON(toJSON), Value) import Data.JsonSpec.Spec (Field(Field), Rec(unRec), Specification(JsonArray), JSONStructure, JStruct, Tag, sym)+import Data.Proxy (Proxy(Proxy)) import Data.Scientific (Scientific) import Data.Set (Set) import Data.Text (Text) import Data.Time (UTCTime) import GHC.TypeLits (KnownSymbol) import Prelude (Either(Left, Right), Functor(fmap), Maybe(Just, Nothing),- Monoid(mempty), (.), Bool, Int, maybe)+ Monoid(mempty), (.), Bool, Int, id, maybe) import qualified Data.Aeson as A import qualified Data.Aeson.KeyMap as KM import qualified Data.Set as Set@@ -55,6 +57,8 @@ -} class StructureToJSON a where reprToJSON :: a -> Value+instance StructureToJSON Value where+ reprToJSON = id instance StructureToJSON () where reprToJSON () = A.object [] instance StructureToJSON Bool where@@ -117,5 +121,15 @@ (sym @key) (reprToJSON val) (toJSONObject more)+++{-|+ Given a raw Haskell structure, directly encode it directly into an+ aeson Value without having to go through any To/FromJSON instances.++ See also: `Data.JsonSpec.eitherDecode`.+-}+encode :: StructureToJSON (JSONStructure spec) => Proxy spec -> JSONStructure spec -> Value+encode Proxy = reprToJSON
src/Data/JsonSpec/Spec.hs view
@@ -19,6 +19,7 @@ ) where +import Data.Aeson (Value) import Data.Kind (Type) import Data.Proxy (Proxy(Proxy)) import Data.Scientific (Scientific)@@ -31,7 +32,7 @@ {-| Simple DSL for defining type level "specifications" for JSON data. Similar in spirit to (but not isomorphic with) JSON Schema.- + Intended to be used at the type level using @-XDataKinds@ See 'JSONStructure' for how these map into Haskell representations.@@ -111,7 +112,7 @@ {-^ A "let" expression. This is useful for giving names to types, which can then be used in the generated code.- + This is also useful to shorten repetitive type definitions. For example, this repetitive definition: @@ -133,7 +134,7 @@ > Required "z" JsonInt) > ]) > ]- + Can be written more concisely as: > type Triangle =@@ -168,8 +169,10 @@ A reference to a specification which has been defined in a surrounding 'JsonLet'. -}+ | JsonRaw {-^ Some raw, uninterpreted JSON value -} + {-| Specify a field in an object. -} data FieldSpec = Required Symbol Specification {-^ The field is required -}@@ -255,6 +258,7 @@ JStruct env (JsonLet defs spec) = JStruct (Append defs env) spec JStruct env (JsonRef ref) = Lookup ref env+ JStruct env JsonRaw = Value {-|@@ -290,7 +294,7 @@ > JsonLet > '[ '("Foo", JsonArray (JsonRef "Foo")) ] > (JsonRef "Foo")- > toJSONStructure (Foo fs) = + > toJSONStructure (Foo fs) = > [ Rec (toJSONStructure f) > | f <- fs > ]
test/jsonspec.hs view
@@ -17,20 +17,13 @@ import Control.Monad (join) import Data.Aeson (FromJSON, ToJSON) import Data.ByteString.Lazy (ByteString)-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.JsonSpec import Data.Proxy (Proxy(Proxy)) import Data.Scientific (Scientific) import Data.Text (Text) import Data.Time (UTCTime(UTCTime)) 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 Prelude import Test.Hspec (describe, hspec, it, shouldBe) import qualified Data.Aeson as A @@ -140,7 +133,7 @@ let actual :: Either String TestOptionality actual = A.eitherDecode "{\"bar\":null,\"qux\":1}"- + expected :: Either String TestOptionality expected = Right obj in@@ -150,7 +143,7 @@ let actual :: Either String TestOptionality actual = A.eitherDecode "{\"bar\":null,\"baz\":null,\"qux\":1}"- + expected :: Either String TestOptionality expected = Right obj in@@ -251,7 +244,6 @@ in actual `shouldBe` expected - describe "nullable" $ do it "encodes product" $ let@@ -282,10 +274,27 @@ in actual `shouldBe` expected - it "eitherDecode" $- let- actual- :: Either+ describe "direct encoding/decoding" $ do+ it "eitherDecode" $+ let+ actual+ :: Either+ String+ (Field "foo" Text,+ (Maybe (Field "bar" Scientific),+ (Field "baz"+ (Field "foo" Text,+ (Field "bar" Int,+ ())),+ (Field "qux" (Maybe Int),+ (Field "qoo" Bool,+ ())))))+ actual =+ A.eitherDecode+ "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null,\"qoo\":false}"+ >>= eitherDecode (Proxy @(EncodingSpec TestObj))+ expected+ :: Either String (Field "foo" Text, (Maybe (Field "bar" Scientific),@@ -296,35 +305,91 @@ (Field "qux" (Maybe Int), (Field "qoo" Bool, ())))))- actual =- A.eitherDecode- "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null,\"qoo\":false}"- >>= eitherDecode (Proxy @(EncodingSpec TestObj))- expected- :: Either- String- (Field "foo" Text,- (Maybe (Field "bar" Scientific),- (Field "baz"- (Field "foo" Text,- (Field "bar" Int,- ())),- (Field "qux" (Maybe Int),- (Field "qoo" Bool,- ())))))- expected =- Right- (Field @"foo" "foo",- (Just (Field @"bar" 1.0),- (Field @"baz"- (Field @"foo" "foo2",- (Field @"bar" 0,- ())),- (Field @"qux" Nothing,- (Field @"qoo" False,- ())))))- in- actual `shouldBe` expected+ expected =+ Right+ (Field @"foo" "foo",+ (Just (Field @"bar" 1.0),+ (Field @"baz"+ (Field @"foo" "foo2",+ (Field @"bar" 0,+ ())),+ (Field @"qux" Nothing,+ (Field @"qoo" False,+ ())))))+ in+ actual `shouldBe` expected++ it "encode" $+ let+ expected :: Maybe A.Value+ expected =+ A.decode "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null,\"qoo\":false}"++ actual :: Maybe A.Value+ actual =+ Just $+ encode+ (Proxy @(EncodingSpec TestObj))+ (+ (Field @"foo" "foo",+ (Just (Field @"bar" 1.0),+ (Field @"baz"+ (Field @"foo" "foo2",+ (Field @"bar" 0,+ ())),+ (Field @"qux" Nothing,+ (Field @"qoo" False,+ ())))))+ )+ in+ actual `shouldBe` expected++ describe "raw values" $ do+ it "decodes" $+ let+ expected :: Either String (Field "foo" A.Value, ())+ expected =+ Right+ (Field @"foo"+ (+ A.object+ [ ("bar", A.String "barval")+ , ("baz", A.toJSON [A.String "qux", A.Number 1.0, A.Bool False])+ ]+ )+ ,())++ actual :: Either String (Field "foo" A.Value, ())+ actual =+ A.eitherDecode+ "{ \"foo\": { \"bar\": \"barval\", \"baz\": [ \"qux\", 1, false ] } }"+ >>=+ eitherDecode (Proxy @( JsonObject '[ Required "foo" JsonRaw ]))+ in+ actual `shouldBe` expected+ it "encodes" $+ let+ expected :: Maybe A.Value+ expected =+ A.decode+ "{ \"foo\": { \"bar\": \"barval\", \"baz\": [ \"qux\", 1, false ] } }"++ actual :: Maybe A.Value+ actual =+ Just $+ encode+ (Proxy @( JsonObject '[ Required "foo" JsonRaw ]))+ (Field @"foo"+ (+ A.object+ [ ("bar", A.String "barval")+ , ("baz", A.toJSON [A.String "qux", A.Number 1.0, A.Bool False])+ ]+ ),+ ())+ in+ actual `shouldBe` expected+ sampleTestObject :: TestObj sampleTestObject =