json-spec 1.3.0.2 → 1.4.0.0
raw patch · 8 files changed
+236/−10 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.JsonSpec: [JsonDict] :: Specification -> Specification
Files
- CHANGELOG.md +5/−0
- README.md +7/−0
- json-spec.cabal +1/−1
- src/Data/JsonSpec.hs +3/−3
- src/Data/JsonSpec/Decode.hs +14/−0
- src/Data/JsonSpec/Encode.hs +9/−0
- src/Data/JsonSpec/Spec.hs +12/−2
- test/jsonspec.hs +185/−4
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog +## 1.4.0.0++- Add `JsonDict` for JSON objects with arbitrary string keys and values that+ all conform to one known specification.+ ## 1.3.0.2 - Relax upper bounds on `containers` and `time` for current Hackage
README.md view
@@ -63,3 +63,10 @@ ``` For more examples, take a look at the test suite.++`JsonDict` represents a JSON object whose keys are arbitrary strings and+whose values all conform to one spec:++```haskell+type ScoresByUser = JsonDict JsonInt+```
json-spec.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: json-spec-version: 1.3.0.2+version: 1.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
@@ -111,9 +111,9 @@ import Data.JsonSpec.Spec ( Field(Field), FieldSpec(Optional, Required), Ref(Ref, unRef) , Specification- ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt- , JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString- , JsonTag+ ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonDict, JsonEither+ , JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef+ , JsonString, JsonTag ) , Tag(Tag), (:::), (::?), JSONStructure, unField )
src/Data/JsonSpec/Decode.hs view
@@ -23,6 +23,7 @@ import Data.JsonSpec.Spec ( Field(Field), Ref(Ref), Tag(Tag), JSONStructure, JStruct, Specification, sym )+import Data.Map (Map) import Data.Proxy (Proxy) import Data.Scientific (Scientific) import Data.Text (Text)@@ -33,7 +34,9 @@ , Maybe(Just, Nothing), MonadFail(fail), Semigroup((<>)) , Traversable(traverse), ($), (.), (<$>), Bool, Int, String )+import qualified Data.Aeson.Key as AK import qualified Data.Aeson.KeyMap as KM+import qualified Data.Map as Map import qualified Data.Vector as Vector @@ -120,6 +123,17 @@ withArray "list" (fmap Vector.toList . traverse reprParseJSON)+instance (StructureFromJSON a) => StructureFromJSON (Map Text a) where+ reprParseJSON =+ withObject+ "dict"+ ( fmap Map.fromList+ . traverse+ ( \(key, val) ->+ (\val_ -> (AK.toText key, val_)) <$> reprParseJSON val+ )+ . KM.toList+ ) instance StructureFromJSON UTCTime where reprParseJSON = parseJSON instance (StructureFromJSON a) => StructureFromJSON (Maybe a) where
src/Data/JsonSpec/Encode.hs view
@@ -16,6 +16,7 @@ import Data.Aeson (ToJSON(toJSON), Value)+import Data.Map (Map) import Data.JsonSpec.Spec ( Field(Field), Ref(unRef), Specification(JsonArray), JSONStructure, JStruct , Tag, sym@@ -31,7 +32,9 @@ , (.), Bool, Int, id, maybe ) import qualified Data.Aeson as A+import qualified Data.Aeson.Key as AK import qualified Data.Aeson.KeyMap as KM+import qualified Data.Map as Map import qualified Data.Set as Set @@ -83,6 +86,12 @@ reprToJSON _proxy = toJSON (sym @const @Text) instance (StructureToJSON a) => StructureToJSON [a] where reprToJSON = toJSON . fmap reprToJSON+instance (StructureToJSON a) => StructureToJSON (Map Text a) where+ reprToJSON =+ A.Object+ . KM.fromList+ . fmap (\(key, val) -> (AK.fromText key, reprToJSON val))+ . Map.toList instance StructureToJSON UTCTime where reprToJSON = toJSON instance (StructureToJSON a) => StructureToJSON (Maybe a) where
src/Data/JsonSpec/Spec.hs view
@@ -26,6 +26,7 @@ import Data.Aeson (Value) import Data.Kind (Type)+import Data.Map (Map) import Data.Proxy (Proxy(Proxy)) import Data.Scientific (Scientific) import Data.String (IsString(fromString))@@ -61,6 +62,14 @@ {-^ A JSON integer. -} JsonArray :: Specification -> Specification {-^ A JSON array of values which conform to the given spec. -}+ JsonDict :: Specification -> Specification+ {-^+ A JSON object used as a dictionary: arbitrary string keys, with every+ value conforming to the given specification.++ This is distinct from 'JsonObject', which represents a record with+ statically known fields.+ -} JsonBool :: Specification {-^ A JSON boolean value. -} JsonNullable :: Specification -> Specification@@ -257,8 +266,8 @@ when building your 'HasJsonDecodingSpec' instances. See @TestHasField@ in the tests for an example - Arrays, booleans, numbers, and strings are just Lists, 'Bool's,- 'Scientific's, and 'Text's respectively.+ Arrays, dicts, booleans, numbers, and strings are just Lists,+ @'Map' 'Text'@, 'Bool's, 'Scientific's, and 'Text's respectively. If the user can convert their normal business logic type to/from this tuple type, then they get a JSON encoding to/from their type that is@@ -343,6 +352,7 @@ JStruct env JsonNum = Scientific JStruct env JsonInt = Int JStruct env (JsonArray spec) = [JStruct env spec]+ JStruct env (JsonDict spec) = Map Text (JStruct env spec) JStruct env JsonBool = Bool JStruct env (JsonEither specs) = EitherJStruct env specs
test/jsonspec.hs view
@@ -26,19 +26,21 @@ import Control.Monad (join) import Data.Aeson (FromJSON, ToJSON) import Data.ByteString.Lazy (ByteString)+import Data.Either (isLeft) import Data.JsonSpec ( Field(Field), FieldSpec(Optional, Required) , HasJsonDecodingSpec(DecodingSpec, fromJSONStructure) , HasJsonEncodingSpec(EncodingSpec, toJSONStructure), Ref(Ref) , SpecJSON(SpecJSON) , Specification- ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonEither, JsonInt- , JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef, JsonString- , JsonTag+ ( JsonAnnotated, JsonArray, JsonBool, JsonDateTime, JsonDict, JsonEither+ , JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject, JsonRaw, JsonRef+ , JsonString, JsonTag ) , Tag(Tag), (:::), (::?), eitherDecode , encode, unField )+import Data.Map (Map) import Data.Proxy (Proxy(Proxy)) import Data.Scientific (Scientific) import Data.Text (Text)@@ -49,8 +51,9 @@ , Functor(fmap), Maybe(Just, Nothing), Monad((>>=)), Num(negate) , Traversable(traverse), ($), (.), Eq, IO, Int, Show, String, realToFrac )-import Test.Hspec (describe, hspec, it, shouldBe)+import Test.Hspec (describe, hspec, it, shouldBe, shouldSatisfy) import qualified Data.Aeson as A+import qualified Data.Map as Map main :: IO ()@@ -366,6 +369,184 @@ (Field @"qoo" False, ()))))) )+ in+ actual `shouldBe` expected++ describe "dict" $ do+ it "encodes an empty dict" $+ let+ actual :: A.Value+ actual =+ encode+ (Proxy @(JsonDict JsonInt))+ Map.empty++ expected :: A.Value+ expected = A.object []+ in+ actual `shouldBe` expected++ it "round-trips a non-empty int dict" $+ let+ raw :: A.Value+ raw =+ A.object+ [ ("alpha", A.Number 1)+ , ("beta", A.Number 2)+ ]++ decoded :: Either String (Map Text Int)+ decoded =+ eitherDecode+ (Proxy @(JsonDict JsonInt))+ raw++ encoded :: Either String A.Value+ encoded =+ fmap+ (encode (Proxy @(JsonDict JsonInt)))+ decoded++ expected :: Either String A.Value+ expected = Right raw+ in+ encoded `shouldBe` expected++ it "decodes a dict of objects" $+ let+ raw :: A.Value+ raw =+ A.object+ [ ( "first"+ , A.object+ [ ("foo", A.String "first")+ , ("bar", A.Number 1)+ ]+ )+ , ( "second"+ , A.object+ [ ("foo", A.String "second")+ , ("bar", A.Number 2)+ ]+ )+ ]++ actual+ :: Either+ String+ (Map Text+ (Field "foo" Text,+ (Field "bar" Int,+ ())))+ actual =+ eitherDecode+ (Proxy @(JsonDict (JsonObject+ '[ "foo" ::: JsonString+ , "bar" ::: JsonInt+ ])))+ raw++ expected+ :: Either+ String+ (Map Text+ (Field "foo" Text,+ (Field "bar" Int,+ ())))+ expected =+ Right $+ Map.fromList+ [ ( "first"+ , (Field @"foo" "first",+ (Field @"bar" 1,+ ()))+ )+ , ( "second"+ , (Field @"foo" "second",+ (Field @"bar" 2,+ ()))+ )+ ]+ in+ actual `shouldBe` expected++ it "decodes a dict of nullable values" $+ let+ raw :: A.Value+ raw =+ A.object+ [ ("present", A.String "value")+ , ("missing", A.Null)+ ]++ actual :: Either String (Map Text (Maybe Text))+ actual =+ eitherDecode+ (Proxy @(JsonDict (JsonNullable JsonString)))+ raw++ expected :: Either String (Map Text (Maybe Text))+ expected =+ Right $+ Map.fromList+ [ ("missing", Nothing)+ , ("present", Just "value")+ ]+ in+ actual `shouldBe` expected++ it "rejects dict values that do not match the value spec" $+ let+ actual :: Either String (Map Text Int)+ actual =+ eitherDecode+ (Proxy @(JsonDict JsonInt))+ (A.object [("bad", A.String "not an int")])+ in+ actual `shouldSatisfy` isLeft++ it "rejects non-object dict JSON" $+ let+ actual :: Either String (Map Text Int)+ actual =+ eitherDecode+ (Proxy @(JsonDict JsonInt))+ (A.String "not an object")+ in+ actual `shouldSatisfy` isLeft++ it "works inside an object field" $+ let+ actual+ :: Either+ String+ (Field "attrs" (Map Text Int), ())+ actual =+ eitherDecode+ (Proxy @(JsonObject '[ "attrs" ::: JsonDict JsonInt ]))+ ( A.object+ [ ( "attrs"+ , A.object+ [ ("alpha", A.Number 1)+ , ("beta", A.Number 2)+ ]+ )+ ]+ )++ expected+ :: Either+ String+ (Field "attrs" (Map Text Int), ())+ expected =+ Right+ ( Field @"attrs" $+ Map.fromList+ [ ("alpha", 1)+ , ("beta", 2)+ ]+ , ()+ ) in actual `shouldBe` expected