aeson-schemas 1.3.4 → 1.3.5

raw patch · 8 files changed

+83/−40 lines, 8 filesdep ~aesondep ~hashabledep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, hashable, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• aeson-schemas.cabal +6/−5
• src/Data/Aeson/Schema/Internal.hs +22/−24
• src/Data/Aeson/Schema/Key.hs +6/−4
• src/Data/Aeson/Schema/Utils/Compat.hs +40/−0
• test/TestUtils/Arbitrary.hs +2/−2
• test/Tests/Object.hs +2/−2
• test/Tests/SchemaQQ/TH.hs +1/−3

@@ -1,5 +1,9 @@ ## Upcoming +## 1.3.5++* Support `aeson-2.0.0.0`+ ## 1.3.4  * Support `template-haskell-2.17.0.0` for GHC 9

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: c3827569da0ed7cd2f7ccd6e6846b6f0607403409198a8340ccc23ec205390aa+-- hash: 7bb36c5076abd002a834f6f14752e8bddacd9773657a3b2bea340068b1194625  name:           aeson-schemas-version:        1.3.4+version:        1.3.5 synopsis:       Easily consume JSON data on-demand with type-safety description:    Parse JSON data easily and safely without defining new data types. Useful                 for deeply nested JSON data, which is difficult to parse using the default@@ -61,6 +61,7 @@       Data.Aeson.Schema.TH       Data.Aeson.Schema.Type       Data.Aeson.Schema.Utils.All+      Data.Aeson.Schema.Utils.Compat       Data.Aeson.Schema.Utils.Invariant       Data.Aeson.Schema.Utils.NameLike       Data.Aeson.Schema.Utils.Sum@@ -76,7 +77,7 @@       src   ghc-options: -Wall   build-depends:-      aeson >=1.1.2.0 && <1.6+      aeson >=1.1.2.0 && <2.1     , base >=4.9 && <5     , first-class-families >=0.3.0.0 && <0.9     , hashable >=1.2.7.0 && <1.4@@ -119,7 +120,7 @@   ghc-options: -Wall   build-depends:       QuickCheck-    , aeson >=1.1.2.0 && <1.6+    , aeson >=1.1.2.0 && <2.1     , aeson-qq     , aeson-schemas     , base >=4.9 && <5@@ -162,7 +163,7 @@       bench   ghc-options: -Wall   build-depends:-      aeson >=1.1.2.0 && <1.6+      aeson >=1.1.2.0 && <2.1     , aeson-schemas     , base >=4.9 && <5     , criterion

