aeson-schemas 1.3.5.1 → 1.4.0.0
raw patch · 19 files changed
+151/−130 lines, 19 filesdep +filepathdep +processdep +temporarydep ~basedep ~megaparsecdep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependencies added: filepath, process, temporary
Dependency ranges changed: base, megaparsec, template-haskell
API changes (from Hackage documentation)
- Data.Aeson.Schema.Key: type family FromSchemaKey key :: Symbol;
+ Data.Aeson.Schema.Key: type FromSchemaKey key :: Symbol;
Files
- CHANGELOG.md +17/−14
- README.md +3/−3
- aeson-schemas.cabal +22/−17
- bench/Utils/DeepSeq.hs +1/−7
- examples/input.json +47/−0
- src/Data/Aeson/Schema/Internal.hs +0/−5
- src/Data/Aeson/Schema/Key.hs +0/−1
- src/Data/Aeson/Schema/TH/Getter.hs +2/−1
- src/Data/Aeson/Schema/TH/Parse.hs +1/−17
- src/Data/Aeson/Schema/TH/Schema.hs +2/−1
- src/Data/Aeson/Schema/TH/Utils.hs +8/−14
- src/Data/Aeson/Schema/Utils/NameLike.hs +1/−1
- test/Main.hs +2/−0
- test/TestUtils.hs +1/−26
- test/TestUtils/Arbitrary.hs +4/−13
- test/TestUtils/DeepSeq.hs +1/−7
- test/Tests/GetQQ.hs +2/−1
- test/Tests/MkGetter.hs +2/−2
- test/Tests/Quickstart.hs +35/−0
CHANGELOG.md view
@@ -1,34 +1,37 @@-## Upcoming+# v1.4.0.0 -## 1.3.5.1+* Drop support for GHC < 8.10+* Drop support for megaparsec < 7 +# v1.3.5.1+ * Fix benchmarks for `aeson-2` -## 1.3.5+# v1.3.5 * Support `aeson-2.0.0.0` -## 1.3.4+# v1.3.4 * Support `template-haskell-2.17.0.0` for GHC 9 -## 1.3.3+# v1.3.3 * Fix test failure in newer Stack snapshots -## 1.3.2+# v1.3.2 Performance: * Optimized including other schemas in a schema, which previously caused a huge slowdown, and possibly even out-of-memory errors. -## 1.3.1+# v1.3.1 Bug fixes: * Update extra-source-files with files needed for testing -## 1.3.0+# v1.3.0 Breaking changes: @@ -66,33 +69,33 @@ * The `Show` instance for objects added some whitespace, from `{"foo": 0}` to `{ "foo": 0 }` -## 1.2.0+# v1.2.0 New features: * Add support for phantom keys * Add support for `Try` schemas -## 1.1.0+# v1.1.0 New features: * Added support for unions * Added `ToJSON` instance for enums generated with `mkEnum` -## 1.0.3+# v1.0.3 Support GHC 8.8 -## 1.0.2+# v1.0.2 Bundle test data files in release tarball -## 1.0.1+# v1.0.1 Add support with `first-class-families-0.6.0.0` -## 1.0.0+# v1.0.0 Initial release:
README.md view
@@ -1,8 +1,8 @@ # aeson-schemas ---[](https://codecov.io/gh/LeapYear/aeson-schemas)+[](https://github.com/LeapYear/aeson-schemas/actions?query=branch%3Amain)+[](https://codecov.io/gh/LeapYear/aeson-schemas)+[](https://hackage.haskell.org/package/aeson-schemas) A library that extracts information from JSON input using type-level schemas and quasiquoters, consuming JSON data in a type-safe manner. Better than
aeson-schemas.cabal view
@@ -1,11 +1,11 @@ cabal-version: >= 1.10 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack name: aeson-schemas-version: 1.3.5.1+version: 1.4.0.0 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@@ -21,6 +21,7 @@ extra-source-files: README.md CHANGELOG.md+ examples/input.json test/goldens/fromjson_error_messages_truncate.golden test/goldens/fromjson_list_inner_invalid.golden test/goldens/fromjson_list_invalid.golden@@ -75,19 +76,19 @@ src ghc-options: -Wall build-depends:- aeson >=1.1.2.0 && <2.1- , base >=4.9 && <5+ aeson >=1.1.2.0 && <3+ , base >=4.14 && <5 , first-class-families >=0.3.0.0 && <0.9 , hashable >=1.2.7.0 && <1.5- , megaparsec >=6.0.0 && <10- , template-haskell >=2.12.0.0 && <2.19+ , megaparsec >=7 && <10+ , template-haskell >=2.16 && <2.19 , text >=1.2.2.2 && <1.3 , unordered-containers >=0.2.8.0 && <0.3+ default-language: Haskell2010 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances- default-language: Haskell2010 test-suite aeson-schemas-test type: exitcode-stdio-1.0@@ -104,6 +105,7 @@ Tests.Object.Show Tests.Object.Show.TH Tests.Object.ToJSON+ Tests.Quickstart Tests.SchemaQQ Tests.SchemaQQ.TH Tests.SumType@@ -118,31 +120,34 @@ ghc-options: -Wall build-depends: QuickCheck- , aeson >=1.1.2.0 && <2.1+ , aeson >=1.1.2.0 && <3 , aeson-qq , aeson-schemas- , base >=4.9 && <5+ , base >=4.14 && <5 , deepseq+ , filepath , first-class-families >=0.3.0.0 && <0.9 , hashable >=1.2.7.0 && <1.5 , hint , interpolate- , megaparsec >=6.0.0 && <10+ , megaparsec >=7 && <10+ , process , raw-strings-qq , tasty , tasty-golden , tasty-hunit , tasty-quickcheck- , template-haskell >=2.12.0.0 && <2.19+ , template-haskell >=2.16 && <2.19+ , temporary , text >=1.2.2.2 && <1.3 , th-orphans , th-test-utils , unordered-containers >=0.2.8.0 && <0.3+ default-language: Haskell2010 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances- default-language: Haskell2010 benchmark aeson-schemas-bench type: exitcode-stdio-1.0@@ -161,20 +166,20 @@ bench ghc-options: -Wall build-depends:- aeson >=1.1.2.0 && <2.1+ aeson >=1.1.2.0 && <3 , aeson-schemas- , base >=4.9 && <5+ , base >=4.14 && <5 , criterion , deepseq , first-class-families >=0.3.0.0 && <0.9 , hashable >=1.2.7.0 && <1.5- , megaparsec >=6.0.0 && <10- , template-haskell >=2.12.0.0 && <2.19+ , megaparsec >=7 && <10+ , template-haskell >=2.16 && <2.19 , text >=1.2.2.2 && <1.3 , th-test-utils , unordered-containers >=0.2.8.0 && <0.3+ default-language: Haskell2010 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances- default-language: Haskell2010
bench/Utils/DeepSeq.hs view
@@ -3,12 +3,8 @@ module Utils.DeepSeq () where -import Control.DeepSeq (NFData (..))--#if MIN_VERSION_template_haskell(2,16,0)-import Control.DeepSeq (rwhnf)+import Control.DeepSeq (NFData (..), rwhnf) import GHC.ForeignPtr (ForeignPtr)-#endif import Language.Haskell.TH.Syntax instance NFData AnnTarget@@ -66,9 +62,7 @@ instance NFData TyVarBndr #endif -#if MIN_VERSION_template_haskell(2,16,0) instance NFData Bytes instance NFData (ForeignPtr a) where rnf = rwhnf-#endif
+ examples/input.json view
@@ -0,0 +1,47 @@+{+ "users": [+ {+ "id": 1,+ "name": "Alice",+ "age": 30,+ "enabled": true,+ "groups": [+ {+ "id": 1,+ "name": "admin"+ }+ ]+ },+ {+ "id": 2,+ "name": "Bob",+ "age": null,+ "enabled": false,+ "groups": null+ },+ {+ "id": 3,+ "name": "Charlie",+ "age": 25,+ "enabled": true,+ "groups": [+ ]+ },+ {+ "id": 4,+ "name": "Darlene",+ "age": 40,+ "enabled": true,+ "groups": [+ {+ "id": 2,+ "name": "groupA"+ },+ {+ "id": 3,+ "name": "groupB"+ }+ ]+ }+ ]+}
src/Data/Aeson/Schema/Internal.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}@@ -75,10 +74,6 @@ 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 -}
src/Data/Aeson/Schema/Key.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-}
src/Data/Aeson/Schema/TH/Getter.hs view
@@ -83,7 +83,8 @@ mkGetter unwrapName funcName startSchemaName ops = do getterExp@GetterExp{..} <- parseGetterExp ops unless (isNothing start) $- fail $ "Getter expression should start with '.': " ++ ops+ fail $+ "Getter expression should start with '.': " ++ ops startSchema <- lookupSchema (NameTH startSchemaName) >>= loadSchema
src/Data/Aeson/Schema/TH/Parse.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE RecordWildCards #-} @@ -14,9 +13,6 @@ import Control.Monad (MonadPlus, void) -#if !MIN_VERSION_base(4,13,0)-import Control.Monad.Fail (MonadFail)-#endif import Data.Functor (($>)) import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty)@@ -29,11 +25,6 @@ type Parser = Parsec Void String -#if !MIN_VERSION_megaparsec(7,0,0)-errorBundlePretty :: (Ord t, ShowToken t, ShowErrorComponent e) => ParseError t e -> String-errorBundlePretty = parseErrorPretty-#endif- runParserFail :: MonadFail m => Parser a -> String -> m a runParserFail parser s = either (fail . errorBundlePretty) return $ runParser parser s s @@ -214,7 +205,7 @@ fmap NonEmpty.toList $ some $ choice- [ try $ char '\\' *> anySingle'+ [ try $ char '\\' *> anySingle , noneOf $ [' ', '\\', '"'] ++ schemaChars ++ getChars ] where@@ -222,13 +213,6 @@ getChars = "!?[](),.@" -- characters that should not indicate the start of a key when parsing 'schema' definitions schemaChars = ":{}#"--anySingle' :: Parser Char-#if MIN_VERSION_megaparsec(7,0,0)-anySingle' = anySingle-#else-anySingle' = anyChar-#endif {- Parsing utilities -}
src/Data/Aeson/Schema/TH/Schema.hs view
@@ -140,7 +140,8 @@ case schemaKey of PhantomKey _ -> unless (isValidPhantomSchema schemaType) $- fail $ "Invalid schema for '" ++ fromSchemaKeyV schemaKey ++ "': " ++ showSchemaTypeV schemaType+ fail $+ "Invalid schema for '" ++ fromSchemaKeyV schemaKey ++ "': " ++ showSchemaTypeV schemaType _ -> return () return ([(schemaKey, schemaType)], Provided)
src/Data/Aeson/Schema/TH/Utils.hs view
@@ -69,14 +69,14 @@ TyConI (TySynD _ _ (stripKinds -> ty)) -- `type MySchema = 'Schema '[ ... ]` | isPromotedSchema ty ->- return ty+ return ty -- `type MySchema = Object ('Schema '[ ... ])` | Just inner <- unwrapObject ty- , isPromotedSchema inner ->- return inner+ , isPromotedSchema inner ->+ return inner -- `type MySchema = Object OtherSchema` | Just (ConT schemaName') <- unwrapObject ty ->- reifySchemaType schemaName'+ reifySchemaType schemaName' _ -> fail $ "'" ++ show schemaName ++ "' is not a Schema" -- If the given type is of the format `Object a`, return `a`.@@ -131,13 +131,13 @@ | name == 'SchemaTry -> SchemaTry <$> parseSchemaType inner | name == 'SchemaList -> SchemaList <$> parseSchemaType inner | name == 'SchemaUnion -> do- schemas <- typeToList inner- SchemaUnion <$> mapM parseSchemaType schemas+ schemas <- typeToList inner+ SchemaUnion <$> mapM parseSchemaType schemas | name == 'SchemaObject -> SchemaObject <$> parseSchemaObjectMap inner AppT (PromotedT name) (AppT (PromotedT right) (ConT inner)) | name == 'SchemaInclude- , right == 'Right ->- return $ SchemaInclude $ Left $ NameTH inner+ , right == 'Right ->+ return $ SchemaInclude $ Left $ NameTH inner _ -> empty -- | Resolve SchemaInclude, if present. (Not recursive)@@ -191,22 +191,16 @@ case ty of -- cases that strip + recurse SigT ty1 _ -> stripKinds ty1-#if MIN_VERSION_template_haskell(2,15,0) AppKindT ty1 _ -> stripKinds ty1-#endif -- cases that recurse ForallT tyVars ctx ty1 -> ForallT tyVars ctx (stripKinds ty1)-#if MIN_VERSION_template_haskell(2,16,0) ForallVisT tyVars ty1 -> ForallVisT tyVars (stripKinds ty1)-#endif AppT ty1 ty2 -> AppT (stripKinds ty1) (stripKinds ty2) InfixT ty1 name ty2 -> InfixT (stripKinds ty1) name (stripKinds ty2) UInfixT ty1 name ty2 -> UInfixT (stripKinds ty1) name (stripKinds ty2) ParensT ty1 -> ParensT (stripKinds ty1)-#if MIN_VERSION_template_haskell(2,15,0) ImplicitParamT str ty1 -> ImplicitParamT str (stripKinds ty1)-#endif -- base cases VarT _ -> ty
src/Data/Aeson/Schema/Utils/NameLike.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskellQuotes #-} module Data.Aeson.Schema.Utils.NameLike ( NameLike (..),
test/Main.hs view
@@ -4,6 +4,7 @@ import qualified Tests.GetQQ import qualified Tests.MkGetter import qualified Tests.Object+import qualified Tests.Quickstart import qualified Tests.SchemaQQ import qualified Tests.SumType import qualified Tests.UnwrapQQ@@ -20,4 +21,5 @@ , Tests.MkGetter.test , Tests.EnumTH.test , Tests.SumType.test+ , Tests.Quickstart.test ]
test/TestUtils.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -25,9 +24,6 @@ import Data.Aeson (FromJSON (..), Value, eitherDecode) import Data.Aeson.Types (parseEither) -#if !MIN_VERSION_megaparsec(7,0,0)-import Data.Char (isDigit, isSpace)-#endif import Data.Proxy (Proxy (..)) import Data.String (fromString) import qualified Data.Text as Text@@ -100,7 +96,7 @@ testParseError name fp s = goldenTest name getExpected getActual cmp update where goldenFile = "test/goldens/" ++ fp- getExpected = sanitize <$> Text.readFile goldenFile+ getExpected = Text.readFile goldenFile getActual = return $ Text.pack s cmp expected actual = return $@@ -108,24 +104,3 @@ then Nothing else Just $ "Test output was different from '" ++ goldenFile ++ "'. It was:\n" ++ Text.unpack actual update = Text.writeFile goldenFile--#if MIN_VERSION_megaparsec(7,0,0)- sanitize = id-#else- -- megaparsec before version 7.0.0 doesn't display the offending lines, so we need to strip- -- out those lines from the golden before comparing them.- --- -- e.g.- --- -- { "a:b": Int } :1:6:- -- > |- -- > 1 | { "a:b": Int }- -- > | ^- -- unexpected ':'- -- expecting '"' or '\'- sanitize = Text.unlines . filter (not . isOffendingLine) . Text.lines-- isOffendingLine line = case Text.splitOn "|" line of- [prefix, _] -> Text.all (\c -> isDigit c || isSpace c) prefix- _ -> False-#endif
test/TestUtils/Arbitrary.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -105,10 +104,10 @@ forAllArbitraryObjects' :: Gen ArbitraryObject -> (ArbitraryObject -> Property) -> Property forAllArbitraryObjects' genArbitraryObject runTest = forAll @_ @Property genArbitraryObject $ \o@(ArbitraryObject _ _ schemaType) ->- tabulate' "Key types" (map getKeyType $ getKeys schemaType) $- tabulate' "Schema types" (getSchemaTypes schemaType) $- tabulate' "Object sizes" (map show $ getObjectSizes schemaType) $- tabulate' "Object depth" [show $ getObjectDepth schemaType] $+ tabulate "Key types" (map getKeyType $ getKeys schemaType) $+ tabulate "Schema types" (getSchemaTypes schemaType) $+ tabulate "Object sizes" (map show $ getObjectSizes schemaType) $+ tabulate "Object depth" [show $ getObjectDepth schemaType] $ runTest o {- Run time helpers -}@@ -180,14 +179,6 @@ SchemaUnion schemas -> maximum $ map getObjectDepth' schemas SchemaObject pairs -> 1 + maximum (map (getObjectDepth' . snd) pairs) SchemaInclude _ -> error "ArbitraryObject unexpectedly generated a schema that includes another schema"--tabulate' :: String -> [String] -> Property -> Property--#if MIN_VERSION_QuickCheck(2,12,0)-tabulate' = tabulate-#else-tabulate' _ _ = id-#endif {- Generating schemas -}
test/TestUtils/DeepSeq.hs view
@@ -3,12 +3,8 @@ module TestUtils.DeepSeq () where -import Control.DeepSeq (NFData (..))--#if MIN_VERSION_template_haskell(2,16,0)-import Control.DeepSeq (rwhnf)+import Control.DeepSeq (NFData (..), rwhnf) import GHC.ForeignPtr (ForeignPtr)-#endif import Language.Haskell.TH.Syntax instance NFData AnnTarget@@ -66,9 +62,7 @@ instance NFData TyVarBndr #endif -#if MIN_VERSION_template_haskell(2,16,0) instance NFData Bytes instance NFData (ForeignPtr a) where rnf = rwhnf-#endif
test/Tests/GetQQ.hs view
@@ -217,7 +217,8 @@ testGroup "fromJust errors" [ testCase "Plain fromJust" $- assertError "Called 'fromJust' on null expression" $ [runGet| ! |] (Nothing :: Maybe Int)+ assertError "Called 'fromJust' on null expression" $+ [runGet| ! |] (Nothing :: Maybe Int) , testCase "With start" $ do let o = $(parseObject "{ foo: Maybe Bool }") [aesonQQ| { "foo": null } |] assertError
test/Tests/MkGetter.hs view
@@ -31,8 +31,8 @@ test :: TestTree test =- runMkGetterQ- `deepseq` testGroup+ runMkGetterQ `deepseq`+ testGroup "`mkGetter` helper" [ testCase "Type synonym is generated" $ showSchemaResult @User @?= [r|Object (SchemaObject { "name": Text })|]
+ test/Tests/Quickstart.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module Tests.Quickstart (test) where++import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readProcess)+import Test.Tasty (TestTree)++import TestUtils (testGoldenIO)++test :: TestTree+test = testGoldenIO "README Quickstart works" "README_Quickstart.golden" $+ withSystemTempDirectory "readme-quickstart" $ \tmpdir -> do+ let testfile = tmpdir </> "readme_quickstart.hs"+ readme <- Text.readFile "README.md"+ Text.writeFile testfile (getQuickstartCode readme)+ readProcess "runghc" [testfile] ""++getQuickstartCode :: Text -> Text+getQuickstartCode = Text.unlines . getQuickstartLines . Text.lines+ where+ getQuickstartLines readmeLines =+ fromMaybe (error "Could not find Quickstart in README") $+ between (== "## Quickstart") ("## " `Text.isPrefixOf`) readmeLines+ >>= between (== "```haskell") (== "```")++ between start end xs =+ case dropWhile (not . start) xs of+ [] -> Nothing+ _ : afterStart -> Just $ takeWhile (not . end) afterStart