on master help sign in
.gitignore+1
since splitsnapshots
unifiedsplit
@@ -5,6 +5,7 @@ dist-newstyle
5cabal.sandbox.config
5cabal.sandbox.config
6.stack-work/
6.stack-work/
7.stack-work-bench/
7.stack-work-bench/
8+*.yaml.lock
8
9
9*.o
10*.o
10*.hi
11*.hi
.hlint.yaml+6−1
@@ -3,4 +3,9 @@
3 name: "Reduce duplication"
3 name: "Reduce duplication"
4 within:
4 within:
5 - Data.Aeson.Types.ToJSON
5 - Data.Aeson.Types.ToJSON
6+- ignore:
6−- ignore: {name: "Eta reduce" }
7+ name: "Eta reduce"
8+- ignore:
9+ name: "Use newtype instead of data"
10+ within:
11+ - Data.Aeson.Types.Internal
.travis.yml+34−23
@@ -12,47 +12,58 @@ cache:
12 - $HOME/.stack
12 - $HOME/.stack
13 - $HOME/.cabsnap
13 - $HOME/.cabsnap
14 - $HOME/.cabal/packages
14 - $HOME/.cabal/packages
15+ - $HOME/.cabal/store
15
16
16before_cache:
17before_cache:
17 - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
18 - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
18− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
19+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
20+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
21+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
22+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
19
24
20matrix:
25matrix:
21 include:
26 include:
27+
22− - env: BUILD=hlint CABALVER=2.2 GHCVER=8.4.3
28+ - env: BUILD=hlint CABALVER=2.2 GHCVER=8.4.4
23− compiler: ": #GHC 8.4.3"
29+ compiler: ": #GHC 8.4.4"
24− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}
30+ addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.4], sources: [hvr-ghc]}}
31+
25− - env: BUILD=stack CABALVER=2.2 GHCVER=8.4.3 STACK_YAML=stack-bench.yaml
32+ - env: BUILD=stack CABALVER=2.4 GHCVER=8.6.5 STACK_YAML=stack-bench.yaml
26− compiler: ": #GHC 8.4.3"
33+ compiler: ": #GHC 8.6.5"
27− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}
34+ addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.5], sources: [hvr-ghc]}}
35+
28− - env: BUILD=stack CABALVER=2.2 GHCVER=8.4.3 STACK_YAML=stack-ffi-unescape.yaml
36+ - env: BUILD=stack CABALVER=2.2 GHCVER=8.6.5 STACK_YAML=stack-ffi-unescape.yaml
29− compiler: ": #GHC 8.4.3"
37+ compiler: ": #GHC 8.6.5"
30− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}
38+ addons: {apt: {packages: [cabal-install-2.2,ghc-8.6.5], sources: [hvr-ghc]}}
31−
39+
40+ - env: BUILD=cabal2 CABALVER=3.0 GHCVER=8.8.1
41+ compiler: ": #GHC 8.8.1"
42+ addons: {apt: {packages: [cabal-install-3.0,ghc-8.8.1], sources: [hvr-ghc]}}
43+
32− - env: BUILD=cabal CABALVER=2.4 GHCVER=8.6.1
44+ - env: BUILD=cabal CABALVER=2.4 GHCVER=8.6.5
33− compiler: ": #GHC 8.6.1"
45+ compiler: ": #GHC 8.6.5"
34− addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}}
46+ addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.5], sources: [hvr-ghc]}}
47+
35− - env: BUILD=cabal CABALVER=2.2 GHCVER=8.4.3
48+ - env: BUILD=cabal CABALVER=2.2 GHCVER=8.4.4
36− compiler: ": #GHC 8.4.3"
49+ compiler: ": #GHC 8.4.4"
37− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}
50+ addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.4], sources: [hvr-ghc]}}
51+
38 - env: BUILD=cabal CABALVER=2.0 GHCVER=8.2.2
52 - env: BUILD=cabal CABALVER=2.0 GHCVER=8.2.2
39 compiler: ": #GHC 8.2.2"
53 compiler: ": #GHC 8.2.2"
40 addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
54 addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
55+
41 - env: BUILD=cabal CABALVER=2.0 GHCVER=8.0.2
56 - env: BUILD=cabal CABALVER=2.0 GHCVER=8.0.2
42 compiler: ": #GHC 8.0.2"
57 compiler: ": #GHC 8.0.2"
43 addons: {apt: {packages: [cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}
58 addons: {apt: {packages: [cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}
59+
44 - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3
60 - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3
45 compiler: ": #GHC 7.10.3"
61 compiler: ": #GHC 7.10.3"
46 addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
62 addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
63+
47 - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4
64 - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4
48 compiler: ": #GHC 7.8.4"
65 compiler: ": #GHC 7.8.4"
49 addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
66 addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
50− - env: BUILD=cabal CABALVER=1.18 GHCVER=7.6.3
51− compiler: ": #GHC 7.6.3"
52− addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}
53− - env: BUILD=cabal CABALVER=1.18 GHCVER=7.4.2
54− compiler: ": #GHC 7.4.2"
55− addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}}
56
67
57before_install:
68before_install:
58 - unset CC
69 - unset CC
CONTRIBUTING.md+38
@@ -58,3 +58,41 @@ import Foo as F
58import Qux (Q(..), q)
58import Qux (Q(..), q)
59import qualified A
59import qualified A
60```
60```
61+
62+## Development Workflow (If you plan on using Stack)
63+
64+Here we outline a general workflow new contributors could adopt for a nice incremental development experience.
65+
66+The root folder consists of two stack-*.yaml config files.
67+
68+1. stack-nightly.yaml - Config file defines all the settings to build and test any changes.
69+2. stack-bench.yaml - Used to run benchmark tests.
70+3. stack-ffi-unescape.yaml - This is for replacing certain parts with a C-implementation.
71+
72+Therefore, a ghci development experience would be:
73+
74+1. `stack ghci --stack-yaml stack-nightly.yaml --test`
75+2. :r to recompile
76+3. `main` to run all tests, or `:main --pattern Foo` to run specific tests matched by pattern.
77+
78+Some discussion on this topic can also be found here [here](https://github.com/bos/aeson/issues/733)
79+
80+Of course before submitting a PR, the following steps are recommended:
81+
82+1. 'stack test --stack-yaml stack-nightly.yaml` - Run the entire suite of tests
83+2. `make hlint` - Run hlint on the source folders.
84+3. 'stack test --stack-yaml stack-bench.yaml` - Run the benchmark tests if you believe your changes could affect the benchmarks.
85+
86+## Development Workflow (If you plan on using Cabal)
87+
88+A ghci development experience would be:
89+
90+1. `cabal new-repl test:tests`
91+2. `:r` to recompile
92+3. `Main.main` to run all tests, or `:m Main; :main --pattern Foo` to run specific tests matched by pattern.
93+
94+Of course before submitting a PR, the following steps are recommended:
95+
96+1. `cabal new-test` - Run the entire suite of tests
97+2. `make hlint` - Run hlint on the source folders.
98+3. Uncomment the `benchmarks` line in `cabal.project` - Run the benchmark tests if you believe your changes could affect the benchmarks.
Data/Aeson/Compat.hsdeleted−16
@@ -1,16 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−module Data.Aeson.Compat
4− (
5− fromStrict
6− ) where
7−
8−import qualified Data.ByteString as S
9−import qualified Data.ByteString.Lazy as L
10−
11−fromStrict :: S.ByteString -> L.ByteString
12−#if MIN_VERSION_bytestring(0, 9, 2)
13−fromStrict = L.fromChunks . (:[])
14−#else
15−fromStrict = L.fromStrict
16−#endif
Data/Aeson/TH.hs+24−38
@@ -135,22 +135,15 @@ import Data.Map (Map)
135import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
135import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
136import qualified Data.Monoid as Monoid
136import qualified Data.Monoid as Monoid
137import Data.Set (Set)
137import Data.Set (Set)
138−#if MIN_VERSION_template_haskell(2,8,0)
139import Language.Haskell.TH hiding (Arity)
138import Language.Haskell.TH hiding (Arity)
140−#else
141−import Language.Haskell.TH
142−#endif
143import Language.Haskell.TH.Datatype
139import Language.Haskell.TH.Datatype
144−#if MIN_VERSION_template_haskell(2,7,0) && !(MIN_VERSION_template_haskell(2,8,0))
145−import Language.Haskell.TH.Lib (starK)
146−#endif
147#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))
140#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))
148import Language.Haskell.TH.Syntax (mkNameG_tc)
141import Language.Haskell.TH.Syntax (mkNameG_tc)
149#endif
142#endif
150import Text.Printf (printf)
143import Text.Printf (printf)
151import qualified Data.Aeson.Encoding.Internal as E
144import qualified Data.Aeson.Encoding.Internal as E
152import qualified Data.Foldable as F (all)
145import qualified Data.Foldable as F (all)
153−import qualified Data.HashMap.Strict as H (lookup, toList)
146+import qualified Data.HashMap.Strict as H (difference, fromList, keys, lookup, toList)
154import qualified Data.List.NonEmpty as NE (length, reverse)
147import qualified Data.List.NonEmpty as NE (length, reverse)
155import qualified Data.Map as M (fromList, keys, lookup , singleton, size)
148import qualified Data.Map as M (fromList, keys, lookup , singleton, size)
156import qualified Data.Semigroup as Semigroup (Option(..))
149import qualified Data.Semigroup as Semigroup (Option(..))
@@ -929,12 +922,32 @@ parseRecord :: JSONClass
929 -> Name
922 -> Name
930 -> [Name]
923 -> [Name]
931 -> Name
924 -> Name
925+ -> Bool
932 -> ExpQ
926 -> ExpQ
933−parseRecord jc tvMap argTys opts tName conName fields obj =
927+parseRecord jc tvMap argTys opts tName conName fields obj inTaggedObject =
928+ (if rejectUnknownFields opts
929+ then infixApp checkUnknownRecords [|(>>)|]
930+ else id) $
934 foldl' (\a b -> infixApp a [|(<*>)|] b)
931 foldl' (\a b -> infixApp a [|(<*>)|] b)
935 (infixApp (conE conName) [|(<$>)|] x)
932 (infixApp (conE conName) [|(<$>)|] x)
936 xs
933 xs
937 where
934 where
935+ tagFieldNameAppender =
936+ if inTaggedObject then (tagFieldName (sumEncoding opts) :) else id
937+ knownFields = appE [|H.fromList|] $ listE $
938+ map (\knownName -> tupE [appE [|T.pack|] $ litE $ stringL knownName, [|()|]]) $
939+ tagFieldNameAppender $ map nameBase fields
940+ checkUnknownRecords =
941+ caseE (appE [|H.keys|] $ infixApp (varE obj) [|H.difference|] knownFields)
942+ [ match (listP []) (normalB [|return ()|]) []
943+ , newName "unknownFields" >>=
944+ \unknownFields -> match (varP unknownFields)
945+ (normalB $ appE [|fail|] $ infixApp
946+ (litE (stringL "Unknown fields: "))
947+ [|(++)|]
948+ (appE [|show|] (varE unknownFields)))
949+ []
950+ ]
938 x:xs = [ [|lookupField|]
951 x:xs = [ [|lookupField|]
939 `appE` dispatchParseJSON jc conName tvMap argTy
952 `appE` dispatchParseJSON jc conName tvMap argTy
940 `appE` litE (stringL $ show tName)
953 `appE` litE (stringL $ show tName)
@@ -1009,7 +1022,7 @@ parseArgs jc tvMap tName opts
1009 , constructorFields = argTys }
1022 , constructorFields = argTys }
1010 (Left (_, obj)) = do
1023 (Left (_, obj)) = do
1011 argTys' <- mapM resolveTypeSynonyms argTys
1024 argTys' <- mapM resolveTypeSynonyms argTys
1012− parseRecord jc tvMap argTys' opts tName conName fields obj
1025+ parseRecord jc tvMap argTys' opts tName conName fields obj True
1013parseArgs jc tvMap tName opts
1026parseArgs jc tvMap tName opts
1014 info@ConstructorInfo { constructorName = conName
1027 info@ConstructorInfo { constructorName = conName
1015 , constructorVariant = RecordConstructor fields
1028 , constructorVariant = RecordConstructor fields
@@ -1024,7 +1037,7 @@ parseArgs jc tvMap tName opts
1024 argTys' <- mapM resolveTypeSynonyms argTys
1037 argTys' <- mapM resolveTypeSynonyms argTys
1025 caseE (varE valName)
1038 caseE (varE valName)
1026 [ match (conP 'Object [varP obj]) (normalB $
1039 [ match (conP 'Object [varP obj]) (normalB $
1027− parseRecord jc tvMap argTys' opts tName conName fields obj) []
1040+ parseRecord jc tvMap argTys' opts tName conName fields obj False) []
1028 , matchFailed tName conName "Object"
1041 , matchFailed tName conName "Object"
1029 ]
1042 ]
1030
1043
@@ -1590,21 +1603,13 @@ type TyVarMap = Map Name (Name, Name)
1590-- | Returns True if a Type has kind *.
1603-- | Returns True if a Type has kind *.
1591hasKindStar :: Type -> Bool
1604hasKindStar :: Type -> Bool
1592hasKindStar VarT{} = True
1605hasKindStar VarT{} = True
1593−#if MIN_VERSION_template_haskell(2,8,0)
1594hasKindStar (SigT _ StarT) = True
1606hasKindStar (SigT _ StarT) = True
1595−#else
1596−hasKindStar (SigT _ StarK) = True
1597−#endif
1598hasKindStar _ = False
1607hasKindStar _ = False
1599
1608
1600-- Returns True is a kind is equal to *, or if it is a kind variable.
1609-- Returns True is a kind is equal to *, or if it is a kind variable.
1601isStarOrVar :: Kind -> Bool
1610isStarOrVar :: Kind -> Bool
1602−#if MIN_VERSION_template_haskell(2,8,0)
1603isStarOrVar StarT = True
1611isStarOrVar StarT = True
1604isStarOrVar VarT{} = True
1612isStarOrVar VarT{} = True
1605−#else
1606−isStarOrVar StarK = True
1607−#endif
1608isStarOrVar _ = False
1613isStarOrVar _ = False
1609
1614
1610-- Generate a list of fresh names with a common prefix, and numbered suffixes.
1615-- Generate a list of fresh names with a common prefix, and numbered suffixes.
@@ -1662,9 +1667,7 @@ isTyFamily (ConT n) = do
1662#else
1667#else
1663 FamilyI (FamilyD TypeFam _ _ _) _ -> True
1668 FamilyI (FamilyD TypeFam _ _ _) _ -> True
1664#endif
1669#endif
1665−#if MIN_VERSION_template_haskell(2,9,0)
1666 FamilyI ClosedTypeFamilyD{} _ -> True
1670 FamilyI ClosedTypeFamilyD{} _ -> True
1667−#endif
1668 _ -> False
1671 _ -> False
1669isTyFamily _ = return False
1672isTyFamily _ = return False
1670
1673
@@ -1692,9 +1695,7 @@ mentionsName = go
1692 go :: Type -> [Name] -> Bool
1695 go :: Type -> [Name] -> Bool
1693 go (AppT t1 t2) names = go t1 names || go t2 names
1696 go (AppT t1 t2) names = go t1 names || go t2 names
1694 go (SigT t _k) names = go t names
1697 go (SigT t _k) names = go t names
1695−#if MIN_VERSION_template_haskell(2,8,0)
1696 || go _k names
1698 || go _k names
1697−#endif
1698 go (VarT n) names = n `elem` names
1699 go (VarT n) names = n `elem` names
1699 go _ _ = False
1700 go _ _ = False
1700
1701
@@ -1750,23 +1751,14 @@ uncurryTy t = ([], t :| [])
1750
1751
1751-- | Like uncurryType, except on a kind level.
1752-- | Like uncurryType, except on a kind level.
1752uncurryKind :: Kind -> NonEmpty Kind
1753uncurryKind :: Kind -> NonEmpty Kind
1753−#if MIN_VERSION_template_haskell(2,8,0)
1754uncurryKind = snd . uncurryTy
1754uncurryKind = snd . uncurryTy
1755−#else
1756−uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2
1757−uncurryKind k = k :| []
1758−#endif
1759
1755
1760createKindChain :: Int -> Kind
1756createKindChain :: Int -> Kind
1761createKindChain = go starK
1757createKindChain = go starK
1762 where
1758 where
1763 go :: Kind -> Int -> Kind
1759 go :: Kind -> Int -> Kind
1764 go k 0 = k
1760 go k 0 = k
1765−#if MIN_VERSION_template_haskell(2,8,0)
1766 go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)
1761 go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)
1767−#else
1768− go k !n = go (ArrowK StarK k) (n - 1)
1769−#endif
1770
1762
1771-- | Makes a string literal expression from a constructor's name.
1763-- | Makes a string literal expression from a constructor's name.
1772conNameExp :: Options -> ConstructorInfo -> Q Exp
1764conNameExp :: Options -> ConstructorInfo -> Q Exp
@@ -1820,11 +1812,7 @@ canEtaReduce remaining dropped =
1820-------------------------------------------------------------------------------
1812-------------------------------------------------------------------------------
1821
1813
1822applySubstitutionKind :: Map Name Kind -> Type -> Type
1814applySubstitutionKind :: Map Name Kind -> Type -> Type
1823−#if MIN_VERSION_template_haskell(2,8,0)
1824applySubstitutionKind = applySubstitution
1815applySubstitutionKind = applySubstitution
1825−#else
1826−applySubstitutionKind _ t = t
1827−#endif
1828
1816
1829substNameWithKind :: Name -> Kind -> Type -> Type
1817substNameWithKind :: Name -> Kind -> Type -> Type
1830substNameWithKind n k = applySubstitutionKind (M.singleton n k)
1818substNameWithKind n k = applySubstitutionKind (M.singleton n k)
@@ -1988,9 +1976,7 @@ data StarKindStatus = NotKindStar
1988canRealizeKindStar :: Type -> StarKindStatus
1976canRealizeKindStar :: Type -> StarKindStatus
1989canRealizeKindStar t = case t of
1977canRealizeKindStar t = case t of
1990 _ | hasKindStar t -> KindStar
1978 _ | hasKindStar t -> KindStar
1991−#if MIN_VERSION_template_haskell(2,8,0)
1992 SigT _ (VarT k) -> IsKindVar k
1979 SigT _ (VarT k) -> IsKindVar k
1993−#endif
1994 _ -> NotKindStar
1980 _ -> NotKindStar
1995
1981
1996-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
1982-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
Data/Aeson/Types.hs+8
@@ -124,6 +124,7 @@ module Data.Aeson.Types
124 , sumEncoding
124 , sumEncoding
125 , unwrapUnaryRecords
125 , unwrapUnaryRecords
126 , tagSingleConstructors
126 , tagSingleConstructors
127+ , rejectUnknownFields
127
128
128 -- ** Options utilities
129 -- ** Options utilities
129 , SumEncoding(..)
130 , SumEncoding(..)
@@ -136,6 +137,13 @@ module Data.Aeson.Types
136 , JSONKeyOptions
137 , JSONKeyOptions
137 , keyModifier
138 , keyModifier
138 , defaultJSONKeyOptions
139 , defaultJSONKeyOptions
140+
141+ -- * Parsing context
142+ , (<?>)
143+ , JSONPath
144+ , JSONPathElement(..)
145+ , formatPath
146+ , formatRelativePath
139 ) where
147 ) where
140
148
141import Prelude.Compat
149import Prelude.Compat
Data/Aeson/Types/FromJSON.hs+90−67
@@ -5,19 +5,16 @@
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE GADTs #-}
6{-# LANGUAGE GADTs #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE NamedFieldPuns #-}
9{-# LANGUAGE NoImplicitPrelude #-}
8{-# LANGUAGE NoImplicitPrelude #-}
10{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE PolyKinds #-}
11{-# LANGUAGE RecordWildCards #-}
11{-# LANGUAGE RecordWildCards #-}
12{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE TypeOperators #-}
14+{-# LANGUAGE TupleSections #-}
14{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE ViewPatterns #-}
16{-# LANGUAGE ViewPatterns #-}
16
17
17−#if __GLASGOW_HASKELL__ >= 706
18−{-# LANGUAGE PolyKinds #-}
19−#endif
20−
21#include "incoherent-compat.h"
18#include "incoherent-compat.h"
22#include "overlapping-compat.h"
19#include "overlapping-compat.h"
23
20
@@ -121,9 +118,9 @@ import GHC.Generics
121import Numeric.Natural (Natural)
118import Numeric.Natural (Natural)
122import Text.ParserCombinators.ReadP (readP_to_S)
119import Text.ParserCombinators.ReadP (readP_to_S)
123import Unsafe.Coerce (unsafeCoerce)
120import Unsafe.Coerce (unsafeCoerce)
124−import qualified Data.Aeson.Compat as Compat
125import qualified Data.Aeson.Parser.Time as Time
121import qualified Data.Aeson.Parser.Time as Time
126import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
122import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
123+import qualified Data.ByteString.Lazy as L
127import qualified Data.DList as DList
124import qualified Data.DList as DList
128import qualified Data.HashMap.Strict as H
125import qualified Data.HashMap.Strict as H
129import qualified Data.HashSet as HashSet
126import qualified Data.HashSet as HashSet
@@ -158,18 +155,8 @@ import qualified Data.Primitive.UnliftedArray as PM
158import qualified Data.Primitive.PrimArray as PM
155import qualified Data.Primitive.PrimArray as PM
159#endif
156#endif
160
157
161−#ifndef HAS_COERCIBLE
162−#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)
163−#endif
164
158
165−#if HAS_COERCIBLE
166import Data.Coerce (Coercible, coerce)
159import Data.Coerce (Coercible, coerce)
167−coerce' :: Coercible a b => a -> b
168−coerce' = coerce
169−#else
170−coerce' :: a -> b
171−coerce' = unsafeCoerce
172−#endif
173
160
174parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
161parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
175parseIndexedJSON p idx value = p value <?> Index idx
162parseIndexedJSON p idx value = p value <?> Index idx
@@ -441,11 +428,7 @@ class FromJSONKey a where
441-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'
428-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'
442-- can be inspected, but cannot be constructed.
429-- can be inspected, but cannot be constructed.
443data CoerceText a where
430data CoerceText a where
444−#if HAS_COERCIBLE
445 CoerceText :: Coercible Text a => CoerceText a
431 CoerceText :: Coercible Text a => CoerceText a
446−#else
447− CoerceText :: CoerceText a
448−#endif
449
432
450-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the
433-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the
451-- 'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'
434-- 'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'
@@ -465,7 +448,7 @@ data FromJSONKeyFunction a
465
448
466-- | Only law abiding up to interpretation
449-- | Only law abiding up to interpretation
467instance Functor FromJSONKeyFunction where
450instance Functor FromJSONKeyFunction where
468− fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce')
451+ fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce)
469 fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)
452 fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)
470 fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)
453 fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)
471 fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)
454 fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)
@@ -479,9 +462,7 @@ instance Functor FromJSONKeyFunction where
479--
462--
480-- On pre GHC 7.8 this is unconstrainted function.
463-- On pre GHC 7.8 this is unconstrainted function.
481fromJSONKeyCoerce ::
464fromJSONKeyCoerce ::
482−#if HAS_COERCIBLE
483 Coercible Text a =>
465 Coercible Text a =>
484−#endif
485 FromJSONKeyFunction a
466 FromJSONKeyFunction a
486fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
467fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
487
468
@@ -489,29 +470,18 @@ fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
489--
470--
490-- See note on 'fromJSONKeyCoerce'.
471-- See note on 'fromJSONKeyCoerce'.
491coerceFromJSONKeyFunction ::
472coerceFromJSONKeyFunction ::
492−#if HAS_COERCIBLE
493 Coercible a b =>
473 Coercible a b =>
494−#endif
495 FromJSONKeyFunction a -> FromJSONKeyFunction b
474 FromJSONKeyFunction a -> FromJSONKeyFunction b
496−#if HAS_COERCIBLE
497coerceFromJSONKeyFunction = coerce
475coerceFromJSONKeyFunction = coerce
498−#else
499−coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText
500−coerceFromJSONKeyFunction (FromJSONKeyText f) = FromJSONKeyText (coerce' . f)
501−coerceFromJSONKeyFunction (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap coerce' . f)
502−coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fmap coerce' . f)
503−#endif
504
476
505{-# RULES
477{-# RULES
506 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).
478 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).
507 fmap id x = x
479 fmap id x = x
508 #-}
480 #-}
509−#if HAS_COERCIBLE
510{-# RULES
481{-# RULES
511 "FromJSONKeyCoerce: fmap coerce" forall x .
482 "FromJSONKeyCoerce: fmap coerce" forall x .
512 fmap coerce x = coerceFromJSONKeyFunction x
483 fmap coerce x = coerceFromJSONKeyFunction x
513 #-}
484 #-}
514−#endif
515
485
516-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.
486-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.
517mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
487mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
@@ -798,13 +768,13 @@ withBoundedScientific' f v = withBoundedScientific_ id f v
798-- | A variant of 'withBoundedScientific_' parameterized by a function to apply
768-- | A variant of 'withBoundedScientific_' parameterized by a function to apply
799-- to the 'Parser' in case of failure.
769-- to the 'Parser' in case of failure.
800withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
770withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
801−withBoundedScientific_ whenFail f v@(Number scientific) =
771+withBoundedScientific_ whenFail f (Number scientific) =
802− if exponent > 1024
772+ if exp10 > 1024
803 then whenFail (fail msg)
773 then whenFail (fail msg)
804 else f scientific
774 else f scientific
805 where
775 where
806− exponent = base10Exponent scientific
776+ exp10 = base10Exponent scientific
807− msg = "found a number with exponent " ++ show exponent ++ ", but it must not be greater than 1024"
777+ msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024"
808withBoundedScientific_ whenFail _ v =
778withBoundedScientific_ whenFail _ v =
809 whenFail (typeMismatch "Number" v)
779 whenFail (typeMismatch "Number" v)
810{-# INLINE withBoundedScientific_ #-}
780{-# INLINE withBoundedScientific_ #-}
@@ -824,7 +794,7 @@ withBool name _ v = prependContext name (typeMismatch "Boolean" v)
824-- | Decode a nested JSON-encoded string.
794-- | Decode a nested JSON-encoded string.
825withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
795withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
826withEmbeddedJSON _ innerParser (String txt) =
796withEmbeddedJSON _ innerParser (String txt) =
827− either fail innerParser $ eitherDecode (Compat.fromStrict $ T.encodeUtf8 txt)
797+ either fail innerParser $ eitherDecode (L.fromStrict $ T.encodeUtf8 txt)
828 where
798 where
829 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
799 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
830 eitherFormatError = either (Left . uncurry formatError) Right
800 eitherFormatError = either (Left . uncurry formatError) Right
@@ -893,7 +863,7 @@ parseFieldMaybe' = (.:!)
893-- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@
863-- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@
894explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
864explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
895explicitParseField p obj key = case H.lookup key obj of
865explicitParseField p obj key = case H.lookup key obj of
896− Nothing -> fail $ "key " ++ show key ++ " not present"
866+ Nothing -> fail $ "key " ++ show key ++ " not found"
897 Just v -> p v <?> Key key
867 Just v -> p v <?> Key key
898{-# INLINE explicitParseField #-}
868{-# INLINE explicitParseField #-}
899
869
@@ -952,6 +922,16 @@ type ConName = String
952contextType :: TypeName -> Parser a -> Parser a
922contextType :: TypeName -> Parser a -> Parser a
953contextType = prependContext
923contextType = prependContext
954
924
925+-- | Add the tagKey that will be looked up while building an ADT
926+-- | Produce the error equivalent to
927+-- | Left "Error in $: parsing T failed, expected an object with keys "tag" and
928+-- | "contents", where "tag" i-- |s associated to one of ["Foo", "Bar"],
929+-- | The parser returned error was: could not find key "tag"
930+contextTag :: Text -> [String] -> Parser a -> Parser a
931+contextTag tagKey cnames = prependFailure
932+ ("expected Object with key \"" ++ unpack tagKey ++ "\"" ++
933+ " containing one of " ++ show cnames ++ ", ")
934+
955-- | Add the name of the constructor being parsed to a parser's error messages.
935-- | Add the name of the constructor being parsed to a parser's error messages.
956contextCons :: ConName -> TypeName -> Parser a -> Parser a
936contextCons :: ConName -> TypeName -> Parser a -> Parser a
957contextCons cname tname = prependContext (showCons cname tname)
937contextCons cname tname = prependContext (showCons cname tname)
@@ -1130,8 +1110,8 @@ instance ConstructorNames a => ConstructorNames (D1 d a) where
1130 retag (Tagged2 x) = Tagged2 x
1110 retag (Tagged2 x) = Tagged2 x
1131
1111
1132--------------------------------------------------------------------------------
1112--------------------------------------------------------------------------------
1133−
1134−parseNonAllNullarySum :: ( FromPair arity f
1113+parseNonAllNullarySum :: forall f c arity.
1114+ ( FromPair arity f
1135 , FromTaggedObject arity f
1115 , FromTaggedObject arity f
1136 , FromUntaggedValue arity f
1116 , FromUntaggedValue arity f
1137 , ConstructorNames f
1117 , ConstructorNames f
@@ -1141,7 +1121,7 @@ parseNonAllNullarySum p@(tname :* opts :* _) =
1141 case sumEncoding opts of
1121 case sumEncoding opts of
1142 TaggedObject{..} ->
1122 TaggedObject{..} ->
1143 withObject tname $ \obj -> do
1123 withObject tname $ \obj -> do
1144− tag <- contextType tname $ obj .: tagKey
1124+ tag <- contextType tname . contextTag tagKey cnames_ $ obj .: tagKey
1145 fromMaybe (badTag tag <?> Key tagKey) $
1125 fromMaybe (badTag tag <?> Key tagKey) $
1146 parseFromTaggedObject (tag :* contentsFieldName :* p) obj
1126 parseFromTaggedObject (tag :* contentsFieldName :* p) obj
1147 where
1127 where
@@ -1149,6 +1129,7 @@ parseNonAllNullarySum p@(tname :* opts :* _) =
1149 badTag tag = failWith_ $ \cnames ->
1129 badTag tag = failWith_ $ \cnames ->
1150 "expected tag field to be one of " ++ show cnames ++
1130 "expected tag field to be one of " ++ show cnames ++
1151 ", but found tag " ++ show tag
1131 ", but found tag " ++ show tag
1132+ cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String])
1152
1133
1153 ObjectWithSingleField ->
1134 ObjectWithSingleField ->
1154 withObject tname $ \obj -> case H.toList obj of
1135 withObject tname $ \obj -> case H.toList obj of
@@ -1220,9 +1201,9 @@ class FromTaggedObject' arity f isRecord where
1220 :: String :* ConName :* TypeName :* Options :* FromArgs arity a
1201 :: String :* ConName :* TypeName :* Options :* FromArgs arity a
1221 -> Object -> Tagged isRecord (Parser (f a))
1202 -> Object -> Tagged isRecord (Parser (f a))
1222
1203
1223−instance (RecordFromJSON arity f) => FromTaggedObject' arity f True where
1204+instance (RecordFromJSON arity f, FieldNames f) => FromTaggedObject' arity f True where
1224 -- Records are unpacked in the tagged object
1205 -- Records are unpacked in the tagged object
1225− parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON p
1206+ parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON (True :* p)
1226
1207
1227instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where
1208instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where
1228 -- Nonnullary nonrecords are encoded in the contents field
1209 -- Nonnullary nonrecords are encoded in the contents field
@@ -1263,11 +1244,11 @@ instance OVERLAPPING_
1263 ) => ConsFromJSON' arity (S1 s a) True where
1244 ) => ConsFromJSON' arity (S1 s a) True where
1264 consParseJSON' p@(cname :* tname :* opts :* fargs)
1245 consParseJSON' p@(cname :* tname :* opts :* fargs)
1265 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs
1246 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs
1266− | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON p)
1247+ | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))
1267
1248
1268instance RecordFromJSON arity f => ConsFromJSON' arity f True where
1249instance RecordFromJSON arity f => ConsFromJSON' arity f True where
1269 consParseJSON' p@(cname :* tname :* _) =
1250 consParseJSON' p@(cname :* tname :* _) =
1270− Tagged . withObject (showCons cname tname) (recordParseJSON p)
1251+ Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))
1271
1252
1272instance OVERLAPPING_
1253instance OVERLAPPING_
1273 ConsFromJSON' arity U1 False where
1254 ConsFromJSON' arity U1 False where
@@ -1293,21 +1274,55 @@ instance (ProductFromJSON arity f, ProductSize f
1293
1274
1294--------------------------------------------------------------------------------
1275--------------------------------------------------------------------------------
1295
1276
1277+class FieldNames f where
1278+ fieldNames :: f a -> [Text] -> [Text]
1279+
1280+instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where
1281+ fieldNames _ =
1282+ fieldNames (undefined :: a x) .
1283+ fieldNames (undefined :: b y)
1284+
1285+instance (Selector s) => FieldNames (S1 s f) where
1286+ fieldNames _ = (pack (selName (undefined :: M1 _i s _f _p)) :)
1287+
1296class RecordFromJSON arity f where
1288class RecordFromJSON arity f where
1297 recordParseJSON
1289 recordParseJSON
1290+ :: Bool :* ConName :* TypeName :* Options :* FromArgs arity a
1291+ -> Object -> Parser (f a)
1292+
1293+instance ( FieldNames f
1294+ , RecordFromJSON' arity f
1295+ ) => RecordFromJSON arity f where
1296+ recordParseJSON (fromTaggedSum :* p@(cname :* tname :* opts :* _)) =
1297+ \obj -> checkUnknown obj >> recordParseJSON' p obj
1298+ where
1299+ knownFields :: H.HashMap Text ()
1300+ knownFields = H.fromList $ map (,()) $
1301+ fieldNames (undefined :: f a)
1302+ [pack (tagFieldName (sumEncoding opts)) | fromTaggedSum]
1303+ checkUnknown =
1304+ if not (rejectUnknownFields opts)
1305+ then \_ -> return ()
1306+ else \obj -> case H.keys (H.difference obj knownFields) of
1307+ [] -> return ()
1308+ unknownFields -> contextCons cname tname $
1309+ fail ("unknown fields: " ++ show unknownFields)
1310+
1311+class RecordFromJSON' arity f where
1312+ recordParseJSON'
1298 :: ConName :* TypeName :* Options :* FromArgs arity a
1313 :: ConName :* TypeName :* Options :* FromArgs arity a
1299 -> Object -> Parser (f a)
1314 -> Object -> Parser (f a)
1300
1315
1301−instance ( RecordFromJSON arity a
1316+instance ( RecordFromJSON' arity a
1302− , RecordFromJSON arity b
1317+ , RecordFromJSON' arity b
1303− ) => RecordFromJSON arity (a :*: b) where
1318+ ) => RecordFromJSON' arity (a :*: b) where
1304− recordParseJSON p obj =
1319+ recordParseJSON' p obj =
1305− (:*:) <$> recordParseJSON p obj
1320+ (:*:) <$> recordParseJSON' p obj
1306− <*> recordParseJSON p obj
1321+ <*> recordParseJSON' p obj
1307
1322
1308instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
1323instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
1309− RecordFromJSON arity (S1 s a) where
1324+ RecordFromJSON' arity (S1 s a) where
1310− recordParseJSON (cname :* tname :* opts :* fargs) obj = do
1325+ recordParseJSON' (cname :* tname :* opts :* fargs) obj = do
1311 fv <- contextCons cname tname (obj .: label)
1326 fv <- contextCons cname tname (obj .: label)
1312 M1 <$> gParseJSON opts fargs fv <?> Key label
1327 M1 <$> gParseJSON opts fargs fv <?> Key label
1313 where
1328 where
@@ -1315,16 +1330,16 @@ instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
1315 sname = selName (undefined :: M1 _i s _f _p)
1330 sname = selName (undefined :: M1 _i s _f _p)
1316
1331
1317instance INCOHERENT_ (Selector s, FromJSON a) =>
1332instance INCOHERENT_ (Selector s, FromJSON a) =>
1318− RecordFromJSON arity (S1 s (K1 i (Maybe a))) where
1333+ RecordFromJSON' arity (S1 s (K1 i (Maybe a))) where
1319− recordParseJSON (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label
1334+ recordParseJSON' (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label
1320 where
1335 where
1321 label = fieldLabelModifier opts sname
1336 label = fieldLabelModifier opts sname
1322 sname = selName (undefined :: M1 _i s _f _p)
1337 sname = selName (undefined :: M1 _i s _f _p)
1323
1338
1324-- Parse an Option like a Maybe.
1339-- Parse an Option like a Maybe.
1325instance INCOHERENT_ (Selector s, FromJSON a) =>
1340instance INCOHERENT_ (Selector s, FromJSON a) =>
1326− RecordFromJSON arity (S1 s (K1 i (Semigroup.Option a))) where
1341+ RecordFromJSON' arity (S1 s (K1 i (Semigroup.Option a))) where
1327− recordParseJSON p obj = wrap <$> recordParseJSON p obj
1342+ recordParseJSON' p obj = wrap <$> recordParseJSON' p obj
1328 where
1343 where
1329 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p
1344 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p
1330 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))
1345 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))
@@ -1561,12 +1576,22 @@ instance FromJSONKey Float where
1561 _ -> Scientific.toRealFloat <$> parseScientificText t
1576 _ -> Scientific.toRealFloat <$> parseScientificText t
1562
1577
1563instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
1578instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
1579+ parseJSON (Number x)
1580+ | exp10 <= 1024
1581+ , exp10 >= -1024 = return $! realToFrac x
1582+ | otherwise = prependContext "Ratio" $ fail msg
1583+ where
1584+ exp10 = base10Exponent x
1585+ msg = "found a number with exponent " ++ show exp10
1586+ ++ ", but it must not be greater than 1024 or less than -1024"
1587+ parseJSON o = objParser o
1588+ where
1564− parseJSON = withObject "Rational" $ \obj -> do
1589+ objParser = withObject "Rational" $ \obj -> do
1565− numerator <- obj .: "numerator"
1590+ numerator <- obj .: "numerator"
1566− denominator <- obj .: "denominator"
1591+ denominator <- obj .: "denominator"
1567− if denominator == 0
1592+ if denominator == 0
1568− then fail "Ratio denominator was 0"
1593+ then fail "Ratio denominator was 0"
1569− else pure $ numerator % denominator
1594+ else pure $ numerator % denominator
1570 {-# INLINE parseJSON #-}
1595 {-# INLINE parseJSON #-}
1571
1596
1572-- | This instance includes a bounds check to prevent maliciously
1597-- | This instance includes a bounds check to prevent maliciously
@@ -1981,7 +2006,6 @@ instance FromJSON DotNetTime where
1981-- primitive
2006-- primitive
1982-------------------------------------------------------------------------------
2007-------------------------------------------------------------------------------
1983
2008
1984−#if MIN_VERSION_base(4,7,0)
1985instance FromJSON a => FromJSON (PM.Array a) where
2009instance FromJSON a => FromJSON (PM.Array a) where
1986 -- note: we could do better than this if vector exposed the data
2010 -- note: we could do better than this if vector exposed the data
1987 -- constructor in Data.Vector.
2011 -- constructor in Data.Vector.
@@ -1999,7 +2023,6 @@ instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where
1999 parseJSON = fmap Exts.fromList . parseJSON
2023 parseJSON = fmap Exts.fromList . parseJSON
2000#endif
2024#endif
2001#endif
2025#endif
2002−#endif
2003
2026
2004-------------------------------------------------------------------------------
2027-------------------------------------------------------------------------------
2005-- time
2028-- time
Data/Aeson/Types/Internal.hs+26−5
@@ -49,6 +49,8 @@ module Data.Aeson.Types.Internal
49 , parserThrowError
49 , parserThrowError
50 , parserCatchError
50 , parserCatchError
51 , formatError
51 , formatError
52+ , formatPath
53+ , formatRelativePath
52 , (<?>)
54 , (<?>)
53 -- * Constructors and accessors
55 -- * Constructors and accessors
54 , object
56 , object
@@ -62,6 +64,7 @@ module Data.Aeson.Types.Internal
62 , sumEncoding
64 , sumEncoding
63 , unwrapUnaryRecords
65 , unwrapUnaryRecords
64 , tagSingleConstructors
66 , tagSingleConstructors
67+ , rejectUnknownFields
65 )
68 )
66
69
67 , SumEncoding(..)
70 , SumEncoding(..)
@@ -99,6 +102,7 @@ import Data.Time.Format (FormatTime)
99import Data.Typeable (Typeable)
102import Data.Typeable (Typeable)
100import Data.Vector (Vector)
103import Data.Vector (Vector)
101import GHC.Generics (Generic)
104import GHC.Generics (Generic)
105+import qualified Control.Monad as Monad
102import qualified Control.Monad.Fail as Fail
106import qualified Control.Monad.Fail as Fail
103import qualified Data.HashMap.Strict as H
107import qualified Data.HashMap.Strict as H
104import qualified Data.Scientific as S
108import qualified Data.Scientific as S
@@ -152,7 +156,7 @@ instance Functor Result where
152 fmap _ (Error err) = Error err
156 fmap _ (Error err) = Error err
153 {-# INLINE fmap #-}
157 {-# INLINE fmap #-}
154
158
155−instance Monad IResult where
159+instance Monad.Monad IResult where
156 return = pure
160 return = pure
157 {-# INLINE return #-}
161 {-# INLINE return #-}
158
162
@@ -169,7 +173,7 @@ instance Fail.MonadFail IResult where
169 fail err = IError [] err
173 fail err = IError [] err
170 {-# INLINE fail #-}
174 {-# INLINE fail #-}
171
175
172−instance Monad Result where
176+instance Monad.Monad Result where
173 return = pure
177 return = pure
174 {-# INLINE return #-}
178 {-# INLINE return #-}
175
179
@@ -288,7 +292,7 @@ newtype Parser a = Parser {
288 -> f r
292 -> f r
289 }
293 }
290
294
291−instance Monad Parser where
295+instance Monad.Monad Parser where
292 m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks
296 m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks
293 in runParser m path kf ks'
297 in runParser m path kf ks'
294 {-# INLINE (>>=) #-}
298 {-# INLINE (>>=) #-}
@@ -457,7 +461,17 @@ parseEither m v = runParser (m v) [] onError Right
457-- | Annotate an error message with a
461-- | Annotate an error message with a
458-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.
462-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.
459formatError :: JSONPath -> String -> String
463formatError :: JSONPath -> String -> String
460−formatError path msg = "Error in " ++ format "$" path ++ ": " ++ msg
464+formatError path msg = "Error in " ++ formatPath path ++ ": " ++ msg
465+
466+-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String',
467+-- representing the root object as @$@.
468+formatPath :: JSONPath -> String
469+formatPath path = "$" ++ formatRelativePath path
470+
471+-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String'
472+-- which represents the path relative to some root object.
473+formatRelativePath :: JSONPath -> String
474+formatRelativePath path = format "" path
461 where
475 where
462 format :: String -> JSONPath -> String
476 format :: String -> JSONPath -> String
463 format pfx [] = pfx
477 format pfx [] = pfx
@@ -611,10 +625,14 @@ data Options = Options
611 , tagSingleConstructors :: Bool
625 , tagSingleConstructors :: Bool
612 -- ^ Encode types with a single constructor as sums,
626 -- ^ Encode types with a single constructor as sums,
613 -- so that `allNullaryToStringTag` and `sumEncoding` apply.
627 -- so that `allNullaryToStringTag` and `sumEncoding` apply.
628+ , rejectUnknownFields :: Bool
629+ -- ^ Applies only to 'Data.Aeson.FromJSON' instances. If a field appears in
630+ -- the parsed object map, but does not appear in the target object, parsing
631+ -- will fail, with an error message indicating which fields were unknown.
614 }
632 }
615
633
616instance Show Options where
634instance Show Options where
617− show (Options f c a o s u t) =
635+ show (Options f c a o s u t r) =
618 "Options {"
636 "Options {"
619 ++ intercalate ", "
637 ++ intercalate ", "
620 [ "fieldLabelModifier =~ " ++ show (f "exampleField")
638 [ "fieldLabelModifier =~ " ++ show (f "exampleField")
@@ -624,6 +642,7 @@ instance Show Options where
624 , "sumEncoding = " ++ show s
642 , "sumEncoding = " ++ show s
625 , "unwrapUnaryRecords = " ++ show u
643 , "unwrapUnaryRecords = " ++ show u
626 , "tagSingleConstructors = " ++ show t
644 , "tagSingleConstructors = " ++ show t
645+ , "rejectUnknownFields = " ++ show r
627 ]
646 ]
628 ++ "}"
647 ++ "}"
629
648
@@ -705,6 +724,7 @@ data JSONKeyOptions = JSONKeyOptions
705-- , 'sumEncoding' = 'defaultTaggedObject'
724-- , 'sumEncoding' = 'defaultTaggedObject'
706-- , 'unwrapUnaryRecords' = False
725-- , 'unwrapUnaryRecords' = False
707-- , 'tagSingleConstructors' = False
726-- , 'tagSingleConstructors' = False
727+-- , 'rejectUnknownFields' = False
708-- }
728-- }
709-- @
729-- @
710defaultOptions :: Options
730defaultOptions :: Options
@@ -716,6 +736,7 @@ defaultOptions = Options
716 , sumEncoding = defaultTaggedObject
736 , sumEncoding = defaultTaggedObject
717 , unwrapUnaryRecords = False
737 , unwrapUnaryRecords = False
718 , tagSingleConstructors = False
738 , tagSingleConstructors = False
739+ , rejectUnknownFields = False
719 }
740 }
720
741
721-- | Default 'TaggedObject' 'SumEncoding' options:
742-- | Default 'TaggedObject' 'SumEncoding' options:
Data/Aeson/Types/ToJSON.hs+3−43
@@ -5,19 +5,15 @@
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FunctionalDependencies #-}
6{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE GADTs #-}
7{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE NamedFieldPuns #-}
9{-# LANGUAGE NoImplicitPrelude #-}
8{-# LANGUAGE NoImplicitPrelude #-}
10{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
11{-# LANGUAGE PatternGuards #-}
10{-# LANGUAGE PatternGuards #-}
11+{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE RecordWildCards #-}
12{-# LANGUAGE RecordWildCards #-}
13{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE UndecidableInstances #-}
16
16
17−#if __GLASGOW_HASKELL__ >= 706
18−{-# LANGUAGE PolyKinds #-}
19−#endif
20−
21#include "overlapping-compat.h"
17#include "overlapping-compat.h"
22#include "incoherent-compat.h"
18#include "incoherent-compat.h"
23
19
@@ -104,7 +100,6 @@ import GHC.Generics
104import Numeric.Natural (Natural)
100import Numeric.Natural (Natural)
105import qualified Data.Aeson.Encoding as E
101import qualified Data.Aeson.Encoding as E
106import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
102import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
107−import qualified Data.ByteString as S
108import qualified Data.ByteString.Lazy as L
103import qualified Data.ByteString.Lazy as L
109import qualified Data.DList as DList
104import qualified Data.DList as DList
110import qualified Data.HashMap.Strict as H
105import qualified Data.HashMap.Strict as H
@@ -145,14 +140,6 @@ import qualified Data.Primitive.UnliftedArray as PM
145import qualified Data.Primitive.PrimArray as PM
140import qualified Data.Primitive.PrimArray as PM
146#endif
141#endif
147
142
148−#if !(MIN_VERSION_bytestring(0,10,0))
149−import Foreign.ForeignPtr (withForeignPtr)
150−import Foreign.Marshal.Utils (copyBytes)
151−import Foreign.Ptr (plusPtr)
152−import qualified Data.ByteString.Internal as S
153−import qualified Data.ByteString.Lazy.Internal as L
154−#endif
155−
156toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
157toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
144toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
158{-# INLINE toJSONPair #-}
145{-# INLINE toJSONPair #-}
@@ -516,7 +503,7 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e
516 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
503 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
517 tot = T.dropAround (== '"')
504 tot = T.dropAround (== '"')
518 . T.decodeLatin1
505 . T.decodeLatin1
519− . lazyToStrictByteString
506+ . L.toStrict
520 . E.encodingToLazyByteString
507 . E.encodingToLazyByteString
521 . e
508 . e
522
509
@@ -1983,7 +1970,6 @@ formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1983-- primitive
1970-- primitive
1984-------------------------------------------------------------------------------
1971-------------------------------------------------------------------------------
1985
1972
1986−#if MIN_VERSION_base(4,7,0)
1987instance ToJSON a => ToJSON (PM.Array a) where
1973instance ToJSON a => ToJSON (PM.Array a) where
1988 -- note: we could do better than this if vector exposed the data
1974 -- note: we could do better than this if vector exposed the data
1989 -- constructor in Data.Vector.
1975 -- constructor in Data.Vector.
@@ -2005,7 +1991,6 @@ instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where
2005 toEncoding = toEncoding . Exts.toList
1991 toEncoding = toEncoding . Exts.toList
2006#endif
1992#endif
2007#endif
1993#endif
2008−#endif
2009
1994
2010-------------------------------------------------------------------------------
1995-------------------------------------------------------------------------------
2011-- time
1996-- time
@@ -2055,7 +2040,7 @@ stringEncoding :: Encoding' Text -> Value
2055stringEncoding = String
2040stringEncoding = String
2056 . T.dropAround (== '"')
2041 . T.dropAround (== '"')
2057 . T.decodeLatin1
2042 . T.decodeLatin1
2058− . lazyToStrictByteString
2043+ . L.toStrict
2059 . E.encodingToLazyByteString
2044 . E.encodingToLazyByteString
2060{-# INLINE stringEncoding #-}
2045{-# INLINE stringEncoding #-}
2061
2046
@@ -2862,31 +2847,6 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2862 toEncoding = toEncoding2
2847 toEncoding = toEncoding2
2863 {-# INLINE toEncoding #-}
2848 {-# INLINE toEncoding #-}
2864
2849
2865−-------------------------------------------------------------------------------
2866−-- pre-bytestring-0.10 compatibility
2867−-------------------------------------------------------------------------------
2868−
2869−{-# INLINE lazyToStrictByteString #-}
2870−lazyToStrictByteString :: L.ByteString -> S.ByteString
2871−#if MIN_VERSION_bytestring(0,10,0)
2872−lazyToStrictByteString = L.toStrict
2873−#else
2874−lazyToStrictByteString = packChunks
2875−
2876−-- packChunks is taken from the blaze-builder package.
2877−
2878−-- | Pack the chunks of a lazy bytestring into a single strict bytestring.
2879−packChunks :: L.ByteString -> S.ByteString
2880−packChunks lbs =
2881− S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
2882− where
2883− copyChunks L.Empty _pf = return ()
2884− copyChunks (L.Chunk (S.PS fpbuf o l) lbs') pf = do
2885− withForeignPtr fpbuf $ \pbuf ->
2886− copyBytes pf (pbuf `plusPtr` o) l
2887− copyChunks lbs' (pf `plusPtr` l)
2888−#endif
2889−
2890--------------------------------------------------------------------------------
2850--------------------------------------------------------------------------------
2891
2851
2892-- | Wrap a list of pairs as an object.
2852-- | Wrap a list of pairs as an object.
Makefile+1−1
@@ -1,2 +1,2 @@
1lint:
1lint:
2− hlint --cpp-include include/ --cpp-file .stack-work/dist/*/*Cabal-*/build/autogen/cabal_macros.h Data/ attoparsec-iso8601/ benchmarks/ examples/ ffi/ pure/ tests/
2+ ./run-hlint.sh --cpp-include include/ --cpp-file travis/cabal_macros.h Data/ attoparsec-iso8601/ benchmarks/ examples/ ffi/ pure/ tests/
aeson.cabal+9−15
@@ -1,5 +1,5 @@
1name: aeson
1name: aeson
2−version: 1.4.3.0
2+version: 1.4.6.0
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5category: Text, Web, JSON
5category: Text, Web, JSON
@@ -88,7 +88,6 @@ library
88 Data.Aeson.Encode
88 Data.Aeson.Encode
89
89
90 other-modules:
90 other-modules:
91− Data.Aeson.Compat
92 Data.Aeson.Encoding.Builder
91 Data.Aeson.Encoding.Builder
93 Data.Aeson.Internal.Functions
92 Data.Aeson.Internal.Functions
94 Data.Aeson.Parser.Unescape
93 Data.Aeson.Parser.Unescape
@@ -103,28 +102,23 @@ library
103
102
104 -- GHC bundled libs
103 -- GHC bundled libs
105 build-depends:
104 build-depends:
106− base >= 4.5.0.0 && < 5,
105+ base >= 4.7.0.0 && < 5,
106+ bytestring >= 0.10.4.0 && < 0.11,
107− containers >= 0.4.2.1 && < 0.7,
107+ containers >= 0.5.5.1 && < 0.7,
108 deepseq >= 1.3.0.0 && < 1.5,
108 deepseq >= 1.3.0.0 && < 1.5,
109 ghc-prim >= 0.2 && < 0.6,
109 ghc-prim >= 0.2 && < 0.6,
110− template-haskell >= 2.7.0.0 && < 2.15,
110+ template-haskell >= 2.9.0.0 && < 2.16,
111 text >= 1.2.3.0 && < 1.3,
111 text >= 1.2.3.0 && < 1.3,
112− time >= 1.4 && < 1.9
112+ time >= 1.4 && < 1.10
113
113
114 if impl(ghc >= 8.0)
114 if impl(ghc >= 8.0)
115 build-depends: bytestring >= 0.10.8.1
115 build-depends: bytestring >= 0.10.8.1
116
116
117 -- Compat
117 -- Compat
118 build-depends:
118 build-depends:
119− base-compat >= 0.9.1 && < 0.11,
119+ base-compat >= 0.9.1 && < 0.12,
120 time-compat >= 1.9.2.2 && < 1.10
120 time-compat >= 1.9.2.2 && < 1.10
121
121
122− if flag(bytestring-builder)
123− build-depends: bytestring >= 0.9.2.1 && < 0.10.4,
124− bytestring-builder >= 0.10.4 && < 1
125− else
126− build-depends: bytestring >= 0.10.4 && < 0.11
127−
128 if !impl(ghc >= 8.6)
122 if !impl(ghc >= 8.6)
129 build-depends:
123 build-depends:
130 contravariant >=1.4.1 && <1.6
124 contravariant >=1.4.1 && <1.6
@@ -225,9 +219,9 @@ test-suite tests
225 containers,
219 containers,
226 directory,
220 directory,
227 dlist,
221 dlist,
228− Diff,
222+ Diff >= 0.4 && < 0.5,
229 filepath,
223 filepath,
230− generic-deriving >= 1.10 && < 1.13,
224+ generic-deriving >= 1.10 && < 1.14,
231 ghc-prim >= 0.2,
225 ghc-prim >= 0.2,
232 hashable >= 1.2.4.0,
226 hashable >= 1.2.4.0,
233 scientific,
227 scientific,
attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs−20
@@ -29,16 +29,8 @@ import Data.Time.Clock (diffTimeToPicoseconds)
29
29
30#endif
30#endif
31
31
32−#if MIN_VERSION_base(4,7,0)
33−
34import Data.Fixed (Pico, Fixed(MkFixed))
32import Data.Fixed (Pico, Fixed(MkFixed))
35
33
36−#else
37−
38−import Data.Fixed (Pico)
39−
40−#endif
41−
42#if !MIN_VERSION_time(1,6,0)
34#if !MIN_VERSION_time(1,6,0)
43
35
44diffTimeToPicoseconds :: DiffTime -> Integer
36diffTimeToPicoseconds :: DiffTime -> Integer
@@ -46,24 +38,12 @@ diffTimeToPicoseconds = unsafeCoerce
46
38
47#endif
39#endif
48
40
49−#if MIN_VERSION_base(4,7,0)
50−
51toPico :: Integer -> Pico
41toPico :: Integer -> Pico
52toPico = MkFixed
42toPico = MkFixed
53
43
54fromPico :: Pico -> Integer
44fromPico :: Pico -> Integer
55fromPico (MkFixed i) = i
45fromPico (MkFixed i) = i
56
46
57−#else
58−
59−toPico :: Integer -> Pico
60−toPico = unsafeCoerce
61−
62−fromPico :: Pico -> Integer
63−fromPico = unsafeCoerce
64−
65−#endif
66−
67-- | Like TimeOfDay, but using a fixed-width integer for seconds.
47-- | Like TimeOfDay, but using a fixed-width integer for seconds.
68data TimeOfDay64 = TOD {-# UNPACK #-} !Int
48data TimeOfDay64 = TOD {-# UNPACK #-} !Int
69 {-# UNPACK #-} !Int
49 {-# UNPACK #-} !Int
attoparsec-iso8601/attoparsec-iso8601.cabal+2−2
@@ -36,8 +36,8 @@ library
36 Data.Attoparsec.Time
36 Data.Attoparsec.Time
37 build-depends:
37 build-depends:
38 attoparsec >= 0.13.0.1,
38 attoparsec >= 0.13.0.1,
39− base >= 4.5 && < 5,
39+ base >= 4.7 && < 5,
40− base-compat >= 0.9.1 && < 0.11,
40+ base-compat >= 0.9.1 && < 0.12,
41 text >= 1.1.1.0,
41 text >= 1.1.1.0,
42 time >= 1.1.1.4
42 time >= 1.1.1.4
43
43
benchmarks/AesonEncode.hs+1−1
@@ -7,7 +7,7 @@ module Main (main) where
7import Prelude.Compat
7import Prelude.Compat
8
8
9import Control.DeepSeq
9import Control.DeepSeq
10−import Control.Monad
10+import Control.Monad (forM_)
11import Data.Aeson
11import Data.Aeson
12import Data.Attoparsec.ByteString (IResult(..), parseWith)
12import Data.Attoparsec.ByteString (IResult(..), parseWith)
13import Data.Char (isDigit)
13import Data.Char (isDigit)
benchmarks/Compare/JsonBench.hs+2−1
@@ -20,6 +20,7 @@ import Data.Aeson ((.:))
20import Data.Monoid ((<>))
20import Data.Monoid ((<>))
21import Data.Text (Text)
21import Data.Text (Text)
22import Typed.Common (load)
22import Typed.Common (load)
23+import qualified Control.Monad.Fail as Fail
23import qualified Data.Aeson as Aeson
24import qualified Data.Aeson as Aeson
24import qualified Data.BufferBuilder.Json as Json
25import qualified Data.BufferBuilder.Json as Json
25
26
@@ -82,7 +83,7 @@ genderTable = [("male", Male), ("female", Female)]
82fruitTable :: [(Text, Fruit)]
83fruitTable :: [(Text, Fruit)]
83fruitTable = [("apple", Apple), ("strawberry", Strawberry), ("banana", Banana)]
84fruitTable = [("apple", Apple), ("strawberry", Strawberry), ("banana", Banana)]
84
85
85−enumFromJson :: Monad m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum
86+enumFromJson :: Fail.MonadFail m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum
86enumFromJson enumName table extract v = do
87enumFromJson enumName table extract v = do
87 s <- extract v
88 s <- extract v
88 case lookup s table of
89 case lookup s table of
benchmarks/aeson-benchmarks.cabal−1
@@ -72,7 +72,6 @@ library
72
72
73 exposed-modules:
73 exposed-modules:
74 Data.Aeson
74 Data.Aeson
75− Data.Aeson.Compat
76 Data.Aeson.Encoding
75 Data.Aeson.Encoding
77 Data.Aeson.Encoding.Builder
76 Data.Aeson.Encoding.Builder
78 Data.Aeson.Encoding.Internal
77 Data.Aeson.Encoding.Internal
cabal.project+3−1
@@ -1,3 +1,5 @@
1with-compiler: ghc
1with-compiler: ghc
2packages: .
2packages: .
3−packages: attoparsec-iso8601, benchmarks
3+packages: attoparsec-iso8601
4+-- packages: benchmarks
5+tests: true
changelog.md+56
@@ -1,5 +1,61 @@
1For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).
1For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).
2
2
3+### upcoming
4+
5+* `FromJSON` instance of `Ratio a` now parses numbers in addtion to
6+ standard `{numerator=..., denumerator=...}` encoding.
7+
8+### 1.4.6.0
9+
10+* Provide a clearer error message when a required tagKey for a constructor is missing, thanks to Guru Devanla.
11+ The error message now looks like this: `Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found`
12+
13+* Add `formatPath` and `formatRelativePath` functions to turn a `JSONPath` into a `String`, thanks to Robbie McMichael
14+
15+
16+### 1.4.5.0
17+
18+* Expose `(<?>)`, `JSONPath` and `JSONPathElement(..)` from `Data.Aeson.Types`. Previously only available through internal modules. Thanks to Luke Clifton.
19+
20+* Support for base-compat 0.11, thanks to Ryan Scott.
21+
22+* Travis build for GHC 8.8, thanks to Oleg Grenrus.
23+
24+### 1.4.4.0
25+
26+**New features**:
27+
28+* Adds a parameterized parser `jsonWith` that can be used to choose how to handle duplicate keys in objects, thanks to Xia Li-Yao.
29+
30+* Add generic implementations of `FromJSONKey` and `ToJSONKey`, thanks to Xia Li-Yao. Example:
31+
32+```haskell
33+data Foo = Bar
34+ deriving Generic
35+
36+opts :: JSONKeyOptions
37+opts = defaultJSONKeyOptions { keyModifier = toLower }
38+
39+instance ToJSONKey Foo where
40+ toJSONKey = genericToJSONKey opts
41+
42+instance FromJSONKey Foo where
43+ fromJSONKey = genericFromJSONKey opts
44+```
45+
46+**Minor**:
47+* aeson now uses `time-compat` instead of `time-locale-compat`, thanks to Oleg Grenrus.
48+* Prepare for `MonadFail` breakages in GHC 8.8, thanks to Oleg Grenrus.
49+* Require `bytestring >= 0.10.8.1` for newer GHCs to avoid build failures, thanks to Oleg Grenrus.
50+* Support `primitive 0.7.*`, thanks to Adam Bergmark.
51+* Allow `semigroups 0.19.*` and `hashable 1.3.*`, thanks to Oleg Grenrus.
52+* Fix a typo in the error message when parsing `NonEmpty`, thanks to Colin Woodbury.
53+* Document surprising behavior when using `omitNothingFields` with type variables, thanks to Xia Li-Yao.
54+
55+**Internal changes**:
56+* Code cleanup by Oleg Grenrus
57+* Fix dependencies of the benchmarks on older GHC's, thanks to Xia Li-Yao.
58+
3### 1.4.3.0
59### 1.4.3.0
4* Improve error messages for FromJSON in existing instances and GHC Generic implementation. Thanks to Xia Li-Yao & Igor Pashev.
60* Improve error messages for FromJSON in existing instances and GHC Generic implementation. Thanks to Xia Li-Yao & Igor Pashev.
5* Tweak error-reporting combinators and their documentation. Thanks to Xia Li-Yao.
61* Tweak error-reporting combinators and their documentation. Thanks to Xia Li-Yao.
run-hlint.shnew file+7
@@ -0,0 +1,7 @@
1+#!/bin/bash
2+
3+if hash hlint 2>/dev/null; then
4+ hlint "$@"
5+else
6+ ./hlint.sh "$@"
7+fi
stack-bench.yaml+2−8
@@ -1,4 +1,4 @@
1−resolver: lts-12.26
1+resolver: nightly-2019-09-21
2# We use aeson in the snapshot to
2# We use aeson in the snapshot to
3# - avoid recompilation of criterion
3# - avoid recompilation of criterion
4# - compare against it
4# - compare against it
@@ -9,10 +9,4 @@ resolver: lts-12.26
9work-dir: .stack-work-bench
9work-dir: .stack-work-bench
10packages:
10packages:
11- benchmarks
11- benchmarks
12−extra-deps:
12+extra-deps: []
13−- base-orphans-0.8.1
14−- hashable-time-0.2.0.1
15−- QuickCheck-2.13.1
16−- quickcheck-instances-0.3.21
17−- splitmix-0.0.2
18−- time-compat-1.9.2.2
stack-ffi-unescape.yaml+2−7
@@ -1,4 +1,4 @@
1−resolver: lts-12.26
1+resolver: nightly-2019-09-21
2packages:
2packages:
3- '.'
3- '.'
4flags:
4flags:
@@ -6,9 +6,4 @@ flags:
6 fast: true
6 fast: true
7 cffi: true
7 cffi: true
8extra-deps:
8extra-deps:
9−- base-orphans-0.8.1
9+- Diff-0.4.0
10−- hashable-time-0.2.0.1
11−- QuickCheck-2.13.1
12−- quickcheck-instances-0.3.21
13−- splitmix-0.0.2
14−- time-compat-1.9.2.2
stack-nightly.yaml+2−4
@@ -1,4 +1,4 @@
1−resolver: nightly-2019-05-13
1+resolver: nightly-2019-10-14
2packages:
2packages:
3- '.'
3- '.'
4- attoparsec-iso8601
4- attoparsec-iso8601
@@ -8,6 +8,4 @@ flags:
8 attoparsec-iso8601:
8 attoparsec-iso8601:
9 fast: true
9 fast: true
10extra-deps:
10extra-deps:
11−- hlint-2.1.18
11+- generic-deriving-1.12.4
12−- time-compat-1.9.2.2
13−- quickcheck-instances-0.3.21
tests/Encoders.hs+25−6
@@ -188,7 +188,6 @@ gSomeTypeToEncoding2ElemArray = genericToEncoding opts2ElemArray
188gSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
188gSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
189gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray
189gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray
190
190
191−#if __GLASGOW_HASKELL__ >= 706
192gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a
191gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a
193gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray
192gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray
194
193
@@ -197,7 +196,6 @@ gSomeTypeLiftToJSON2ElemArray = genericLiftToJSON opts2ElemArray
197
196
198gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a
197gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a
199gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray
198gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray
200−#endif
201
199
202
200
203gSomeTypeToJSONTaggedObject :: SomeType Int -> Value
201gSomeTypeToJSONTaggedObject :: SomeType Int -> Value
@@ -209,7 +207,6 @@ gSomeTypeToEncodingTaggedObject = genericToEncoding optsTaggedObject
209gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
207gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
210gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject
208gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject
211
209
212−#if __GLASGOW_HASKELL__ >= 706
213gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a
210gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a
214gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject
211gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject
215
212
@@ -218,7 +215,6 @@ gSomeTypeLiftToJSONTaggedObject = genericLiftToJSON optsTaggedObject
218
215
219gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a
216gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a
220gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject
217gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject
221−#endif
222
218
223
219
224gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
220gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
@@ -230,7 +226,6 @@ gSomeTypeToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingl
230gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
226gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
231gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
227gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
232
228
233−#if __GLASGOW_HASKELL__ >= 706
234gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a
229gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a
235gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField
230gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField
236
231
@@ -239,7 +234,6 @@ gSomeTypeLiftToJSONObjectWithSingleField = genericLiftToJSON optsObjectWithSingl
239
234
240gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a
235gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a
241gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField
236gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField
242−#endif
243
237
244
238
245gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value
239gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value
@@ -249,6 +243,31 @@ gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding
249gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
243gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
250
244
251
245
246+thSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)
247+thSomeTypeParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''SomeType)
248+
249+gSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)
250+gSomeTypeParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields
251+
252+
253+--------------------------------------------------------------------------------
254+-- Foo decoders
255+--------------------------------------------------------------------------------
256+
257+thFooParseJSONRejectUnknownFields :: Value -> Parser Foo
258+thFooParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''Foo)
259+
260+gFooParseJSONRejectUnknownFields :: Value -> Parser Foo
261+gFooParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields
262+
263+
264+thFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo
265+thFooParseJSONRejectUnknownFieldsTagged = $(mkParseJSON optsRejectUnknownFieldsTagged ''Foo)
266+
267+gFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo
268+gFooParseJSONRejectUnknownFieldsTagged = genericParseJSON optsRejectUnknownFieldsTagged
269+
270+
252--------------------------------------------------------------------------------
271--------------------------------------------------------------------------------
253-- Option fields
272-- Option fields
254--------------------------------------------------------------------------------
273--------------------------------------------------------------------------------
tests/ErrorMessages.hs+27−1
@@ -13,7 +13,7 @@ import Data.Aeson (FromJSON(..), Value, json)
13import Data.Aeson.Types (Parser)
13import Data.Aeson.Types (Parser)
14import Data.Aeson.Parser (eitherDecodeWith)
14import Data.Aeson.Parser (eitherDecodeWith)
15import Data.Aeson.Internal (formatError, iparse)
15import Data.Aeson.Internal (formatError, iparse)
16−import Data.Algorithm.Diff (Diff(..), getGroupedDiff)
16+import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff)
17import Data.Proxy (Proxy(..))
17import Data.Proxy (Proxy(..))
18import Data.Semigroup ((<>))
18import Data.Semigroup ((<>))
19import Data.Sequence (Seq)
19import Data.Sequence (Seq)
@@ -136,6 +136,29 @@ outputGeneric choice = concat
136 , "[1,"
136 , "[1,"
137 ]
137 ]
138
138
139+ , testWithSomeType "SomeType (reject unknown fields)"
140+ (select
141+ thSomeTypeParseJSONRejectUnknownFields
142+ gSomeTypeParseJSONRejectUnknownFields)
143+ [ "{\"tag\": \"record\", \"testOne\": 1.0, \"testZero\": 1}"
144+ , "{\"testZero\": 1}"
145+ , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"
146+ ]
147+
148+ , testWithFoo "Foo (reject unknown fields)"
149+ (select
150+ thFooParseJSONRejectUnknownFields
151+ gFooParseJSONRejectUnknownFields)
152+ [ "{\"tag\": \"foo\"}"
153+ ]
154+
155+ , testWithFoo "Foo (reject unknown fields, tagged single)"
156+ (select
157+ thFooParseJSONRejectUnknownFieldsTagged
158+ gFooParseJSONRejectUnknownFieldsTagged)
159+ [ "{\"tag\": \"foo\", \"unknownField\": 0}"
160+ ]
161+
139 , testWith "EitherTextInt"
162 , testWith "EitherTextInt"
140 (select
163 (select
141 thEitherTextIntParseJSONUntaggedValue
164 thEitherTextIntParseJSONUntaggedValue
@@ -196,3 +219,6 @@ testFor name _ = testWith name (parseJSON :: Value -> Parser a)
196
219
197testWithSomeType :: String -> (Value -> Parser (SomeType Int)) -> [L.ByteString] -> Output
220testWithSomeType :: String -> (Value -> Parser (SomeType Int)) -> [L.ByteString] -> Output
198testWithSomeType = testWith
221testWithSomeType = testWith
222+
223+testWithFoo :: String -> (Value -> Parser Foo) -> [L.ByteString] -> Output
224+testWithFoo = testWith
tests/Instances.hs+1−4
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
1{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE NoImplicitPrelude #-}
@@ -25,14 +24,12 @@ import qualified Data.HashMap.Strict as HM
25
24
26import Data.Orphans ()
25import Data.Orphans ()
27import Test.QuickCheck.Instances ()
26import Test.QuickCheck.Instances ()
28−#if MIN_VERSION_base(4,7,0)
29import Data.Hashable.Time ()
27import Data.Hashable.Time ()
30−#endif
31
28
32-- "System" types.
29-- "System" types.
33
30
34instance Arbitrary DotNetTime where
31instance Arbitrary DotNetTime where
35− arbitrary = DotNetTime `liftM` arbitrary
32+ arbitrary = DotNetTime `fmap` arbitrary
36 shrink = map DotNetTime . shrink . fromDotNetTime
33 shrink = map DotNetTime . shrink . fromDotNetTime
37
34
38-- | Compare timezone part only on 'timeZoneMinutes'
35-- | Compare timezone part only on 'timeZoneMinutes'
tests/Options.hs+11
@@ -55,3 +55,14 @@ optsOptionField = optsDefault
55 { fieldLabelModifier = const "field"
55 { fieldLabelModifier = const "field"
56 , omitNothingFields = True
56 , omitNothingFields = True
57 }
57 }
58+
59+optsRejectUnknownFields :: Options
60+optsRejectUnknownFields = optsDefault
61+ { rejectUnknownFields = True
62+ }
63+
64+optsRejectUnknownFieldsTagged :: Options
65+optsRejectUnknownFieldsTagged = optsDefault
66+ { rejectUnknownFields = True
67+ , tagSingleConstructors = True
68+ }
tests/PropertyGeneric.hs−8
@@ -44,11 +44,9 @@ genericTests =
44 , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)
44 , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)
45 , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)
45 , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)
46
46
47−#if __GLASGOW_HASKELL__ >= 706
48 , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)
47 , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)
49 , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)
48 , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)
50 , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)
49 , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)
51−#endif
52 ]
50 ]
53 ]
51 ]
54 , testGroup "OneConstructor" [
52 , testGroup "OneConstructor" [
@@ -85,30 +83,24 @@ genericTests =
85
83
86 , testProperty "SomeType2ElemArray" $
84 , testProperty "SomeType2ElemArray" $
87 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray
85 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray
88−#if __GLASGOW_HASKELL__ >= 706
89 , testProperty "SomeType2ElemArray unary" $
86 , testProperty "SomeType2ElemArray unary" $
90 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray
87 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray
91 , testProperty "SomeType2ElemArray unary agree" $
88 , testProperty "SomeType2ElemArray unary agree" $
92 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray
89 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray
93−#endif
94
90
95 , testProperty "SomeTypeTaggedObject" $
91 , testProperty "SomeTypeTaggedObject" $
96 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject
92 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject
97−#if __GLASGOW_HASKELL__ >= 706
98 , testProperty "SomeTypeTaggedObject unary" $
93 , testProperty "SomeTypeTaggedObject unary" $
99 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject
94 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject
100 , testProperty "SomeTypeTaggedObject unary agree" $
95 , testProperty "SomeTypeTaggedObject unary agree" $
101 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject
96 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject
102−#endif
103
97
104 , testProperty "SomeTypeObjectWithSingleField" $
98 , testProperty "SomeTypeObjectWithSingleField" $
105 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField
99 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField
106−#if __GLASGOW_HASKELL__ >= 706
107 , testProperty "SomeTypeObjectWithSingleField unary" $
100 , testProperty "SomeTypeObjectWithSingleField unary" $
108 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField
101 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField
109 , testProperty "SomeTypeObjectWithSingleField unary agree" $
102 , testProperty "SomeTypeObjectWithSingleField unary agree" $
110 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField
103 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField
111−#endif
112
104
113 , testProperty "SomeTypeOmitNothingFields" $
105 , testProperty "SomeTypeOmitNothingFields" $
114 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
106 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
tests/PropertyKeys.hs−3
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE NoImplicitPrelude #-}
1{-# LANGUAGE NoImplicitPrelude #-}
3
2
4module PropertyKeys ( keysTests ) where
3module PropertyKeys ( keysTests ) where
@@ -31,12 +30,10 @@ keysTests =
31 , testProperty "Natural" $ roundTripKey (undefined :: Natural)
30 , testProperty "Natural" $ roundTripKey (undefined :: Natural)
32 , testProperty "Float" $ roundTripKey (undefined :: Float)
31 , testProperty "Float" $ roundTripKey (undefined :: Float)
33 , testProperty "Double" $ roundTripKey (undefined :: Double)
32 , testProperty "Double" $ roundTripKey (undefined :: Double)
34−#if MIN_VERSION_base(4,7,0)
35 , testProperty "Day" $ roundTripKey (undefined :: Day)
33 , testProperty "Day" $ roundTripKey (undefined :: Day)
36 , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)
34 , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)
37 , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)
35 , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)
38 , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)
36 , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)
39−#endif
40 , testProperty "Version" $ roundTripKey (undefined :: Version)
37 , testProperty "Version" $ roundTripKey (undefined :: Version)
41 , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)
38 , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)
42 , testProperty "UUID" $ roundTripKey UUID.nil
39 , testProperty "UUID" $ roundTripKey UUID.nil
tests/SerializationFormatSpec.hs−4
@@ -3,9 +3,7 @@
3{-# LANGUAGE GADTs #-}
3{-# LANGUAGE GADTs #-}
4{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE NoImplicitPrelude #-}
5{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE OverloadedStrings #-}
6−#if __GLASGOW_HASKELL__ >= 708
7{-# LANGUAGE DataKinds #-}
6{-# LANGUAGE DataKinds #-}
8−#endif
9
7
10------------------------------------------------------------------------------
8------------------------------------------------------------------------------
11-- These tests assert that the JSON serialization doesn't change by accident.
9-- These tests assert that the JSON serialization doesn't change by accident.
@@ -77,10 +75,8 @@ jsonExamples =
77 , example "Just" "1" (Just 1 :: Maybe Int)
75 , example "Just" "1" (Just 1 :: Maybe Int)
78 , example "Proxy Int" "null" (Proxy :: Proxy Int)
76 , example "Proxy Int" "null" (Proxy :: Proxy Int)
79 , example "Tagged Char Int" "1" (Tagged 1 :: Tagged Char Int)
77 , example "Tagged Char Int" "1" (Tagged 1 :: Tagged Char Int)
80−#if __GLASGOW_HASKELL__ >= 708
81 -- Test Tagged instance is polykinded
78 -- Test Tagged instance is polykinded
82 , example "Tagged 123 Int" "1" (Tagged 1 :: Tagged 123 Int)
79 , example "Tagged 123 Int" "1" (Tagged 1 :: Tagged 123 Int)
83−#endif
84 , example "Const Char Int" "\"c\"" (Const 'c' :: Const Char Int)
80 , example "Const Char Int" "\"c\"" (Const 'c' :: Const Char Int)
85 , example "Tuple" "[1,2]" ((1, 2) :: (Int, Int))
81 , example "Tuple" "[1,2]" ((1, 2) :: (Int, Int))
86 , example "NonEmpty" "[1,2,3]" (1 :| [2, 3] :: NonEmpty Int)
82 , example "NonEmpty" "[1,2,3]" (1 :| [2, 3] :: NonEmpty Int)
tests/Types.hs−2
@@ -119,9 +119,7 @@ deriving instance Generic (Sum4 a b c d)
119deriving instance Generic (Approx a)
119deriving instance Generic (Approx a)
120deriving instance Generic Nullary
120deriving instance Generic Nullary
121deriving instance Generic (SomeType a)
121deriving instance Generic (SomeType a)
122−#if __GLASGOW_HASKELL__ >= 706
123deriving instance Generic1 SomeType
122deriving instance Generic1 SomeType
124−#endif
125deriving instance Generic OptionField
123deriving instance Generic OptionField
126deriving instance Generic EitherTextInt
124deriving instance Generic EitherTextInt
127
125
tests/UnitTests.hs+118−3
@@ -33,14 +33,15 @@ import Data.Aeson.Parser
33 ( json, jsonLast, jsonAccum, jsonNoDup
33 ( json, jsonLast, jsonAccum, jsonNoDup
34 , json', jsonLast', jsonAccum', jsonNoDup')
34 , json', jsonLast', jsonAccum', jsonNoDup')
35import Data.Aeson.Types
35import Data.Aeson.Types
36− ( Options(..), Result(Success), ToJSON(..), Value(Array, Bool, Null, Object)
36+ ( Options(..), Result(Success, Error), ToJSON(..)
37+ , Value(Array, Bool, Null, Number, Object, String), camelTo, camelTo2
37− , camelTo, camelTo2, defaultOptions, omitNothingFields, parse)
38+ , defaultOptions, formatPath, formatRelativePath, omitNothingFields, parse)
38import Data.Attoparsec.ByteString (Parser, parseOnly)
39import Data.Attoparsec.ByteString (Parser, parseOnly)
39import Data.Char (toUpper)
40import Data.Char (toUpper)
40import Data.Either.Compat (isLeft, isRight)
41import Data.Either.Compat (isLeft, isRight)
41import Data.Hashable (hash)
42import Data.Hashable (hash)
42import Data.HashMap.Strict (HashMap)
43import Data.HashMap.Strict (HashMap)
43−import Data.List (sort)
44+import Data.List (sort, isSuffixOf)
44import Data.Maybe (fromMaybe)
45import Data.Maybe (fromMaybe)
45import Data.Scientific (Scientific, scientific)
46import Data.Scientific (Scientific, scientific)
46import Data.Tagged (Tagged(..))
47import Data.Tagged (Tagged(..))
@@ -111,8 +112,12 @@ tests = testGroup "unit" [
111 , testGroup "SingleMaybeField" singleMaybeField
112 , testGroup "SingleMaybeField" singleMaybeField
112 , testCase "withEmbeddedJSON" withEmbeddedJSONTest
113 , testCase "withEmbeddedJSON" withEmbeddedJSONTest
113 , testCase "SingleFieldCon" singleFieldCon
114 , testCase "SingleFieldCon" singleFieldCon
115+ , testGroup "UnknownFields" unknownFields
114 , testGroup "Ordering of object keys" keyOrdering
116 , testGroup "Ordering of object keys" keyOrdering
115 , testCase "Ratio with denominator 0" ratioDenominator0
117 , testCase "Ratio with denominator 0" ratioDenominator0
118+ , testCase "Rational parses number" rationalNumber
119+ , testCase "Big rational" bigRationalDecoding
120+ , testCase "Small rational" smallRationalDecoding
116 , testCase "Big scientific exponent" bigScientificExponent
121 , testCase "Big scientific exponent" bigScientificExponent
117 , testCase "Big integer decoding" bigIntegerDecoding
122 , testCase "Big integer decoding" bigIntegerDecoding
118 , testCase "Big natural decading" bigNaturalDecoding
123 , testCase "Big natural decading" bigNaturalDecoding
@@ -253,6 +258,18 @@ formatErrorExample =
253 lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
258 lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
254 in assertEqual "formatError example" lhs rhs
259 in assertEqual "formatError example" lhs rhs
255
260
261+formatPathExample :: Assertion
262+formatPathExample =
263+ let rhs = formatPath [Key "x", Index 0]
264+ lhs = "$.x[0]"
265+ in assertEqual "formatPath example" lhs rhs
266+
267+formatRelativePathExample :: Assertion
268+formatRelativePathExample =
269+ let rhs = formatPath [Key "x", Index 0]
270+ lhs = ".x[0]"
271+ in assertEqual "formatRelativePath example" lhs rhs
272+
256------------------------------------------------------------------------------
273------------------------------------------------------------------------------
257-- Comparison (.:?) and (.:!)
274-- Comparison (.:?) and (.:!)
258------------------------------------------------------------------------------
275------------------------------------------------------------------------------
@@ -523,6 +540,7 @@ showOptions =
523 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"
540 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"
524 ++ ", unwrapUnaryRecords = False"
541 ++ ", unwrapUnaryRecords = False"
525 ++ ", tagSingleConstructors = False"
542 ++ ", tagSingleConstructors = False"
543+ ++ ", rejectUnknownFields = False"
526 ++ "}")
544 ++ "}")
527 (show defaultOptions)
545 (show defaultOptions)
528
546
@@ -567,6 +585,79 @@ singleFieldCon :: Assertion
567singleFieldCon =
585singleFieldCon =
568 assertEqual "fromJSON" (Right (SingleFieldCon 0)) (eitherDecode "0")
586 assertEqual "fromJSON" (Right (SingleFieldCon 0)) (eitherDecode "0")
569
587
588+newtype UnknownFields = UnknownFields { knownField :: Int }
589+ deriving (Eq, Show, Generic)
590+newtype UnknownFieldsTag = UnknownFieldsTag { tag :: Int }
591+ deriving (Eq, Show, Generic)
592+newtype UnknownFieldsUnaryTagged = UnknownFieldsUnaryTagged { knownFieldUnaryTagged :: Int }
593+ deriving (Eq, Show, Generic)
594+data UnknownFieldsSum
595+ = UnknownFields1 { knownField1 :: Int }
596+ | UnknownFields2 { knownField2 :: Int }
597+ deriving (Eq, Show, Generic)
598+
599+unknownFields :: [TestTree]
600+unknownFields = concat
601+ [ testsUnary
602+ "unary-unknown"
603+ (object [("knownField", Number 1), ("unknownField", Number 1)])
604+ (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFields)
605+ , testsUnary
606+ "unary-unknown-tag"
607+ (object [("knownField", Number 1), ("tag", String "UnknownFields")])
608+ (Error "nknown fields: [\"tag\"]" :: Result UnknownFields)
609+ , testsUnaryTag
610+ "unary-explicit-tag"
611+ (object [("tag", Number 1)])
612+ (Success $ UnknownFieldsTag 1)
613+ , testsSum
614+ "sum-tag"
615+ (object [("knownField1", Number 1), ("tag", String "UnknownFields1")])
616+ (Success $ UnknownFields1 1)
617+ , testsSum
618+ "sum-unknown-in-branch"
619+ (object [("knownField1", Number 1), ("knownField2", Number 1), ("tag", String "UnknownFields1")])
620+ (Error "nknown fields: [\"knownField2\"]" :: Result UnknownFieldsSum)
621+ , testsSum
622+ "sum-unknown"
623+ (object [("knownField1", Number 1), ("unknownField", Number 1), ("tag", String "UnknownFields1")])
624+ (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFieldsSum)
625+ , testsTagged
626+ "unary-tagged"
627+ (object [("knownFieldUnaryTagged", Number 1), ("tag", String "UnknownFieldsUnaryTagged")])
628+ (Success $ UnknownFieldsUnaryTagged 1)
629+ , -- Just a case to verify that the tag isn't optional, this is likely already tested by other unit tests
630+ testsTagged
631+ "unary-tagged-notag"
632+ (object [("knownFieldUnaryTagged", Number 1)])
633+ (Error "key \"tag\" not found" :: Result UnknownFieldsUnaryTagged)
634+ , testsTagged
635+ "unary-tagged-unknown"
636+ (object [ ("knownFieldUnaryTagged", Number 1), ("unknownField", Number 1)
637+ , ("tag", String "UnknownFieldsUnaryTagged")])
638+ (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFieldsUnaryTagged)
639+ ]
640+ where
641+ opts = defaultOptions{rejectUnknownFields=True}
642+ taggedOpts = opts{tagSingleConstructors=True}
643+ assertApprox :: (Show a, Eq a) => Result a -> Result a -> IO ()
644+ assertApprox (Error expected) (Error actual) | expected `isSuffixOf` actual = return ()
645+ assertApprox expected actual = assertEqual "fromJSON" expected actual
646+ testsBase :: (Show a, Eq a) => (Value -> Result a) -> (Value -> Result a)
647+ -> String -> Value -> Result a -> [TestTree]
648+ testsBase th g name value expected =
649+ [ testCase (name ++ "-th") $ assertApprox expected (th value)
650+ , testCase (name ++ "-generic") $ assertApprox expected (g value)
651+ ]
652+ testsUnary :: String -> Value -> Result UnknownFields -> [TestTree]
653+ testsUnary = testsBase fromJSON (parse (genericParseJSON opts))
654+ testsUnaryTag :: String -> Value -> Result UnknownFieldsTag -> [TestTree]
655+ testsUnaryTag = testsBase fromJSON (parse (genericParseJSON opts))
656+ testsSum :: String -> Value -> Result UnknownFieldsSum -> [TestTree]
657+ testsSum = testsBase fromJSON (parse (genericParseJSON opts))
658+ testsTagged :: String -> Value -> Result UnknownFieldsUnaryTagged -> [TestTree]
659+ testsTagged = testsBase fromJSON (parse (genericParseJSON taggedOpts))
660+
570testParser :: (Eq a, Show a)
661testParser :: (Eq a, Show a)
571 => String -> Parser a -> S.ByteString -> Either String a -> TestTree
662 => String -> Parser a -> S.ByteString -> Either String a -> TestTree
572testParser name json_ s expected =
663testParser name json_ s expected =
@@ -607,6 +698,25 @@ ratioDenominator0 =
607 (Left "Error in $: Ratio denominator was 0")
698 (Left "Error in $: Ratio denominator was 0")
608 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)
699 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)
609
700
701+rationalNumber :: Assertion
702+rationalNumber =
703+ assertEqual "Ratio with denominator 0"
704+ (Right 1.37)
705+ (eitherDecode "1.37" :: Either String Rational)
706+
707+bigRationalDecoding :: Assertion
708+bigRationalDecoding =
709+ assertEqual "Decoding an Integer with a large exponent should fail"
710+ (Left "Error in $: parsing Ratio failed, found a number with exponent 2000, but it must not be greater than 1024 or less than -1024")
711+ ((eitherDecode :: L.ByteString -> Either String Rational) "1e2000")
712+
713+smallRationalDecoding :: Assertion
714+smallRationalDecoding =
715+ assertEqual "Decoding an Integer with a large exponent should fail"
716+ (Left "Error in $: parsing Ratio failed, found a number with exponent -2000, but it must not be greater than 1024 or less than -1024")
717+ ((eitherDecode :: L.ByteString -> Either String Rational) "1e-2000")
718+
719+
610bigScientificExponent :: Assertion
720bigScientificExponent :: Assertion
611bigScientificExponent =
721bigScientificExponent =
612 assertEqual "Encoding an integral scientific with a large exponent should normalize it"
722 assertEqual "Encoding an integral scientific with a large exponent should normalize it"
@@ -643,3 +753,8 @@ deriveToJSON defaultOptions ''Foo
643deriveToJSON1 defaultOptions ''Foo
753deriveToJSON1 defaultOptions ''Foo
644
754
645deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField
755deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField
756+
757+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFields
758+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag
759+deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged
760+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum
tests/golden/generic.expected+11−3
@@ -6,11 +6,11 @@ Error in $: parsing Types.Nullary failed, expected one of the tags ["C1","C2","C
6Error in $: parsing Types.Nullary failed, expected String, but encountered Array
6Error in $: parsing Types.Nullary failed, expected String, but encountered Array
7SomeType (tagged)
7SomeType (tagged)
8Error in $.contents: parsing Int failed, expected Number, but encountered Boolean
8Error in $.contents: parsing Int failed, expected Number, but encountered Boolean
9−Error in $: parsing Types.SomeType(Unary) failed, key "contents" not present
9+Error in $: parsing Types.SomeType(Unary) failed, key "contents" not found
10−Error in $: parsing Types.SomeType(Record) failed, key "testone" not present
10+Error in $: parsing Types.SomeType(Record) failed, key "testone" not found
11Error in $.testone: parsing Double failed, unexpected Boolean
11Error in $.testone: parsing Double failed, unexpected Boolean
12Error in $.tag: parsing Types.SomeType failed, expected tag field to be one of ["nullary","unary","product","record","list"], but found tag "X"
12Error in $.tag: parsing Types.SomeType failed, expected tag field to be one of ["nullary","unary","product","record","list"], but found tag "X"
13−Error in $: parsing Types.SomeType failed, key "tag" not present
13+Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found
14Error in $: parsing Types.SomeType failed, expected Object, but encountered Array
14Error in $: parsing Types.SomeType failed, expected Object, but encountered Array
15SomeType (single-field)
15SomeType (single-field)
16Error in $.unary: parsing Int failed, expected Number, but encountered Object
16Error in $.unary: parsing Int failed, expected Number, but encountered Object
@@ -31,6 +31,14 @@ Error in $: parsing Types.SomeType failed, expected a 2-element Array, but encou
31Error in $: parsing Types.SomeType failed, expected Array, but encountered Object
31Error in $: parsing Types.SomeType failed, expected Array, but encountered Object
32Error in $: not enough input. Expecting ',' or ']'
32Error in $: not enough input. Expecting ',' or ']'
33Error in $: not enough input. Expecting json list value
33Error in $: not enough input. Expecting json list value
34+SomeType (reject unknown fields)
35+Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testZero"]
36+Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found
37+Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testtwo","testone","testthree"]
38+Foo (reject unknown fields)
39+Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["tag"]
40+Foo (reject unknown fields, tagged single)
41+Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["unknownField"]
34EitherTextInt
42EitherTextInt
35Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected tag "nonenullary", but found tag "X"
43Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected tag "nonenullary", but found tag "X"
36Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected String, but encountered Array
44Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected String, but encountered Array
travis/cabal_macros.hnew file+448
@@ -0,0 +1,448 @@
1+/* DO NOT EDIT: This file is automatically generated by Cabal */
2+
3+/* package aeson-1.4.4.0 */
4+#ifndef VERSION_aeson
5+#define VERSION_aeson "1.4.4.0"
6+#endif /* VERSION_aeson */
7+#ifndef MIN_VERSION_aeson
8+#define MIN_VERSION_aeson(major1,major2,minor) (\
9+ (major1) < 1 || \
10+ (major1) == 1 && (major2) < 4 || \
11+ (major1) == 1 && (major2) == 4 && (minor) <= 4)
12+#endif /* MIN_VERSION_aeson */
13+
14+/* package Diff-0.3.4 */
15+#ifndef VERSION_Diff
16+#define VERSION_Diff "0.3.4"
17+#endif /* VERSION_Diff */
18+#ifndef MIN_VERSION_Diff
19+#define MIN_VERSION_Diff(major1,major2,minor) (\
20+ (major1) < 0 || \
21+ (major1) == 0 && (major2) < 3 || \
22+ (major1) == 0 && (major2) == 3 && (minor) <= 4)
23+#endif /* MIN_VERSION_Diff */
24+
25+/* package QuickCheck-2.13.1 */
26+#ifndef VERSION_QuickCheck
27+#define VERSION_QuickCheck "2.13.1"
28+#endif /* VERSION_QuickCheck */
29+#ifndef MIN_VERSION_QuickCheck
30+#define MIN_VERSION_QuickCheck(major1,major2,minor) (\
31+ (major1) < 2 || \
32+ (major1) == 2 && (major2) < 13 || \
33+ (major1) == 2 && (major2) == 13 && (minor) <= 1)
34+#endif /* MIN_VERSION_QuickCheck */
35+
36+/* package aeson-1.4.4.0 */
37+#ifndef VERSION_aeson
38+#define VERSION_aeson "1.4.4.0"
39+#endif /* VERSION_aeson */
40+#ifndef MIN_VERSION_aeson
41+#define MIN_VERSION_aeson(major1,major2,minor) (\
42+ (major1) < 1 || \
43+ (major1) == 1 && (major2) < 4 || \
44+ (major1) == 1 && (major2) == 4 && (minor) <= 4)
45+#endif /* MIN_VERSION_aeson */
46+
47+/* package attoparsec-0.13.2.2 */
48+#ifndef VERSION_attoparsec
49+#define VERSION_attoparsec "0.13.2.2"
50+#endif /* VERSION_attoparsec */
51+#ifndef MIN_VERSION_attoparsec
52+#define MIN_VERSION_attoparsec(major1,major2,minor) (\
53+ (major1) < 0 || \
54+ (major1) == 0 && (major2) < 13 || \
55+ (major1) == 0 && (major2) == 13 && (minor) <= 2)
56+#endif /* MIN_VERSION_attoparsec */
57+
58+/* package base-4.12.0.0 */
59+#ifndef VERSION_base
60+#define VERSION_base "4.12.0.0"
61+#endif /* VERSION_base */
62+#ifndef MIN_VERSION_base
63+#define MIN_VERSION_base(major1,major2,minor) (\
64+ (major1) < 4 || \
65+ (major1) == 4 && (major2) < 12 || \
66+ (major1) == 4 && (major2) == 12 && (minor) <= 0)
67+#endif /* MIN_VERSION_base */
68+
69+/* package base-compat-0.10.5 */
70+#ifndef VERSION_base_compat
71+#define VERSION_base_compat "0.10.5"
72+#endif /* VERSION_base_compat */
73+#ifndef MIN_VERSION_base_compat
74+#define MIN_VERSION_base_compat(major1,major2,minor) (\
75+ (major1) < 0 || \
76+ (major1) == 0 && (major2) < 10 || \
77+ (major1) == 0 && (major2) == 10 && (minor) <= 5)
78+#endif /* MIN_VERSION_base_compat */
79+
80+/* package base-orphans-0.8.1 */
81+#ifndef VERSION_base_orphans
82+#define VERSION_base_orphans "0.8.1"
83+#endif /* VERSION_base_orphans */
84+#ifndef MIN_VERSION_base_orphans
85+#define MIN_VERSION_base_orphans(major1,major2,minor) (\
86+ (major1) < 0 || \
87+ (major1) == 0 && (major2) < 8 || \
88+ (major1) == 0 && (major2) == 8 && (minor) <= 1)
89+#endif /* MIN_VERSION_base_orphans */
90+
91+/* package base16-bytestring-0.1.1.6 */
92+#ifndef VERSION_base16_bytestring
93+#define VERSION_base16_bytestring "0.1.1.6"
94+#endif /* VERSION_base16_bytestring */
95+#ifndef MIN_VERSION_base16_bytestring
96+#define MIN_VERSION_base16_bytestring(major1,major2,minor) (\
97+ (major1) < 0 || \
98+ (major1) == 0 && (major2) < 1 || \
99+ (major1) == 0 && (major2) == 1 && (minor) <= 1)
100+#endif /* MIN_VERSION_base16_bytestring */
101+
102+/* package bytestring-0.10.8.2 */
103+#ifndef VERSION_bytestring
104+#define VERSION_bytestring "0.10.8.2"
105+#endif /* VERSION_bytestring */
106+#ifndef MIN_VERSION_bytestring
107+#define MIN_VERSION_bytestring(major1,major2,minor) (\
108+ (major1) < 0 || \
109+ (major1) == 0 && (major2) < 10 || \
110+ (major1) == 0 && (major2) == 10 && (minor) <= 8)
111+#endif /* MIN_VERSION_bytestring */
112+
113+/* package containers-0.6.0.1 */
114+#ifndef VERSION_containers
115+#define VERSION_containers "0.6.0.1"
116+#endif /* VERSION_containers */
117+#ifndef MIN_VERSION_containers
118+#define MIN_VERSION_containers(major1,major2,minor) (\
119+ (major1) < 0 || \
120+ (major1) == 0 && (major2) < 6 || \
121+ (major1) == 0 && (major2) == 6 && (minor) <= 0)
122+#endif /* MIN_VERSION_containers */
123+
124+/* package directory-1.3.3.0 */
125+#ifndef VERSION_directory
126+#define VERSION_directory "1.3.3.0"
127+#endif /* VERSION_directory */
128+#ifndef MIN_VERSION_directory
129+#define MIN_VERSION_directory(major1,major2,minor) (\
130+ (major1) < 1 || \
131+ (major1) == 1 && (major2) < 3 || \
132+ (major1) == 1 && (major2) == 3 && (minor) <= 3)
133+#endif /* MIN_VERSION_directory */
134+
135+/* package dlist-0.8.0.6 */
136+#ifndef VERSION_dlist
137+#define VERSION_dlist "0.8.0.6"
138+#endif /* VERSION_dlist */
139+#ifndef MIN_VERSION_dlist
140+#define MIN_VERSION_dlist(major1,major2,minor) (\
141+ (major1) < 0 || \
142+ (major1) == 0 && (major2) < 8 || \
143+ (major1) == 0 && (major2) == 8 && (minor) <= 0)
144+#endif /* MIN_VERSION_dlist */
145+
146+/* package filepath-1.4.2.1 */
147+#ifndef VERSION_filepath
148+#define VERSION_filepath "1.4.2.1"
149+#endif /* VERSION_filepath */
150+#ifndef MIN_VERSION_filepath
151+#define MIN_VERSION_filepath(major1,major2,minor) (\
152+ (major1) < 1 || \
153+ (major1) == 1 && (major2) < 4 || \
154+ (major1) == 1 && (major2) == 4 && (minor) <= 2)
155+#endif /* MIN_VERSION_filepath */
156+
157+/* package generic-deriving-1.12.4 */
158+#ifndef VERSION_generic_deriving
159+#define VERSION_generic_deriving "1.12.4"
160+#endif /* VERSION_generic_deriving */
161+#ifndef MIN_VERSION_generic_deriving
162+#define MIN_VERSION_generic_deriving(major1,major2,minor) (\
163+ (major1) < 1 || \
164+ (major1) == 1 && (major2) < 12 || \
165+ (major1) == 1 && (major2) == 12 && (minor) <= 4)
166+#endif /* MIN_VERSION_generic_deriving */
167+
168+/* package ghc-prim-0.5.3 */
169+#ifndef VERSION_ghc_prim
170+#define VERSION_ghc_prim "0.5.3"
171+#endif /* VERSION_ghc_prim */
172+#ifndef MIN_VERSION_ghc_prim
173+#define MIN_VERSION_ghc_prim(major1,major2,minor) (\
174+ (major1) < 0 || \
175+ (major1) == 0 && (major2) < 5 || \
176+ (major1) == 0 && (major2) == 5 && (minor) <= 3)
177+#endif /* MIN_VERSION_ghc_prim */
178+
179+/* package hashable-1.3.0.0 */
180+#ifndef VERSION_hashable
181+#define VERSION_hashable "1.3.0.0"
182+#endif /* VERSION_hashable */
183+#ifndef MIN_VERSION_hashable
184+#define MIN_VERSION_hashable(major1,major2,minor) (\
185+ (major1) < 1 || \
186+ (major1) == 1 && (major2) < 3 || \
187+ (major1) == 1 && (major2) == 3 && (minor) <= 0)
188+#endif /* MIN_VERSION_hashable */
189+
190+/* package hashable-time-0.2.0.2 */
191+#ifndef VERSION_hashable_time
192+#define VERSION_hashable_time "0.2.0.2"
193+#endif /* VERSION_hashable_time */
194+#ifndef MIN_VERSION_hashable_time
195+#define MIN_VERSION_hashable_time(major1,major2,minor) (\
196+ (major1) < 0 || \
197+ (major1) == 0 && (major2) < 2 || \
198+ (major1) == 0 && (major2) == 2 && (minor) <= 0)
199+#endif /* MIN_VERSION_hashable_time */
200+
201+/* package integer-logarithms-1.0.3 */
202+#ifndef VERSION_integer_logarithms
203+#define VERSION_integer_logarithms "1.0.3"
204+#endif /* VERSION_integer_logarithms */
205+#ifndef MIN_VERSION_integer_logarithms
206+#define MIN_VERSION_integer_logarithms(major1,major2,minor) (\
207+ (major1) < 1 || \
208+ (major1) == 1 && (major2) < 0 || \
209+ (major1) == 1 && (major2) == 0 && (minor) <= 3)
210+#endif /* MIN_VERSION_integer_logarithms */
211+
212+/* package quickcheck-instances-0.3.21 */
213+#ifndef VERSION_quickcheck_instances
214+#define VERSION_quickcheck_instances "0.3.21"
215+#endif /* VERSION_quickcheck_instances */
216+#ifndef MIN_VERSION_quickcheck_instances
217+#define MIN_VERSION_quickcheck_instances(major1,major2,minor) (\
218+ (major1) < 0 || \
219+ (major1) == 0 && (major2) < 3 || \
220+ (major1) == 0 && (major2) == 3 && (minor) <= 21)
221+#endif /* MIN_VERSION_quickcheck_instances */
222+
223+/* package scientific-0.3.6.2 */
224+#ifndef VERSION_scientific
225+#define VERSION_scientific "0.3.6.2"
226+#endif /* VERSION_scientific */
227+#ifndef MIN_VERSION_scientific
228+#define MIN_VERSION_scientific(major1,major2,minor) (\
229+ (major1) < 0 || \
230+ (major1) == 0 && (major2) < 3 || \
231+ (major1) == 0 && (major2) == 3 && (minor) <= 6)
232+#endif /* MIN_VERSION_scientific */
233+
234+/* package tagged-0.8.6 */
235+#ifndef VERSION_tagged
236+#define VERSION_tagged "0.8.6"
237+#endif /* VERSION_tagged */
238+#ifndef MIN_VERSION_tagged
239+#define MIN_VERSION_tagged(major1,major2,minor) (\
240+ (major1) < 0 || \
241+ (major1) == 0 && (major2) < 8 || \
242+ (major1) == 0 && (major2) == 8 && (minor) <= 6)
243+#endif /* MIN_VERSION_tagged */
244+
245+/* package tasty-1.2.3 */
246+#ifndef VERSION_tasty
247+#define VERSION_tasty "1.2.3"
248+#endif /* VERSION_tasty */
249+#ifndef MIN_VERSION_tasty
250+#define MIN_VERSION_tasty(major1,major2,minor) (\
251+ (major1) < 1 || \
252+ (major1) == 1 && (major2) < 2 || \
253+ (major1) == 1 && (major2) == 2 && (minor) <= 3)
254+#endif /* MIN_VERSION_tasty */
255+
256+/* package tasty-golden-2.3.2 */
257+#ifndef VERSION_tasty_golden
258+#define VERSION_tasty_golden "2.3.2"
259+#endif /* VERSION_tasty_golden */
260+#ifndef MIN_VERSION_tasty_golden
261+#define MIN_VERSION_tasty_golden(major1,major2,minor) (\
262+ (major1) < 2 || \
263+ (major1) == 2 && (major2) < 3 || \
264+ (major1) == 2 && (major2) == 3 && (minor) <= 2)
265+#endif /* MIN_VERSION_tasty_golden */
266+
267+/* package tasty-hunit-0.10.0.2 */
268+#ifndef VERSION_tasty_hunit
269+#define VERSION_tasty_hunit "0.10.0.2"
270+#endif /* VERSION_tasty_hunit */
271+#ifndef MIN_VERSION_tasty_hunit
272+#define MIN_VERSION_tasty_hunit(major1,major2,minor) (\
273+ (major1) < 0 || \
274+ (major1) == 0 && (major2) < 10 || \
275+ (major1) == 0 && (major2) == 10 && (minor) <= 0)
276+#endif /* MIN_VERSION_tasty_hunit */
277+
278+/* package tasty-quickcheck-0.10.1 */
279+#ifndef VERSION_tasty_quickcheck
280+#define VERSION_tasty_quickcheck "0.10.1"
281+#endif /* VERSION_tasty_quickcheck */
282+#ifndef MIN_VERSION_tasty_quickcheck
283+#define MIN_VERSION_tasty_quickcheck(major1,major2,minor) (\
284+ (major1) < 0 || \
285+ (major1) == 0 && (major2) < 10 || \
286+ (major1) == 0 && (major2) == 10 && (minor) <= 1)
287+#endif /* MIN_VERSION_tasty_quickcheck */
288+
289+/* package template-haskell-2.14.0.0 */
290+#ifndef VERSION_template_haskell
291+#define VERSION_template_haskell "2.14.0.0"
292+#endif /* VERSION_template_haskell */
293+#ifndef MIN_VERSION_template_haskell
294+#define MIN_VERSION_template_haskell(major1,major2,minor) (\
295+ (major1) < 2 || \
296+ (major1) == 2 && (major2) < 14 || \
297+ (major1) == 2 && (major2) == 14 && (minor) <= 0)
298+#endif /* MIN_VERSION_template_haskell */
299+
300+/* package text-1.2.3.1 */
301+#ifndef VERSION_text
302+#define VERSION_text "1.2.3.1"
303+#endif /* VERSION_text */
304+#ifndef MIN_VERSION_text
305+#define MIN_VERSION_text(major1,major2,minor) (\
306+ (major1) < 1 || \
307+ (major1) == 1 && (major2) < 2 || \
308+ (major1) == 1 && (major2) == 2 && (minor) <= 3)
309+#endif /* MIN_VERSION_text */
310+
311+/* package time-1.8.0.2 */
312+#ifndef VERSION_time
313+#define VERSION_time "1.8.0.2"
314+#endif /* VERSION_time */
315+#ifndef MIN_VERSION_time
316+#define MIN_VERSION_time(major1,major2,minor) (\
317+ (major1) < 1 || \
318+ (major1) == 1 && (major2) < 8 || \
319+ (major1) == 1 && (major2) == 8 && (minor) <= 0)
320+#endif /* MIN_VERSION_time */
321+
322+/* package time-compat-1.9.2.2 */
323+#ifndef VERSION_time_compat
324+#define VERSION_time_compat "1.9.2.2"
325+#endif /* VERSION_time_compat */
326+#ifndef MIN_VERSION_time_compat
327+#define MIN_VERSION_time_compat(major1,major2,minor) (\
328+ (major1) < 1 || \
329+ (major1) == 1 && (major2) < 9 || \
330+ (major1) == 1 && (major2) == 9 && (minor) <= 2)
331+#endif /* MIN_VERSION_time_compat */
332+
333+/* package unordered-containers-0.2.10.0 */
334+#ifndef VERSION_unordered_containers
335+#define VERSION_unordered_containers "0.2.10.0"
336+#endif /* VERSION_unordered_containers */
337+#ifndef MIN_VERSION_unordered_containers
338+#define MIN_VERSION_unordered_containers(major1,major2,minor) (\
339+ (major1) < 0 || \
340+ (major1) == 0 && (major2) < 2 || \
341+ (major1) == 0 && (major2) == 2 && (minor) <= 10)
342+#endif /* MIN_VERSION_unordered_containers */
343+
344+/* package uuid-types-1.0.3 */
345+#ifndef VERSION_uuid_types
346+#define VERSION_uuid_types "1.0.3"
347+#endif /* VERSION_uuid_types */
348+#ifndef MIN_VERSION_uuid_types
349+#define MIN_VERSION_uuid_types(major1,major2,minor) (\
350+ (major1) < 1 || \
351+ (major1) == 1 && (major2) < 0 || \
352+ (major1) == 1 && (major2) == 0 && (minor) <= 3)
353+#endif /* MIN_VERSION_uuid_types */
354+
355+/* package vector-0.12.0.3 */
356+#ifndef VERSION_vector
357+#define VERSION_vector "0.12.0.3"
358+#endif /* VERSION_vector */
359+#ifndef MIN_VERSION_vector
360+#define MIN_VERSION_vector(major1,major2,minor) (\
361+ (major1) < 0 || \
362+ (major1) == 0 && (major2) < 12 || \
363+ (major1) == 0 && (major2) == 12 && (minor) <= 0)
364+#endif /* MIN_VERSION_vector */
365+
366+/* tool gcc-4.2.1 */
367+#ifndef TOOL_VERSION_gcc
368+#define TOOL_VERSION_gcc "4.2.1"
369+#endif /* TOOL_VERSION_gcc */
370+#ifndef MIN_TOOL_VERSION_gcc
371+#define MIN_TOOL_VERSION_gcc(major1,major2,minor) (\
372+ (major1) < 4 || \
373+ (major1) == 4 && (major2) < 2 || \
374+ (major1) == 4 && (major2) == 2 && (minor) <= 1)
375+#endif /* MIN_TOOL_VERSION_gcc */
376+
377+/* tool ghc-8.6.5 */
378+#ifndef TOOL_VERSION_ghc
379+#define TOOL_VERSION_ghc "8.6.5"
380+#endif /* TOOL_VERSION_ghc */
381+#ifndef MIN_TOOL_VERSION_ghc
382+#define MIN_TOOL_VERSION_ghc(major1,major2,minor) (\
383+ (major1) < 8 || \
384+ (major1) == 8 && (major2) < 6 || \
385+ (major1) == 8 && (major2) == 6 && (minor) <= 5)
386+#endif /* MIN_TOOL_VERSION_ghc */
387+
388+/* tool ghc-pkg-8.6.5 */
389+#ifndef TOOL_VERSION_ghc_pkg
390+#define TOOL_VERSION_ghc_pkg "8.6.5"
391+#endif /* TOOL_VERSION_ghc_pkg */
392+#ifndef MIN_TOOL_VERSION_ghc_pkg
393+#define MIN_TOOL_VERSION_ghc_pkg(major1,major2,minor) (\
394+ (major1) < 8 || \
395+ (major1) == 8 && (major2) < 6 || \
396+ (major1) == 8 && (major2) == 6 && (minor) <= 5)
397+#endif /* MIN_TOOL_VERSION_ghc_pkg */
398+
399+/* tool haddock-2.22.0 */
400+#ifndef TOOL_VERSION_haddock
401+#define TOOL_VERSION_haddock "2.22.0"
402+#endif /* TOOL_VERSION_haddock */
403+#ifndef MIN_TOOL_VERSION_haddock
404+#define MIN_TOOL_VERSION_haddock(major1,major2,minor) (\
405+ (major1) < 2 || \
406+ (major1) == 2 && (major2) < 22 || \
407+ (major1) == 2 && (major2) == 22 && (minor) <= 0)
408+#endif /* MIN_TOOL_VERSION_haddock */
409+
410+/* tool hpc-0.67 */
411+#ifndef TOOL_VERSION_hpc
412+#define TOOL_VERSION_hpc "0.67"
413+#endif /* TOOL_VERSION_hpc */
414+#ifndef MIN_TOOL_VERSION_hpc
415+#define MIN_TOOL_VERSION_hpc(major1,major2,minor) (\
416+ (major1) < 0 || \
417+ (major1) == 0 && (major2) < 67 || \
418+ (major1) == 0 && (major2) == 67 && (minor) <= 0)
419+#endif /* MIN_TOOL_VERSION_hpc */
420+
421+/* tool hsc2hs-0.68.5 */
422+#ifndef TOOL_VERSION_hsc2hs
423+#define TOOL_VERSION_hsc2hs "0.68.5"
424+#endif /* TOOL_VERSION_hsc2hs */
425+#ifndef MIN_TOOL_VERSION_hsc2hs
426+#define MIN_TOOL_VERSION_hsc2hs(major1,major2,minor) (\
427+ (major1) < 0 || \
428+ (major1) == 0 && (major2) < 68 || \
429+ (major1) == 0 && (major2) == 68 && (minor) <= 5)
430+#endif /* MIN_TOOL_VERSION_hsc2hs */
431+
432+/* tool runghc-8.6.5 */
433+#ifndef TOOL_VERSION_runghc
434+#define TOOL_VERSION_runghc "8.6.5"
435+#endif /* TOOL_VERSION_runghc */
436+#ifndef MIN_TOOL_VERSION_runghc
437+#define MIN_TOOL_VERSION_runghc(major1,major2,minor) (\
438+ (major1) < 8 || \
439+ (major1) == 8 && (major2) < 6 || \
440+ (major1) == 8 && (major2) == 6 && (minor) <= 5)
441+#endif /* MIN_TOOL_VERSION_runghc */
442+
443+#ifndef CURRENT_COMPONENT_ID
444+#define CURRENT_COMPONENT_ID "aeson-1.4.4.0-inplace-tests"
445+#endif /* CURRENT_COMPONENT_ID */
446+#ifndef CURRENT_PACKAGE_VERSION
447+#define CURRENT_PACKAGE_VERSION "1.4.4.0"
448+#endif /* CURRENT_PACKAGE_VERSION */
travis/install.sh+11
@@ -7,6 +7,11 @@ echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo
7stack --version
7stack --version
8
8
9case $BUILD in
9case $BUILD in
10+ hlint)
11+ echo "Downloading hlint"
12+ curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh > hlint.sh
13+ chmod +x hlint.sh
14+ ;;
10 stack)
15 stack)
11 stack --no-terminal --skip-ghc-check setup
16 stack --no-terminal --skip-ghc-check setup
12 stack --no-terminal --skip-ghc-check test --only-snapshot
17 stack --no-terminal --skip-ghc-check test --only-snapshot
@@ -44,4 +49,10 @@ case $BUILD in
44 cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
49 cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
45 fi
50 fi
46 ;;
51 ;;
52+ cabal2)
53+ cabal v2-update -v
54+ sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
55+
56+ cabal v2-build --only-dependencies --enable-tests --enable-benchmarks --dry
57+ ;;
47esac
58esac
travis/script.sh+4−2
@@ -19,9 +19,11 @@ case $BUILD in
19 SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
19 SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
20 (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
20 (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
21 ;;
21 ;;
22+ cabal2)
23+ cabal v2-build --enable-tests --enable-benchmarks
24+ cabal v2-test --enable-tests --enable-benchmarks
25+ ;;
22 hlint)
26 hlint)
23− stack build --fast aeson --stack-yaml stack-nightly.yaml --system-ghc --no-terminal
24− stack install hlint --stack-yaml stack-nightly.yaml --system-ghc --no-terminal
25 make lint
27 make lint
26 ;;
28 ;;
27esac
29esac