@@ -26,21 +26,15 @@ -} module Data.Aeson.Schema.Internal where -import Control.Applicative (Alternative (..))--#if !MIN_VERSION_base(4,13,0)-import Control.Monad.Fail (MonadFail)-#endif+import Control.Applicative (Alternative (..), optional) import Data.Aeson (FromJSON (..), ToJSON (..), Value (..)) import qualified Data.Aeson as Aeson import Data.Aeson.Types (Parser) import Data.Dynamic (Dynamic, fromDynamic, toDyn)-import Data.HashMap.Strict (HashMap, (!))-import qualified Data.HashMap.Strict as HashMap import Data.List (intersperse) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..))-import Data.Text (Text)+import Data.String (fromString) import qualified Data.Text as Text import Data.Typeable (Typeable) import Fcf (type (<=<), type (=<<))@@ -77,9 +71,15 @@   toSchemaV,  ) import Data.Aeson.Schema.Utils.All (All (..))+import Data.Aeson.Schema.Utils.Compat (Key, KeyMap)+import qualified Data.Aeson.Schema.Utils.Compat as Compat import Data.Aeson.Schema.Utils.Invariant (unreachable) import Data.Aeson.Schema.Utils.Sum (SumType (..)) +#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#endif+ {- Schema-validated JSON object -}  {- | The object containing JSON data and its schema.@@ -88,7 +88,7 @@   > obj = decode "{\"a\": 1}" :: Maybe (Object [schema| { a: Int } |]) -}-newtype Object (schema :: Schema) = UnsafeObject (HashMap Text Dynamic)+newtype Object (schema :: Schema) = UnsafeObject (KeyMap Dynamic)  instance IsSchema schema => Show (Object schema) where   showsPrec _ = showValue @(ToSchemaObject schema)@@ -102,7 +102,7 @@ instance IsSchema schema => ToJSON (Object schema) where   toJSON = toValue @(ToSchemaObject schema) -{- | Convert an 'Object' into a 'HashMap', losing the type information in the schema.+{- | Convert an 'Object' into a 'Aeson.Object', losing the type information in the schema.   @since 1.3.0 -}@@ -161,8 +161,8 @@  -- | A type-class for types that can be parsed from JSON for an associated schema type. class IsSchemaType schema => HasSchemaResult (schema :: SchemaType) where-  parseValue :: [Text] -> Value -> Parser (SchemaResult schema)-  default parseValue :: FromJSON (SchemaResult schema) => [Text] -> Value -> Parser (SchemaResult schema)+  parseValue :: [Key] -> Value -> Parser (SchemaResult schema)+  default parseValue :: FromJSON (SchemaResult schema) => [Key] -> Value -> Parser (SchemaResult schema)   parseValue path value = parseJSON value <|> parseFail @schema path value    toValue :: SchemaResult schema -> Value@@ -183,9 +183,7 @@     value -> (Just <$> parseValue @inner path value)  instance (HasSchemaResult inner, Show (SchemaResult inner), ToJSON (SchemaResult inner)) => HasSchemaResult ( 'SchemaTry inner) where-  parseValue path = wrapTry . parseValue @inner path-    where-      wrapTry parser = (Just <$> parser) <|> pure Nothing+  parseValue path = optional . parseValue @inner path  instance (HasSchemaResult inner, Show (SchemaResult inner), ToJSON (SchemaResult inner)) => HasSchemaResult ( 'SchemaList inner) where   parseValue path = \case@@ -205,7 +203,7 @@   parseValue path value = parseSumType @schemas path value <|> parseFail @( 'SchemaUnion schemas) path value  class ParseSumType xs where-  parseSumType :: [Text] -> Value -> Parser (SumType (SchemaResultList xs))+  parseSumType :: [Key] -> Value -> Parser (SumType (SchemaResultList xs))  instance ParseSumType '[] where   parseSumType _ _ = empty@@ -218,10 +216,10 @@  instance (All HasSchemaResultPair pairs, IsSchemaObjectMap pairs) => HasSchemaResult ( 'SchemaObject pairs) where   parseValue path = \case-    Aeson.Object o -> UnsafeObject . HashMap.fromList <$> parseValueMap o+    Aeson.Object o -> UnsafeObject . Compat.fromList <$> parseValueMap o     value -> parseFail @( 'SchemaObject pairs) path value     where-      parseValueMap :: Aeson.Object -> Parser [(Text, Dynamic)]+      parseValueMap :: Aeson.Object -> Parser [(Key, Dynamic)]       parseValueMap o = sequence $ mapAll @HasSchemaResultPair @pairs $ \proxy -> parseValuePair proxy path o    toValue = Aeson.Object . toValueMap@@ -239,10 +237,10 @@       concatShowS = foldr (.) id  toValueMap :: forall pairs. All HasSchemaResultPair pairs => Object ( 'Schema pairs) -> Aeson.Object-toValueMap o = HashMap.unions $ mapAll @HasSchemaResultPair @pairs (\proxy -> toValuePair proxy o)+toValueMap o = Compat.unions $ mapAll @HasSchemaResultPair @pairs (\proxy -> toValuePair proxy o)  class HasSchemaResultPair (a :: (SchemaKey, SchemaType)) where-  parseValuePair :: Proxy a -> [Text] -> Aeson.Object -> Parser (Text, Dynamic)+  parseValuePair :: Proxy a -> [Key] -> Aeson.Object -> Parser (Key, Dynamic)   toValuePair :: Proxy a -> Object schema -> Aeson.Object   showValuePair :: Proxy a -> Object schema -> (String, ShowS) @@ -258,7 +256,7 @@     return (key, toDyn inner)     where       schemaKey = toSchemaKeyV $ Proxy @key-      key = Text.pack $ fromSchemaKeyV schemaKey+      key = fromString $ fromSchemaKeyV schemaKey    toValuePair _ o = toContext schemaKey (toValue @inner val)     where@@ -275,14 +273,14 @@   showValue = showValue @(ToSchemaObject schema)  -- | A helper for creating fail messages when parsing a schema.-parseFail :: forall (schema :: SchemaType) m a. (MonadFail m, HasSchemaResult schema) => [Text] -> Value -> m a+parseFail :: forall (schema :: SchemaType) m a. (MonadFail m, HasSchemaResult schema) => [Key] -> Value -> m a parseFail path value = fail $ msg ++ ": " ++ ellipses 200 (show value)   where     msg =       if null path         then "Could not parse schema " ++ schema'         else "Could not parse path '" ++ path' ++ "' with schema " ++ schema'-    path' = Text.unpack . Text.intercalate "." $ reverse path+    path' = Text.unpack . Text.intercalate "." . map Compat.keyToText $ reverse path     schema' = "`" ++ showSchemaType @schema ++ "`"     ellipses n s = if length s > n then take n s ++ "..." else s @@ -350,6 +348,6 @@   SchemaResult endSchema unsafeGetKey keyProxy (UnsafeObject object) =   fromMaybe (unreachable $ "Could not load key: " ++ key) $-    fromDynamic (object ! Text.pack key)+    fromDynamic =<< Compat.lookup (fromString key) object   where     key = symbolVal keyProxy

