json-spec 0.2.1.3 → 0.2.2.0

raw patch · 5 files changed

+72/−16 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• json-spec.cabal +1/−1
• src/Data/JsonSpec.hs +5/−2
• src/Data/JsonSpec/Decode.hs +17/−4
• src/Data/JsonSpec/Spec.hs +2/−0
• test/jsonspec.hs +47/−9

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                json-spec-version:             0.2.1.3+version:             0.2.2.0 synopsis:            Type-level JSON specification maintainer:          rick@owensmurray.com description:         = Motivation

@@ -86,7 +86,7 @@   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+  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. -}@@ -99,18 +99,21 @@   Field(..),   JSONStructure,   Rec(..),+  eitherDecode,+  StructureFromJSON, ) where   import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON)) import Data.JsonSpec.Decode (HasJsonDecodingSpec(DecodingSpec,-  fromJSONStructure), StructureFromJSON(reprParseJSON))+  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 Prelude ((.), (<$>), (=<<))   {- |

@@ -11,22 +11,23 @@ module Data.JsonSpec.Decode (   StructureFromJSON(..),   HasJsonDecodingSpec(..),+  eitherDecode, ) where   import Control.Applicative (Alternative((<|>)))-import Data.Aeson (FromJSON(parseJSON), Value(Null, Object), withArray,-  withObject, withScientific, withText)-import Data.Aeson.Types (Parser)+import Data.Aeson.Types (FromJSON(parseJSON), Value(Null, Object),+  Parser, parseEither, withArray, withObject, withScientific, withText) import Data.JsonSpec.Spec (Field(Field), Rec(Rec), Tag(Tag),   JSONStructure, JStruct, Specification, sym)+import Data.Proxy (Proxy) import Data.Scientific (Scientific) import Data.Text (Text) import Data.Time (UTCTime) import GHC.TypeLits (KnownSymbol) import Prelude (Applicative(pure), Either(Left, Right), Eq((==)),   Functor(fmap), Maybe(Just, Nothing), MonadFail(fail), Semigroup((<>)),-  Traversable(traverse), ($), (.), (<$>), Int)+  Traversable(traverse), ($), (.), (<$>), Int, String) import qualified Data.Aeson.KeyMap as KM import qualified Data.Vector as Vector @@ -116,5 +117,17 @@     Rec <$> reprParseJSON val  +{-|+  Directly decode some JSON accoring to a spec without going through+  any To/FromJSON instances.+-}+eitherDecode+  :: forall spec.+     (StructureFromJSON (JSONStructure spec))+   => Proxy (spec :: Specification)+  -> Value+  -> Either String (JSONStructure spec)+eitherDecode _spec =+  parseEither reprParseJSON  

@@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}@@ -282,6 +283,7 @@  {-| Structural representation of an object field. -} newtype Field (key :: Symbol) t = Field t+  deriving stock (Show, Eq)   {- |

@@ -9,21 +9,19 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wwarn #-} {- Because of GHC-69797 -}+ module Main (main) where + 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,-  JsonDateTime, JsonEither, JsonInt, JsonLet, JsonNullable, JsonNum,-  JsonObject, JsonRef, JsonString, JsonTag), Tag(Tag))+import Data.JsonSpec+import Data.Proxy import Data.Scientific (Scientific) import Data.Text (Text) import Data.Time (UTCTime(UTCTime))-import Prelude (Applicative(pure), Either(Left, Right), Enum(toEnum),-  Maybe(Just, Nothing), Traversable(traverse), ($), (.), Eq, IO, Int,-  Show, String, realToFrac)+import Prelude  import Test.Hspec (describe, hspec, it, shouldBe) import qualified Data.Aeson as A @@ -202,8 +200,8 @@             expected = "{\"children\":[{\"children\":[{\"children\":[],\"label\":\"child1\"},{\"children\":[],\"label\":\"child2\"}],\"label\":\"parent\"}],\"label\":\"grandparent\"}"           in             actual `shouldBe` expected-           +       describe "nullable" $ do         it "encodes product" $           let@@ -234,6 +232,46 @@         in           actual `shouldBe` expected +      it "eitherDecode" $+        let+          actual+            :: Either+                 String+                 (Field "foo" Text,+                 (Field "bar" Scientific,+                 (Field "baz"+                   (Field "foo" Text,+                   (Field "bar" Int,+                   ())),+                 (Field "qux" (Maybe Int),+                 ()))))+          actual =+            A.eitherDecode+              "{\"bar\":1,\"baz\":{\"bar\":0,\"foo\":\"foo2\"},\"foo\":\"foo\",\"qux\":null}"+              >>= eitherDecode (Proxy @(EncodingSpec TestObj))+          expected+            :: Either+               String+               (Field "foo" Text,+               (Field "bar" Scientific,+               (Field "baz"+                 (Field "foo" Text,+                 (Field "bar" Int,+                 ())),+               (Field "qux" (Maybe Int),+               ()))))+          expected =+            Right+              (Field @"foo" "foo",+              (Field @"bar" 1.0,+              (Field @"baz"+                (Field @"foo" "foo2",+                (Field @"bar" 0,+                ())),+              (Field @"qux" Nothing,+              ()))))+        in+          actual `shouldBe` expected  sampleTestObject :: TestObj sampleTestObject =