@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-}@@ -31,14 +32,15 @@ ) where  import qualified Data.Aeson as Aeson-import qualified Data.HashMap.Strict as HashMap import Data.Hashable (Hashable)+import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..))-import qualified Data.Text as Text+import Data.String (fromString) import GHC.Generics (Generic) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Language.Haskell.TH.Syntax (Lift) +import qualified Data.Aeson.Schema.Utils.Compat as Compat import Data.Aeson.Schema.Utils.Invariant (unreachable)  -- | A key in a JSON object schema.@@ -66,7 +68,7 @@ getContext :: SchemaKeyV -> Aeson.Object -> Aeson.Value getContext = \case   -- `innerSchema` should parse `val1`-  NormalKey key -> HashMap.lookupDefault Aeson.Null (Text.pack key)+  NormalKey key -> fromMaybe Aeson.Null . Compat.lookup (fromString key)   -- `innerSchema` should parse the same object that `key` is in   PhantomKey _ -> Aeson.Object @@ -76,7 +78,7 @@ toContext :: SchemaKeyV -> Aeson.Value -> Aeson.Object toContext = \case   -- `val` should be inserted with key `key`-  NormalKey key -> HashMap.singleton (Text.pack key)+  NormalKey key -> Compat.singleton (fromString key)   -- If `val` is an object, it should be merged with the outer JSON object   PhantomKey _ -> \case     Aeson.Object o -> o

@@ -0,0 +1,40 @@+{-# LANGUAGE CPP #-}++module Data.Aeson.Schema.Utils.Compat (+  -- * Key+  Key,+  keyToText,++  -- * KeyMap+  KeyMap,+  KeyMap.singleton,+  KeyMap.fromList,+  KeyMap.lookup,+  unions,+) where++import Data.List (foldl')+import Data.Text (Text)+import Prelude hiding (lookup)++#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.Key (Key)+import qualified Data.Aeson.Key as Key+import Data.Aeson.KeyMap (KeyMap)+import qualified Data.Aeson.KeyMap as KeyMap++keyToText :: Key -> Text+keyToText = Key.toText+#else+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as KeyMap++type Key = Text+type KeyMap = HashMap Key++keyToText :: Key -> Text+keyToText = id+#endif++unions :: [KeyMap v] -> KeyMap v+unions = foldl' KeyMap.union KeyMap.empty

@@ -25,7 +25,6 @@ import Control.Monad (forM) import Data.Aeson (ToJSON (..), Value (..), encode) import qualified Data.Aeson as Aeson-import qualified Data.HashMap.Strict as HashMap import Data.List (nub) import Data.Proxy (Proxy (..)) import Data.Text (Text)@@ -58,6 +57,7 @@   toSchemaObjectV,  ) import Data.Aeson.Schema.Utils.All (All (..))+import qualified Data.Aeson.Schema.Utils.Compat as Compat import Data.Aeson.Schema.Utils.NameLike (NameLike (..), fromName)  data ArbitraryObject where@@ -232,7 +232,7 @@       genSchemaElem _ = genSchema @schema  instance All ArbitraryObjectPair pairs => ArbitrarySchema ( 'SchemaObject (pairs :: [(SchemaKey, SchemaType)])) where-  genSchema = Object . HashMap.unions <$> genSchemaPairs+  genSchema = Object . Compat.unions <$> genSchemaPairs     where       genSchemaPairs :: Gen [Aeson.Object]       genSchemaPairs = sequence $ mapAll @ArbitraryObjectPair @pairs genSchemaPair

@@ -6,11 +6,11 @@  import Data.Aeson (Value (..)) import Data.Aeson.QQ (aesonQQ)-import qualified Data.HashMap.Lazy as HashMap import Test.Tasty import Test.Tasty.HUnit  import Data.Aeson.Schema (Object, schema, toMap)+import qualified Data.Aeson.Schema.Utils.Compat as Compat import TestUtils (parseValue) import qualified Tests.Object.Eq import qualified Tests.Object.FromJSON@@ -29,7 +29,7 @@         let o :: Object [schema| { a: Bool } |]             o = parseValue [aesonQQ| { "a": true } |]          in toMap o-              @?= HashMap.fromList+              @?= Compat.fromList                 [ ("a", Bool True)                 ]     ]

@@ -11,7 +11,6 @@ import Control.DeepSeq (deepseq) import Data.Aeson (FromJSON, ToJSON) import Foreign.C (CBool (..))-import Language.Haskell.TH (appTypeE) import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.TestUtils (   MockedMode (..),@@ -81,8 +80,7 @@ schemaRep :: QuasiQuoter schemaRep = mkExpQQ $ \s ->   let schemaType = quoteType schema s-      showSchemaQ = appTypeE [|showSchema|] schemaType-   in [|runTestQ qState (quoteType schema s) `deepseq` $showSchemaQ|]+   in [|runTestQ qState (quoteType schema s) `deepseq` showSchema @($schemaType)|]  schemaErr :: QuasiQuoter schemaErr = mkExpQQ $ \s -> [|runTestQErr qState (quoteType schema s)|]