1bd485c...master · typeable/aeson

git.iko.soy/typeable/aeson

38 files changed+1055−317

since splitsnapshots

unifiedsplit

.gitignore+1 .hlint.yaml+6−1 .travis.yml+34−23 CONTRIBUTING.md+38 Data/Aeson/Compat.hs−16 Data/Aeson/Parser/Internal.hs+30−27 Data/Aeson/TH.hs+24−38 Data/Aeson/Types.hs+8 Data/Aeson/Types/FromJSON.hs+90−67 Data/Aeson/Types/Internal.hs+26−5 Data/Aeson/Types/ToJSON.hs+3−43 Makefile+1−1 aeson.cabal+9−15 attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs−20 attoparsec-iso8601/attoparsec-iso8601.cabal+2−2 benchmarks/AesonEncode.hs+1−1 benchmarks/Compare/JsonBench.hs+2−1 benchmarks/Issue673.hs+1 benchmarks/aeson-benchmarks.cabal+7−1 cabal.project+3−1 changelog.md+56 run-hlint.sh+7 stack-bench.yaml+2−8 stack-ffi-unescape.yaml+2−7 stack-nightly.yaml+2−4 tests/Encoders.hs+25−6 tests/ErrorMessages.hs+27−1 tests/Instances.hs+1−4 tests/Options.hs+11 tests/PropertyGeneric.hs−8 tests/PropertyKeys.hs−3 tests/SerializationFormatSpec.hs−4 tests/Types.hs−2 tests/UnitTests.hs+162−3 tests/golden/generic.expected+11−3 travis/cabal_macros.h+448 travis/install.sh+11 travis/script.sh+4−2

.gitignore+1

@@ -5,6 +5,7 @@ dist-newstyle

55cabal.sandbox.config

66.stack-work/

77.stack-work-bench/

8+*.yaml.lock

910*.o

1011*.hi

.hlint.yaml+6−1

@@ -3,4 +3,9 @@

33 name: "Reduce duplication"

44 within:

55 - Data.Aeson.Types.ToJSON

6−- ignore: {name: "Eta reduce" }

6+- ignore:

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:

1212 - $HOME/.stack

1313 - $HOME/.cabsnap

1414 - $HOME/.cabal/packages

15+ - $HOME/.cabal/store

1516

1617before_cache:

1718 - 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

1924

2025matrix:

2126 include:

22− - env: BUILD=hlint CABALVER=2.2 GHCVER=8.4.3

23− compiler: ": #GHC 8.4.3"

24− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}

25− - env: BUILD=stack CABALVER=2.2 GHCVER=8.4.3 STACK_YAML=stack-bench.yaml

26− compiler: ": #GHC 8.4.3"

27− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}

28− - env: BUILD=stack CABALVER=2.2 GHCVER=8.4.3 STACK_YAML=stack-ffi-unescape.yaml

29− compiler: ": #GHC 8.4.3"

30− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}

31−

32− - env: BUILD=cabal CABALVER=2.4 GHCVER=8.6.1

33− compiler: ": #GHC 8.6.1"

34− addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}}

35− - env: BUILD=cabal CABALVER=2.2 GHCVER=8.4.3

36− compiler: ": #GHC 8.4.3"

37− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}

27+

28+ - env: BUILD=hlint CABALVER=2.2 GHCVER=8.4.4

29+ compiler: ": #GHC 8.4.4"

30+ addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.4], sources: [hvr-ghc]}}

31+

32+ - env: BUILD=stack CABALVER=2.4 GHCVER=8.6.5 STACK_YAML=stack-bench.yaml

33+ compiler: ": #GHC 8.6.5"

34+ addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.5], sources: [hvr-ghc]}}

35+

36+ - env: BUILD=stack CABALVER=2.2 GHCVER=8.6.5 STACK_YAML=stack-ffi-unescape.yaml

37+ compiler: ": #GHC 8.6.5"

38+ addons: {apt: {packages: [cabal-install-2.2,ghc-8.6.5], sources: [hvr-ghc]}}

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+

44+ - env: BUILD=cabal CABALVER=2.4 GHCVER=8.6.5

45+ compiler: ": #GHC 8.6.5"

46+ addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.5], sources: [hvr-ghc]}}

47+

48+ - env: BUILD=cabal CABALVER=2.2 GHCVER=8.4.4

49+ compiler: ": #GHC 8.4.4"

50+ addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.4], sources: [hvr-ghc]}}

51+

3852 - env: BUILD=cabal CABALVER=2.0 GHCVER=8.2.2

3953 compiler: ": #GHC 8.2.2"

4054 addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}

55+

4156 - env: BUILD=cabal CABALVER=2.0 GHCVER=8.0.2

4257 compiler: ": #GHC 8.0.2"

4358 addons: {apt: {packages: [cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}

59+

4460 - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3

4561 compiler: ": #GHC 7.10.3"

4662 addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}

63+

4764 - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4

4865 compiler: ": #GHC 7.8.4"

4966 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]}}

5667

5768before_install:

5869 - unset CC

CONTRIBUTING.md+38

@@ -58,3 +58,41 @@ import Foo as F

5858import Qux (Q(..), q)

5959import qualified A

6060```

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/Parser/Internal.hs+30−27

@@ -5,6 +5,10 @@

55#if MIN_VERSION_ghc_prim(0,3,1)

66{-# LANGUAGE MagicHash #-}

77#endif

8+#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706

9+-- Work around a compiler bug

10+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}

11+#endif

812-- |

913-- Module: Data.Aeson.Parser.Internal

@@ -126,15 +130,15 @@ json' = value'

126130

127131-- Open recursion: object_, object_', array_, array_' are parameterized by the

128132-- toplevel Value parser to be called recursively, to keep the parameter

129−-- hFromList outside of the recursive loop for proper inlining.

133+-- mkObject outside of the recursive loop for proper inlining.

130134

131−object_ :: HFromList -> Parser Value -> Parser Value

132−object_ hFromList val = {-# SCC "object_" #-} Object <$> objectValues hFromList jstring val

135+object_ :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value

136+object_ mkObject val = {-# SCC "object_" #-} Object <$> objectValues mkObject jstring val

133137{-# INLINE object_ #-}

134138

135−object_' :: HFromList -> Parser Value -> Parser Value

136−object_' hFromList val' = {-# SCC "object_'" #-} do

137− !vals <- objectValues hFromList jstring' val'

139+object_' :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value

140+object_' mkObject val' = {-# SCC "object_'" #-} do

141+ !vals <- objectValues mkObject jstring' val'

138142 return (Object vals)

139143 where

140144 jstring' = do

@@ -142,12 +146,9 @@ object_' hFromList val' = {-# SCC "object_'" #-} do

142146 return s

143147{-# INLINE object_' #-}

144148

145−-- The object parser 'objectValues' is parameterized by the object constructor.

146−-- See also 'jsonWith'.

147−type HFromList = [(Text, Value)] -> Parser Object

148−

149−objectValues :: HFromList -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)

150−objectValues hFromList str val = do

149+objectValues :: ([(Text, Value)] -> Either String Object)

150+ -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)

151+objectValues mkObject str val = do

151152 skipSpace

152153 w <- A.peekWord8'

153154 if w == CLOSE_CURLY

@@ -163,7 +164,9 @@ objectValues hFromList str val = do

163164 let acc' = (k, v) : acc

164165 if ch == COMMA

165166 then skipSpace >> loop acc'

166− else hFromList acc'

167+ else case mkObject acc' of

168+ Left err -> fail err

169+ Right obj -> pure obj

167170{-# INLINE objectValues #-}

168171

169172array_ :: Parser Value -> Parser Value

@@ -207,21 +210,21 @@ value = jsonWith (pure . H.fromList)

207210-- 'json' keeps only the first occurence of each key, using 'HashMap.Lazy.fromList'.

208211--

209212-- @

210−-- 'json' = 'jsonWith' ('pure' '.' 'H.fromList')

213+-- 'json' = 'jsonWith' ('Right' '.' 'H.fromList')

211214-- @

212215--

213216-- 'jsonLast' keeps the last occurence of each key, using

214217-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.

215218--

216219-- @

217−-- 'jsonLast' = 'jsonWith' ('pure' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))

220+-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))

218221-- @

219222--

220223-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using

221224-- 'fromListAccum'.

222225--

223226-- @

224−-- 'jsonAccum' = 'jsonWith' ('pure' . 'fromListAccum')

227+-- 'jsonAccum' = 'jsonWith' ('Right' . 'fromListAccum')

225228-- @

226229--

227230-- 'jsonNoDup' fails if any object contains duplicate keys, using 'parseListNoDup'.

@@ -229,13 +232,13 @@ value = jsonWith (pure . H.fromList)

229232-- @

230233-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'

231234-- @

232−jsonWith :: ([(Text, Value)] -> Parser Object) -> Parser Value

233−jsonWith hFromList = fix $ \value_ -> do

235+jsonWith :: ([(Text, Value)] -> Either String Object) -> Parser Value

236+jsonWith mkObject = fix $ \value_ -> do

234237 skipSpace

235238 w <- A.peekWord8'

236239 case w of

237240 DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_)

238− OPEN_CURLY -> A.anyWord8 *> object_ hFromList value_

241+ OPEN_CURLY -> A.anyWord8 *> object_ mkObject value_

239242 OPEN_SQUARE -> A.anyWord8 *> array_ value_

240243 C_f -> string "false" $> Bool False

241244 C_t -> string "true" $> Bool True

@@ -247,12 +250,12 @@ jsonWith hFromList = fix $ \value_ -> do

247250

248251-- | Variant of 'json' which keeps only the last occurence of every key.

249252jsonLast :: Parser Value

250−jsonLast = jsonWith (pure . H.fromListWith (const id))

253+jsonLast = jsonWith (Right . H.fromListWith (const id))

251254

252255-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve

253256-- key-value pairs with the same keys.

254257jsonAccum :: Parser Value

255−jsonAccum = jsonWith (pure . fromListAccum)

258+jsonAccum = jsonWith (Right . fromListAccum)

256259

257260-- | Variant of 'json' which fails if any object contains duplicate keys.

258261jsonNoDup :: Parser Value

@@ -268,27 +271,27 @@ fromListAccum =

268271 fmap (Array . Vector.fromList . ($ [])) . H.fromListWith (.) . (fmap . fmap) (:)

269272

270273-- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.

271−parseListNoDup :: [(Text, Value)] -> Parser Object

274+parseListNoDup :: [(Text, Value)] -> Either String Object

272275parseListNoDup =

273276 H.traverseWithKey unwrap . H.fromListWith (\_ _ -> Nothing) . (fmap . fmap) Just

274277 where

275− unwrap k Nothing = fail $ "found duplicate key: " ++ show k

276− unwrap _ (Just v) = pure v

278+ unwrap k Nothing = Left $ "found duplicate key: " ++ show k

279+ unwrap _ (Just v) = Right v

277280

278281-- | Strict version of 'value'. Synonym of 'json''.

279282value' :: Parser Value

280283value' = jsonWith' (pure . H.fromList)

281284

282285-- | Strict version of 'jsonWith'.

283−jsonWith' :: ([(Text, Value)] -> Parser Object) -> Parser Value

284−jsonWith' hFromList = fix $ \value_ -> do

286+jsonWith' :: ([(Text, Value)] -> Either String Object) -> Parser Value

287+jsonWith' mkObject = fix $ \value_ -> do

285288 skipSpace

286289 w <- A.peekWord8'

287290 case w of

288291 DOUBLE_QUOTE -> do

289292 !s <- A.anyWord8 *> jstring_

290293 return (String s)

291− OPEN_CURLY -> A.anyWord8 *> object_' hFromList value_

294+ OPEN_CURLY -> A.anyWord8 *> object_' mkObject value_

292295 OPEN_SQUARE -> A.anyWord8 *> array_' value_

293296 C_f -> string "false" $> Bool False

294297 C_t -> string "true" $> Bool True

Data/Aeson/TH.hs+24−38

@@ -135,22 +135,15 @@ import Data.Map (Map)

135135import Data.Maybe (catMaybes, fromMaybe, mapMaybe)

136136import qualified Data.Monoid as Monoid

137137import Data.Set (Set)

138−#if MIN_VERSION_template_haskell(2,8,0)

139138import Language.Haskell.TH hiding (Arity)

140−#else

141−import Language.Haskell.TH

142−#endif

143139import 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

147140#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))

148141import Language.Haskell.TH.Syntax (mkNameG_tc)

149142#endif

150143import Text.Printf (printf)

151144import qualified Data.Aeson.Encoding.Internal as E

152145import 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)

154147import qualified Data.List.NonEmpty as NE (length, reverse)

155148import qualified Data.Map as M (fromList, keys, lookup , singleton, size)

156149import qualified Data.Semigroup as Semigroup (Option(..))

@@ -929,12 +922,32 @@ parseRecord :: JSONClass

929922 -> Name

930923 -> [Name]

931924 -> Name

925+ -> Bool

932926 -> 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) $

934931 foldl' (\a b -> infixApp a [|(<*>)|] b)

935932 (infixApp (conE conName) [|(<$>)|] x)

936933 xs

937934 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+ ]

938951 x:xs = [ [|lookupField|]

939952 `appE` dispatchParseJSON jc conName tvMap argTy

940953 `appE` litE (stringL $ show tName)

@@ -1009,7 +1022,7 @@ parseArgs jc tvMap tName opts

10091022 , constructorFields = argTys }

10101023 (Left (_, obj)) = do

10111024 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

10131026parseArgs jc tvMap tName opts

10141027 info@ConstructorInfo { constructorName = conName

10151028 , constructorVariant = RecordConstructor fields

@@ -1024,7 +1037,7 @@ parseArgs jc tvMap tName opts

10241037 argTys' <- mapM resolveTypeSynonyms argTys

10251038 caseE (varE valName)

10261039 [ 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) []

10281041 , matchFailed tName conName "Object"

10291042 ]

10301043

@@ -1590,21 +1603,13 @@ type TyVarMap = Map Name (Name, Name)

15901603-- | Returns True if a Type has kind *.

15911604hasKindStar :: Type -> Bool

15921605hasKindStar VarT{} = True

1593−#if MIN_VERSION_template_haskell(2,8,0)

15941606hasKindStar (SigT _ StarT) = True

1595−#else

1596−hasKindStar (SigT _ StarK) = True

1597−#endif

15981607hasKindStar _ = False

15991608

16001609-- Returns True is a kind is equal to *, or if it is a kind variable.

16011610isStarOrVar :: Kind -> Bool

1602−#if MIN_VERSION_template_haskell(2,8,0)

16031611isStarOrVar StarT = True

16041612isStarOrVar VarT{} = True

1605−#else

1606−isStarOrVar StarK = True

1607−#endif

16081613isStarOrVar _ = False

16091614

16101615-- Generate a list of fresh names with a common prefix, and numbered suffixes.

@@ -1662,9 +1667,7 @@ isTyFamily (ConT n) = do

16621667#else

16631668 FamilyI (FamilyD TypeFam _ _ _) _ -> True

16641669#endif

1665−#if MIN_VERSION_template_haskell(2,9,0)

16661670 FamilyI ClosedTypeFamilyD{} _ -> True

1667−#endif

16681671 _ -> False

16691672isTyFamily _ = return False

16701673

@@ -1692,9 +1695,7 @@ mentionsName = go

16921695 go :: Type -> [Name] -> Bool

16931696 go (AppT t1 t2) names = go t1 names || go t2 names

16941697 go (SigT t _k) names = go t names

1695−#if MIN_VERSION_template_haskell(2,8,0)

16961698 || go _k names

1697−#endif

16981699 go (VarT n) names = n `elem` names

16991700 go _ _ = False

17001701

@@ -1750,23 +1751,14 @@ uncurryTy t = ([], t :| [])

17501751

17511752-- | Like uncurryType, except on a kind level.

17521753uncurryKind :: Kind -> NonEmpty Kind

1753−#if MIN_VERSION_template_haskell(2,8,0)

17541754uncurryKind = snd . uncurryTy

1755−#else

1756−uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2

1757−uncurryKind k = k :| []

1758−#endif

17591755

17601756createKindChain :: Int -> Kind

17611757createKindChain = go starK

17621758 where

17631759 go :: Kind -> Int -> Kind

17641760 go k 0 = k

1765−#if MIN_VERSION_template_haskell(2,8,0)

17661761 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

17701762

17711763-- | Makes a string literal expression from a constructor's name.

17721764conNameExp :: Options -> ConstructorInfo -> Q Exp

@@ -1820,11 +1812,7 @@ canEtaReduce remaining dropped =

18201812-------------------------------------------------------------------------------

18211813

18221814applySubstitutionKind :: Map Name Kind -> Type -> Type

1823−#if MIN_VERSION_template_haskell(2,8,0)

18241815applySubstitutionKind = applySubstitution

1825−#else

1826−applySubstitutionKind _ t = t

1827−#endif

18281816

18291817substNameWithKind :: Name -> Kind -> Type -> Type

18301818substNameWithKind n k = applySubstitutionKind (M.singleton n k)

@@ -1988,9 +1976,7 @@ data StarKindStatus = NotKindStar

19881976canRealizeKindStar :: Type -> StarKindStatus

19891977canRealizeKindStar t = case t of

19901978 _ | hasKindStar t -> KindStar

1991−#if MIN_VERSION_template_haskell(2,8,0)

19921979 SigT _ (VarT k) -> IsKindVar k

1993−#endif

19941980 _ -> NotKindStar

19951981

19961982-- | 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

124124 , sumEncoding

125125 , unwrapUnaryRecords

126126 , tagSingleConstructors

127+ , rejectUnknownFields

127128

128129 -- ** Options utilities

129130 , SumEncoding(..)

@@ -136,6 +137,13 @@ module Data.Aeson.Types

136137 , JSONKeyOptions

137138 , keyModifier

138139 , defaultJSONKeyOptions

140+

141+ -- * Parsing context

142+ , (<?>)

143+ , JSONPath

144+ , JSONPathElement(..)

145+ , formatPath

146+ , formatRelativePath

139147 ) where

140148

141149import Prelude.Compat

Data/Aeson/Types/FromJSON.hs+90−67

@@ -5,19 +5,16 @@

55{-# LANGUAGE FlexibleInstances #-}

66{-# LANGUAGE GADTs #-}

77{-# LANGUAGE MultiParamTypeClasses #-}

8−{-# LANGUAGE NamedFieldPuns #-}

98{-# LANGUAGE NoImplicitPrelude #-}

109{-# LANGUAGE OverloadedStrings #-}

10+{-# LANGUAGE PolyKinds #-}

1111{-# LANGUAGE RecordWildCards #-}

1212{-# LANGUAGE ScopedTypeVariables #-}

1313{-# LANGUAGE TypeOperators #-}

14+{-# LANGUAGE TupleSections #-}

1415{-# LANGUAGE UndecidableInstances #-}

1516{-# LANGUAGE ViewPatterns #-}

1617

17−#if __GLASGOW_HASKELL__ >= 706

18−{-# LANGUAGE PolyKinds #-}

19−#endif

20−

2118#include "incoherent-compat.h"

2219#include "overlapping-compat.h"

2320

@@ -121,9 +118,9 @@ import GHC.Generics

121118import Numeric.Natural (Natural)

122119import Text.ParserCombinators.ReadP (readP_to_S)

123120import Unsafe.Coerce (unsafeCoerce)

124−import qualified Data.Aeson.Compat as Compat

125121import qualified Data.Aeson.Parser.Time as Time

126122import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)

123+import qualified Data.ByteString.Lazy as L

127124import qualified Data.DList as DList

128125import qualified Data.HashMap.Strict as H

129126import qualified Data.HashSet as HashSet

@@ -158,18 +155,8 @@ import qualified Data.Primitive.UnliftedArray as PM

158155import qualified Data.Primitive.PrimArray as PM

159156#endif

160157

161−#ifndef HAS_COERCIBLE

162−#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)

163−#endif

164158

165−#if HAS_COERCIBLE

166159import 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

173160

174161parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a

175162parseIndexedJSON p idx value = p value <?> Index idx

@@ -441,11 +428,7 @@ class FromJSONKey a where

441428-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'

442429-- can be inspected, but cannot be constructed.

443430data CoerceText a where

444−#if HAS_COERCIBLE

445431 CoerceText :: Coercible Text a => CoerceText a

446−#else

447− CoerceText :: CoerceText a

448−#endif

449432

450433-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the

451434-- 'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'

@@ -465,7 +448,7 @@ data FromJSONKeyFunction a

465448

466449-- | Only law abiding up to interpretation

467450instance Functor FromJSONKeyFunction where

468− fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce')

451+ fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce)

469452 fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)

470453 fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)

471454 fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)

@@ -479,9 +462,7 @@ instance Functor FromJSONKeyFunction where

479462--

480463-- On pre GHC 7.8 this is unconstrainted function.

481464fromJSONKeyCoerce ::

482−#if HAS_COERCIBLE

483465 Coercible Text a =>

484−#endif

485466 FromJSONKeyFunction a

486467fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

487468

@@ -489,29 +470,18 @@ fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

489470--

490471-- See note on 'fromJSONKeyCoerce'.

491472coerceFromJSONKeyFunction ::

492−#if HAS_COERCIBLE

493473 Coercible a b =>

494−#endif

495474 FromJSONKeyFunction a -> FromJSONKeyFunction b

496−#if HAS_COERCIBLE

497475coerceFromJSONKeyFunction = 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

504476

505477{-# RULES

506478 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).

507479 fmap id x = x

508480 #-}

509−#if HAS_COERCIBLE

510481{-# RULES

511482 "FromJSONKeyCoerce: fmap coerce" forall x .

512483 fmap coerce x = coerceFromJSONKeyFunction x

513484 #-}

514−#endif

515485

516486-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.

517487mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b

@@ -798,13 +768,13 @@ withBoundedScientific' f v = withBoundedScientific_ id f v

798768-- | A variant of 'withBoundedScientific_' parameterized by a function to apply

799769-- to the 'Parser' in case of failure.

800770withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a

801−withBoundedScientific_ whenFail f v@(Number scientific) =

802− if exponent > 1024

771+withBoundedScientific_ whenFail f (Number scientific) =

772+ if exp10 > 1024

803773 then whenFail (fail msg)

804774 else f scientific

805775 where

806− exponent = base10Exponent scientific

807− msg = "found a number with exponent " ++ show exponent ++ ", but it must not be greater than 1024"

776+ exp10 = base10Exponent scientific

777+ msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024"

808778withBoundedScientific_ whenFail _ v =

809779 whenFail (typeMismatch "Number" v)

810780{-# INLINE withBoundedScientific_ #-}

@@ -824,7 +794,7 @@ withBool name _ v = prependContext name (typeMismatch "Boolean" v)

824794-- | Decode a nested JSON-encoded string.

825795withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a

826796withEmbeddedJSON _ innerParser (String txt) =

827− either fail innerParser $ eitherDecode (Compat.fromStrict $ T.encodeUtf8 txt)

797+ either fail innerParser $ eitherDecode (L.fromStrict $ T.encodeUtf8 txt)

828798 where

829799 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON

830800 eitherFormatError = either (Left . uncurry formatError) Right

@@ -893,7 +863,7 @@ parseFieldMaybe' = (.:!)

893863-- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@

894864explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a

895865explicitParseField 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"

897867 Just v -> p v <?> Key key

898868{-# INLINE explicitParseField #-}

899869

@@ -952,6 +922,16 @@ type ConName = String

952922contextType :: TypeName -> Parser a -> Parser a

953923contextType = prependContext

954924

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+

955935-- | Add the name of the constructor being parsed to a parser's error messages.

956936contextCons :: ConName -> TypeName -> Parser a -> Parser a

957937contextCons cname tname = prependContext (showCons cname tname)

@@ -1130,8 +1110,8 @@ instance ConstructorNames a => ConstructorNames (D1 d a) where

11301110 retag (Tagged2 x) = Tagged2 x

11311111

11321112--------------------------------------------------------------------------------

1133−

1134−parseNonAllNullarySum :: ( FromPair arity f

1113+parseNonAllNullarySum :: forall f c arity.

1114+ ( FromPair arity f

11351115 , FromTaggedObject arity f

11361116 , FromUntaggedValue arity f

11371117 , ConstructorNames f

@@ -1141,7 +1121,7 @@ parseNonAllNullarySum p@(tname :* opts :* _) =

11411121 case sumEncoding opts of

11421122 TaggedObject{..} ->

11431123 withObject tname $ \obj -> do

1144− tag <- contextType tname $ obj .: tagKey

1124+ tag <- contextType tname . contextTag tagKey cnames_ $ obj .: tagKey

11451125 fromMaybe (badTag tag <?> Key tagKey) $

11461126 parseFromTaggedObject (tag :* contentsFieldName :* p) obj

11471127 where

@@ -1149,6 +1129,7 @@ parseNonAllNullarySum p@(tname :* opts :* _) =

11491129 badTag tag = failWith_ $ \cnames ->

11501130 "expected tag field to be one of " ++ show cnames ++

11511131 ", but found tag " ++ show tag

1132+ cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String])

11521133

11531134 ObjectWithSingleField ->

11541135 withObject tname $ \obj -> case H.toList obj of

@@ -1220,9 +1201,9 @@ class FromTaggedObject' arity f isRecord where

12201201 :: String :* ConName :* TypeName :* Options :* FromArgs arity a

12211202 -> Object -> Tagged isRecord (Parser (f a))

12221203

1223−instance (RecordFromJSON arity f) => FromTaggedObject' arity f True where

1204+instance (RecordFromJSON arity f, FieldNames f) => FromTaggedObject' arity f True where

12241205 -- Records are unpacked in the tagged object

1225− parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON p

1206+ parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON (True :* p)

12261207

12271208instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where

12281209 -- Nonnullary nonrecords are encoded in the contents field

@@ -1263,11 +1244,11 @@ instance OVERLAPPING_

12631244 ) => ConsFromJSON' arity (S1 s a) True where

12641245 consParseJSON' p@(cname :* tname :* opts :* fargs)

12651246 | 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))

12671248

12681249instance RecordFromJSON arity f => ConsFromJSON' arity f True where

12691250 consParseJSON' p@(cname :* tname :* _) =

1270− Tagged . withObject (showCons cname tname) (recordParseJSON p)

1251+ Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))

12711252

12721253instance OVERLAPPING_

12731254 ConsFromJSON' arity U1 False where

@@ -1293,21 +1274,55 @@ instance (ProductFromJSON arity f, ProductSize f

12931274

12941275--------------------------------------------------------------------------------

12951276

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+

12961288class RecordFromJSON arity f where

12971289 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'

12981313 :: ConName :* TypeName :* Options :* FromArgs arity a

12991314 -> Object -> Parser (f a)

13001315

1301−instance ( RecordFromJSON arity a

1302− , RecordFromJSON arity b

1303− ) => RecordFromJSON arity (a :*: b) where

1304− recordParseJSON p obj =

1305− (:*:) <$> recordParseJSON p obj

1306− <*> recordParseJSON p obj

1316+instance ( RecordFromJSON' arity a

1317+ , RecordFromJSON' arity b

1318+ ) => RecordFromJSON' arity (a :*: b) where

1319+ recordParseJSON' p obj =

1320+ (:*:) <$> recordParseJSON' p obj

1321+ <*> recordParseJSON' p obj

13071322

13081323instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>

1309− RecordFromJSON arity (S1 s a) where

1310− recordParseJSON (cname :* tname :* opts :* fargs) obj = do

1324+ RecordFromJSON' arity (S1 s a) where

1325+ recordParseJSON' (cname :* tname :* opts :* fargs) obj = do

13111326 fv <- contextCons cname tname (obj .: label)

13121327 M1 <$> gParseJSON opts fargs fv <?> Key label

13131328 where

@@ -1315,16 +1330,16 @@ instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>

13151330 sname = selName (undefined :: M1 _i s _f _p)

13161331

13171332instance INCOHERENT_ (Selector s, FromJSON a) =>

1318− RecordFromJSON arity (S1 s (K1 i (Maybe a))) where

1319− recordParseJSON (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label

1333+ RecordFromJSON' arity (S1 s (K1 i (Maybe a))) where

1334+ recordParseJSON' (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label

13201335 where

13211336 label = fieldLabelModifier opts sname

13221337 sname = selName (undefined :: M1 _i s _f _p)

13231338

13241339-- Parse an Option like a Maybe.

13251340instance INCOHERENT_ (Selector s, FromJSON a) =>

1326− RecordFromJSON arity (S1 s (K1 i (Semigroup.Option a))) where

1327− recordParseJSON p obj = wrap <$> recordParseJSON p obj

1341+ RecordFromJSON' arity (S1 s (K1 i (Semigroup.Option a))) where

1342+ recordParseJSON' p obj = wrap <$> recordParseJSON' p obj

13281343 where

13291344 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p

13301345 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))

@@ -1561,12 +1576,22 @@ instance FromJSONKey Float where

15611576 _ -> Scientific.toRealFloat <$> parseScientificText t

15621577

15631578instance (FromJSON a, Integral a) => FromJSON (Ratio a) where

1564− parseJSON = withObject "Rational" $ \obj -> do

1565− numerator <- obj .: "numerator"

1566− denominator <- obj .: "denominator"

1567− if denominator == 0

1568− then fail "Ratio denominator was 0"

1569− else pure $ numerator % denominator

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

1589+ objParser = withObject "Rational" $ \obj -> do

1590+ numerator <- obj .: "numerator"

1591+ denominator <- obj .: "denominator"

1592+ if denominator == 0

1593+ then fail "Ratio denominator was 0"

1594+ else pure $ numerator % denominator

15701595 {-# INLINE parseJSON #-}

15711596

15721597-- | This instance includes a bounds check to prevent maliciously

@@ -1981,7 +2006,6 @@ instance FromJSON DotNetTime where

19812006-- primitive

19822007-------------------------------------------------------------------------------

19832008

1984−#if MIN_VERSION_base(4,7,0)

19852009instance FromJSON a => FromJSON (PM.Array a) where

19862010 -- note: we could do better than this if vector exposed the data

19872011 -- constructor in Data.Vector.

@@ -1999,7 +2023,6 @@ instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where

19992023 parseJSON = fmap Exts.fromList . parseJSON

20002024#endif

20012025#endif

2002−#endif

20032026

20042027-------------------------------------------------------------------------------

20052028-- time

Data/Aeson/Types/Internal.hs+26−5

@@ -49,6 +49,8 @@ module Data.Aeson.Types.Internal

4949 , parserThrowError

5050 , parserCatchError

5151 , formatError

52+ , formatPath

53+ , formatRelativePath

5254 , (<?>)

5355 -- * Constructors and accessors

5456 , object

@@ -62,6 +64,7 @@ module Data.Aeson.Types.Internal

6264 , sumEncoding

6365 , unwrapUnaryRecords

6466 , tagSingleConstructors

67+ , rejectUnknownFields

6568 )

6669

6770 , SumEncoding(..)

@@ -99,6 +102,7 @@ import Data.Time.Format (FormatTime)

99102import Data.Typeable (Typeable)

100103import Data.Vector (Vector)

101104import GHC.Generics (Generic)

105+import qualified Control.Monad as Monad

102106import qualified Control.Monad.Fail as Fail

103107import qualified Data.HashMap.Strict as H

104108import qualified Data.Scientific as S

@@ -152,7 +156,7 @@ instance Functor Result where

152156 fmap _ (Error err) = Error err

153157 {-# INLINE fmap #-}

154158

155−instance Monad IResult where

159+instance Monad.Monad IResult where

156160 return = pure

157161 {-# INLINE return #-}

158162

@@ -169,7 +173,7 @@ instance Fail.MonadFail IResult where

169173 fail err = IError [] err

170174 {-# INLINE fail #-}

171175

172−instance Monad Result where

176+instance Monad.Monad Result where

173177 return = pure

174178 {-# INLINE return #-}

175179

@@ -288,7 +292,7 @@ newtype Parser a = Parser {

288292 -> f r

289293 }

290294

291−instance Monad Parser where

295+instance Monad.Monad Parser where

292296 m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks

293297 in runParser m path kf ks'

294298 {-# INLINE (>>=) #-}

@@ -457,7 +461,17 @@ parseEither m v = runParser (m v) [] onError Right

457461-- | Annotate an error message with a

458462-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.

459463formatError :: 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

461475 where

462476 format :: String -> JSONPath -> String

463477 format pfx [] = pfx

@@ -611,10 +625,14 @@ data Options = Options

611625 , tagSingleConstructors :: Bool

612626 -- ^ Encode types with a single constructor as sums,

613627 -- 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.

614632 }

615633

616634instance Show Options where

617− show (Options f c a o s u t) =

635+ show (Options f c a o s u t r) =

618636 "Options {"

619637 ++ intercalate ", "

620638 [ "fieldLabelModifier =~ " ++ show (f "exampleField")

@@ -624,6 +642,7 @@ instance Show Options where

624642 , "sumEncoding = " ++ show s

625643 , "unwrapUnaryRecords = " ++ show u

626644 , "tagSingleConstructors = " ++ show t

645+ , "rejectUnknownFields = " ++ show r

627646 ]

628647 ++ "}"

629648

@@ -705,6 +724,7 @@ data JSONKeyOptions = JSONKeyOptions

705724-- , 'sumEncoding' = 'defaultTaggedObject'

706725-- , 'unwrapUnaryRecords' = False

707726-- , 'tagSingleConstructors' = False

727+-- , 'rejectUnknownFields' = False

708728-- }

709729-- @

710730defaultOptions :: Options

@@ -716,6 +736,7 @@ defaultOptions = Options

716736 , sumEncoding = defaultTaggedObject

717737 , unwrapUnaryRecords = False

718738 , tagSingleConstructors = False

739+ , rejectUnknownFields = False

719740 }

720741

721742-- | Default 'TaggedObject' 'SumEncoding' options:

Data/Aeson/Types/ToJSON.hs+3−43

@@ -5,19 +5,15 @@

55{-# LANGUAGE FlexibleInstances #-}

66{-# LANGUAGE FunctionalDependencies #-}

77{-# LANGUAGE GADTs #-}

8−{-# LANGUAGE NamedFieldPuns #-}

98{-# LANGUAGE NoImplicitPrelude #-}

109{-# LANGUAGE OverloadedStrings #-}

1110{-# LANGUAGE PatternGuards #-}

11+{-# LANGUAGE PolyKinds #-}

1212{-# LANGUAGE RecordWildCards #-}

1313{-# LANGUAGE ScopedTypeVariables #-}

1414{-# LANGUAGE TypeOperators #-}

1515{-# LANGUAGE UndecidableInstances #-}

1616

17−#if __GLASGOW_HASKELL__ >= 706

18−{-# LANGUAGE PolyKinds #-}

19−#endif

20−

2117#include "overlapping-compat.h"

2218#include "incoherent-compat.h"

2319

@@ -104,7 +100,6 @@ import GHC.Generics

104100import Numeric.Natural (Natural)

105101import qualified Data.Aeson.Encoding as E

106102import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)

107−import qualified Data.ByteString as S

108103import qualified Data.ByteString.Lazy as L

109104import qualified Data.DList as DList

110105import qualified Data.HashMap.Strict as H

@@ -145,14 +140,6 @@ import qualified Data.Primitive.UnliftedArray as PM

145140import qualified Data.Primitive.PrimArray as PM

146141#endif

147142

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−

156143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value

157144toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)

158145{-# INLINE toJSONPair #-}

@@ -516,7 +503,7 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e

516503 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm

517504 tot = T.dropAround (== '"')

518505 . T.decodeLatin1

519− . lazyToStrictByteString

506+ . L.toStrict

520507 . E.encodingToLazyByteString

521508 . e

522509

@@ -1983,7 +1970,6 @@ formatMillis = take 3 . formatTime defaultTimeLocale "%q"

19831970-- primitive

19841971-------------------------------------------------------------------------------

19851972

1986−#if MIN_VERSION_base(4,7,0)

19871973instance ToJSON a => ToJSON (PM.Array a) where

19881974 -- note: we could do better than this if vector exposed the data

19891975 -- constructor in Data.Vector.

@@ -2005,7 +1991,6 @@ instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where

20051991 toEncoding = toEncoding . Exts.toList

20061992#endif

20071993#endif

2008−#endif

20091994

20101995-------------------------------------------------------------------------------

20111996-- time

@@ -2055,7 +2040,7 @@ stringEncoding :: Encoding' Text -> Value

20552040stringEncoding = String

20562041 . T.dropAround (== '"')

20572042 . T.decodeLatin1

2058− . lazyToStrictByteString

2043+ . L.toStrict

20592044 . E.encodingToLazyByteString

20602045{-# INLINE stringEncoding #-}

20612046

@@ -2862,31 +2847,6 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,

28622847 toEncoding = toEncoding2

28632848 {-# INLINE toEncoding #-}

28642849

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−

28902850--------------------------------------------------------------------------------

28912851

28922852-- | Wrap a list of pairs as an object.

Makefile+1−1

@@ -1,2 +1,2 @@

11lint:

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 @@

11name: aeson

2−version: 1.4.3.0

2+version: 1.4.6.0

33license: BSD3

44license-file: LICENSE

55category: Text, Web, JSON

@@ -88,7 +88,6 @@ library

8888 Data.Aeson.Encode

8989

9090 other-modules:

91− Data.Aeson.Compat

9291 Data.Aeson.Encoding.Builder

9392 Data.Aeson.Internal.Functions

9493 Data.Aeson.Parser.Unescape

@@ -103,28 +102,23 @@ library

103102

104103 -- GHC bundled libs

105104 build-depends:

106− base >= 4.5.0.0 && < 5,

107− containers >= 0.4.2.1 && < 0.7,

105+ base >= 4.7.0.0 && < 5,

106+ bytestring >= 0.10.4.0 && < 0.11,

107+ containers >= 0.5.5.1 && < 0.7,

108108 deepseq >= 1.3.0.0 && < 1.5,

109109 ghc-prim >= 0.2 && < 0.6,

110− template-haskell >= 2.7.0.0 && < 2.15,

110+ template-haskell >= 2.9.0.0 && < 2.16,

111111 text >= 1.2.3.0 && < 1.3,

112− time >= 1.4 && < 1.9

112+ time >= 1.4 && < 1.10

113113

114114 if impl(ghc >= 8.0)

115115 build-depends: bytestring >= 0.10.8.1

116116

117117 -- Compat

118118 build-depends:

119− base-compat >= 0.9.1 && < 0.11,

119+ base-compat >= 0.9.1 && < 0.12,

120120 time-compat >= 1.9.2.2 && < 1.10

121121

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−

128122 if !impl(ghc >= 8.6)

129123 build-depends:

130124 contravariant >=1.4.1 && <1.6

@@ -225,9 +219,9 @@ test-suite tests

225219 containers,

226220 directory,

227221 dlist,

228− Diff,

222+ Diff >= 0.4 && < 0.5,

229223 filepath,

230− generic-deriving >= 1.10 && < 1.13,

224+ generic-deriving >= 1.10 && < 1.14,

231225 ghc-prim >= 0.2,

232226 hashable >= 1.2.4.0,

233227 scientific,

attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs−20

@@ -29,16 +29,8 @@ import Data.Time.Clock (diffTimeToPicoseconds)

2929

3030#endif

3131

32−#if MIN_VERSION_base(4,7,0)

33−

3432import Data.Fixed (Pico, Fixed(MkFixed))

3533

36−#else

37−

38−import Data.Fixed (Pico)

39−

40−#endif

41−

4234#if !MIN_VERSION_time(1,6,0)

4335

4436diffTimeToPicoseconds :: DiffTime -> Integer

@@ -46,24 +38,12 @@ diffTimeToPicoseconds = unsafeCoerce

4638

4739#endif

4840

49−#if MIN_VERSION_base(4,7,0)

50−

5141toPico :: Integer -> Pico

5242toPico = MkFixed

5343

5444fromPico :: Pico -> Integer

5545fromPico (MkFixed i) = i

5646

57−#else

58−

59−toPico :: Integer -> Pico

60−toPico = unsafeCoerce

61−

62−fromPico :: Pico -> Integer

63−fromPico = unsafeCoerce

64−

65−#endif

66−

6747-- | Like TimeOfDay, but using a fixed-width integer for seconds.

6848data TimeOfDay64 = TOD {-# UNPACK #-} !Int

6949 {-# UNPACK #-} !Int

attoparsec-iso8601/attoparsec-iso8601.cabal+2−2

@@ -36,8 +36,8 @@ library

3636 Data.Attoparsec.Time

3737 build-depends:

3838 attoparsec >= 0.13.0.1,

39− base >= 4.5 && < 5,

40− base-compat >= 0.9.1 && < 0.11,

39+ base >= 4.7 && < 5,

40+ base-compat >= 0.9.1 && < 0.12,

4141 text >= 1.1.1.0,

4242 time >= 1.1.1.4

4343

benchmarks/AesonEncode.hs+1−1

@@ -7,7 +7,7 @@ module Main (main) where

77import Prelude.Compat

99import Control.DeepSeq

10−import Control.Monad

10+import Control.Monad (forM_)

1111import Data.Aeson

1212import Data.Attoparsec.ByteString (IResult(..), parseWith)

1313import Data.Char (isDigit)

benchmarks/Compare/JsonBench.hs+2−1

@@ -20,6 +20,7 @@ import Data.Aeson ((.:))

2020import Data.Monoid ((<>))

2121import Data.Text (Text)

2222import Typed.Common (load)

23+import qualified Control.Monad.Fail as Fail

2324import qualified Data.Aeson as Aeson

2425import qualified Data.BufferBuilder.Json as Json

2526

@@ -82,7 +83,7 @@ genderTable = [("male", Male), ("female", Female)]

8283fruitTable :: [(Text, Fruit)]

8384fruitTable = [("apple", Apple), ("strawberry", Strawberry), ("banana", Banana)]

8485

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

8687enumFromJson enumName table extract v = do

8788 s <- extract v

8889 case lookup s table of

benchmarks/Issue673.hs+1

@@ -18,6 +18,7 @@ import Criterion.Main

1818import Prelude.Compat

1919import Data.Int (Int64)

2020import Data.Scientific (Scientific)

21+import Data.Semigroup ((<>))

2122import Data.Aeson.Parser (scientific)

2223

2324import qualified Data.Attoparsec.ByteString.Lazy as AttoL

benchmarks/aeson-benchmarks.cabal+7−1

@@ -72,7 +72,6 @@ library

7272

7373 exposed-modules:

7474 Data.Aeson

75− Data.Aeson.Compat

7675 Data.Aeson.Encoding

7776 Data.Aeson.Encoding.Builder

7877 Data.Aeson.Encoding.Internal

@@ -176,6 +175,9 @@ executable aeson-benchmark-compare

176175 Compare.JsonBuilder

177176 build-depends:

178177 json-builder

178+ if impl(ghc < 8.0)

179+ build-depends:

180+ semigroups

179181

180182executable aeson-benchmark-micro

181183 default-language: Haskell2010

@@ -222,6 +224,8 @@ executable aeson-benchmark-typed

222224 bytestring-builder >= 0.10.4 && < 1

223225 else

224226 build-depends: bytestring >= 0.10.4

227+ if impl(ghc < 8.0)

228+ build-depends: semigroups

225229

226230executable aeson-benchmark-compare-with-json

227231 default-language: Haskell2010

@@ -337,3 +341,5 @@ executable aeson-issue-673

337341 scientific,

338342 base-compat,

339343 criterion >= 1.0

344+ if impl(ghc < 8.0)

345+ build-depends: semigroups

cabal.project+3−1

@@ -1,3 +1,5 @@

11with-compiler: ghc

22packages: .

3−packages: attoparsec-iso8601, benchmarks

3+packages: attoparsec-iso8601

4+-- packages: benchmarks

5+tests: true

changelog.md+56

@@ -1,5 +1,61 @@

11For 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).

3+### upcoming

5+* `FromJSON` instance of `Ratio a` now parses numbers in addtion to

6+ standard `{numerator=..., denumerator=...}` encoding.

8+### 1.4.6.0

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+

359### 1.4.3.0

460* Improve error messages for FromJSON in existing instances and GHC Generic implementation. Thanks to Xia Li-Yao & Igor Pashev.

561* Tweak error-reporting combinators and their documentation. Thanks to Xia Li-Yao.

run-hlint.shnew file+7

@@ -0,0 +1,7 @@

1+#!/bin/bash

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

22# We use aeson in the snapshot to

33# - avoid recompilation of criterion

44# - compare against it

@@ -9,10 +9,4 @@ resolver: lts-12.26

99work-dir: .stack-work-bench

1010packages:

1111- benchmarks

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

12+extra-deps: []

stack-ffi-unescape.yaml+2−7

@@ -1,4 +1,4 @@

1−resolver: lts-12.26

1+resolver: nightly-2019-09-21

22packages:

33- '.'

44flags:

@@ -6,9 +6,4 @@ flags:

66 fast: true

77 cffi: true

88extra-deps:

9−- base-orphans-0.8.1

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

9+- Diff-0.4.0

stack-nightly.yaml+2−4

@@ -1,4 +1,4 @@

1−resolver: nightly-2019-05-13

1+resolver: nightly-2019-10-14

22packages:

33- '.'

44- attoparsec-iso8601

@@ -8,6 +8,4 @@ flags:

88 attoparsec-iso8601:

99 fast: true

1010extra-deps:

11−- hlint-2.1.18

12−- time-compat-1.9.2.2

13−- quickcheck-instances-0.3.21

11+- generic-deriving-1.12.4

tests/Encoders.hs+25−6

@@ -188,7 +188,6 @@ gSomeTypeToEncoding2ElemArray = genericToEncoding opts2ElemArray

188188gSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)

189189gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray

190190

191−#if __GLASGOW_HASKELL__ >= 706

192191gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a

193192gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray

194193

@@ -197,7 +196,6 @@ gSomeTypeLiftToJSON2ElemArray = genericLiftToJSON opts2ElemArray

197196

198197gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a

199198gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray

200−#endif

201199

202200

203201gSomeTypeToJSONTaggedObject :: SomeType Int -> Value

@@ -209,7 +207,6 @@ gSomeTypeToEncodingTaggedObject = genericToEncoding optsTaggedObject

209207gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)

210208gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject

211209

212−#if __GLASGOW_HASKELL__ >= 706

213210gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a

214211gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject

215212

@@ -218,7 +215,6 @@ gSomeTypeLiftToJSONTaggedObject = genericLiftToJSON optsTaggedObject

218215

219216gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a

220217gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject

221−#endif

222218

223219

224220gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value

@@ -230,7 +226,6 @@ gSomeTypeToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingl

230226gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)

231227gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField

232228

233−#if __GLASGOW_HASKELL__ >= 706

234229gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a

235230gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField

236231

@@ -239,7 +234,6 @@ gSomeTypeLiftToJSONObjectWithSingleField = genericLiftToJSON optsObjectWithSingl

239234

240235gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a

241236gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField

242−#endif

243237

244238

245239gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value

@@ -249,6 +243,31 @@ gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding

249243gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields

250244

251245

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+

252271--------------------------------------------------------------------------------

253272-- Option fields

254273--------------------------------------------------------------------------------

tests/ErrorMessages.hs+27−1

@@ -13,7 +13,7 @@ import Data.Aeson (FromJSON(..), Value, json)

1313import Data.Aeson.Types (Parser)

1414import Data.Aeson.Parser (eitherDecodeWith)

1515import Data.Aeson.Internal (formatError, iparse)

16−import Data.Algorithm.Diff (Diff(..), getGroupedDiff)

16+import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff)

1717import Data.Proxy (Proxy(..))

1818import Data.Semigroup ((<>))

1919import Data.Sequence (Seq)

@@ -136,6 +136,29 @@ outputGeneric choice = concat

136136 , "[1,"

137137 ]

138138

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+

139162 , testWith "EitherTextInt"

140163 (select

141164 thEitherTextIntParseJSONUntaggedValue

@@ -196,3 +219,6 @@ testFor name _ = testWith name (parseJSON :: Value -> Parser a)

196219

197220testWithSomeType :: String -> (Value -> Parser (SomeType Int)) -> [L.ByteString] -> Output

198221testWithSomeType = 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 #-}

21{-# LANGUAGE FlexibleContexts #-}

32{-# LANGUAGE FlexibleInstances #-}

43{-# LANGUAGE NoImplicitPrelude #-}

@@ -25,14 +24,12 @@ import qualified Data.HashMap.Strict as HM

2524

2625import Data.Orphans ()

2726import Test.QuickCheck.Instances ()

28−#if MIN_VERSION_base(4,7,0)

2927import Data.Hashable.Time ()

30−#endif

3128

3229-- "System" types.

3330

3431instance Arbitrary DotNetTime where

35− arbitrary = DotNetTime `liftM` arbitrary

32+ arbitrary = DotNetTime `fmap` arbitrary

3633 shrink = map DotNetTime . shrink . fromDotNetTime

3734

3835-- | Compare timezone part only on 'timeZoneMinutes'

tests/Options.hs+11

@@ -55,3 +55,14 @@ optsOptionField = optsDefault

5555 { fieldLabelModifier = const "field"

5656 , omitNothingFields = True

5757 }

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 =

4444 , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)

4545 , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)

4646

47−#if __GLASGOW_HASKELL__ >= 706

4847 , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)

4948 , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)

5049 , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)

51−#endif

5250 ]

5351 ]

5452 , testGroup "OneConstructor" [

@@ -85,30 +83,24 @@ genericTests =

8583

8684 , testProperty "SomeType2ElemArray" $

8785 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray

88−#if __GLASGOW_HASKELL__ >= 706

8986 , testProperty "SomeType2ElemArray unary" $

9087 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray

9188 , testProperty "SomeType2ElemArray unary agree" $

9289 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray

93−#endif

9490

9591 , testProperty "SomeTypeTaggedObject" $

9692 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject

97−#if __GLASGOW_HASKELL__ >= 706

9893 , testProperty "SomeTypeTaggedObject unary" $

9994 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject

10095 , testProperty "SomeTypeTaggedObject unary agree" $

10196 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject

102−#endif

10397

10498 , testProperty "SomeTypeObjectWithSingleField" $

10599 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField

106−#if __GLASGOW_HASKELL__ >= 706

107100 , testProperty "SomeTypeObjectWithSingleField unary" $

108101 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField

109102 , testProperty "SomeTypeObjectWithSingleField unary agree" $

110103 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField

111−#endif

112104

113105 , testProperty "SomeTypeOmitNothingFields" $

114106 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields

tests/PropertyKeys.hs−3

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE NoImplicitPrelude #-}

43module PropertyKeys ( keysTests ) where

@@ -31,12 +30,10 @@ keysTests =

3130 , testProperty "Natural" $ roundTripKey (undefined :: Natural)

3231 , testProperty "Float" $ roundTripKey (undefined :: Float)

3332 , testProperty "Double" $ roundTripKey (undefined :: Double)

34−#if MIN_VERSION_base(4,7,0)

3533 , testProperty "Day" $ roundTripKey (undefined :: Day)

3634 , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)

3735 , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)

3836 , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)

39−#endif

4037 , testProperty "Version" $ roundTripKey (undefined :: Version)

4138 , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)

4239 , testProperty "UUID" $ roundTripKey UUID.nil

tests/SerializationFormatSpec.hs−4

@@ -3,9 +3,7 @@

33{-# LANGUAGE GADTs #-}

44{-# LANGUAGE NoImplicitPrelude #-}

55{-# LANGUAGE OverloadedStrings #-}

6−#if __GLASGOW_HASKELL__ >= 708

76{-# LANGUAGE DataKinds #-}

8−#endif

108------------------------------------------------------------------------------

119-- These tests assert that the JSON serialization doesn't change by accident.

@@ -77,10 +75,8 @@ jsonExamples =

7775 , example "Just" "1" (Just 1 :: Maybe Int)

7876 , example "Proxy Int" "null" (Proxy :: Proxy Int)

7977 , example "Tagged Char Int" "1" (Tagged 1 :: Tagged Char Int)

80−#if __GLASGOW_HASKELL__ >= 708

8178 -- Test Tagged instance is polykinded

8279 , example "Tagged 123 Int" "1" (Tagged 1 :: Tagged 123 Int)

83−#endif

8480 , example "Const Char Int" "\"c\"" (Const 'c' :: Const Char Int)

8581 , example "Tuple" "[1,2]" ((1, 2) :: (Int, Int))

8682 , 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)

119119deriving instance Generic (Approx a)

120120deriving instance Generic Nullary

121121deriving instance Generic (SomeType a)

122−#if __GLASGOW_HASKELL__ >= 706

123122deriving instance Generic1 SomeType

124−#endif

125123deriving instance Generic OptionField

126124deriving instance Generic EitherTextInt

127125

tests/UnitTests.hs+162−3

@@ -29,12 +29,19 @@ import Data.Aeson.Internal (JSONPathElement(..), formatError)

2929import Data.Aeson.QQ.Simple (aesonQQ)

3030import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1)

3131import Data.Aeson.Text (encodeToTextBuilder)

32−import Data.Aeson.Types (Options(..), Result(Success), ToJSON(..), Value(Null, Object), camelTo, camelTo2, defaultOptions, omitNothingFields, parse)

32+import Data.Aeson.Parser

33+ ( json, jsonLast, jsonAccum, jsonNoDup

34+ , json', jsonLast', jsonAccum', jsonNoDup')

35+import Data.Aeson.Types

36+ ( Options(..), Result(Success, Error), ToJSON(..)

37+ , Value(Array, Bool, Null, Number, Object, String), camelTo, camelTo2

38+ , defaultOptions, formatPath, formatRelativePath, omitNothingFields, parse)

39+import Data.Attoparsec.ByteString (Parser, parseOnly)

3340import Data.Char (toUpper)

3441import Data.Either.Compat (isLeft, isRight)

3542import Data.Hashable (hash)

3643import Data.HashMap.Strict (HashMap)

37−import Data.List (sort)

44+import Data.List (sort, isSuffixOf)

3845import Data.Maybe (fromMaybe)

3946import Data.Scientific (Scientific, scientific)

4047import Data.Tagged (Tagged(..))

@@ -47,16 +54,19 @@ import Numeric.Natural (Natural)

4754import System.Directory (getDirectoryContents)

4855import System.FilePath ((</>), takeExtension, takeFileName)

4956import Test.Tasty (TestTree, testGroup)

50−import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, assertEqual, testCase)

57+import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, assertEqual, testCase, (@?=))

5158import Text.Printf (printf)

5259import UnitTests.NullaryConstructors (nullaryConstructors)

60+import qualified Data.ByteString as S

5361import qualified Data.ByteString.Base16.Lazy as LBase16

5462import qualified Data.ByteString.Lazy.Char8 as L

5563import qualified Data.HashSet as HashSet

64+import qualified Data.HashMap.Lazy as HashMap

5665import qualified Data.Text.Lazy as LT

5766import qualified Data.Text.Lazy.Builder as TLB

5867import qualified Data.Text.Lazy.Encoding as LT

5968import qualified Data.Text.Lazy.Encoding as TLE

69+import qualified Data.Vector as Vector

6070import qualified ErrorMessages

6171import qualified SerializationFormatSpec

6272

@@ -102,7 +112,12 @@ tests = testGroup "unit" [

102112 , testGroup "SingleMaybeField" singleMaybeField

103113 , testCase "withEmbeddedJSON" withEmbeddedJSONTest

104114 , testCase "SingleFieldCon" singleFieldCon

115+ , testGroup "UnknownFields" unknownFields

116+ , testGroup "Ordering of object keys" keyOrdering

105117 , testCase "Ratio with denominator 0" ratioDenominator0

118+ , testCase "Rational parses number" rationalNumber

119+ , testCase "Big rational" bigRationalDecoding

120+ , testCase "Small rational" smallRationalDecoding

106121 , testCase "Big scientific exponent" bigScientificExponent

107122 , testCase "Big integer decoding" bigIntegerDecoding

108123 , testCase "Big natural decading" bigNaturalDecoding

@@ -243,6 +258,18 @@ formatErrorExample =

243258 lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"

244259 in assertEqual "formatError example" lhs rhs

245260

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+

246273------------------------------------------------------------------------------

247274-- Comparison (.:?) and (.:!)

248275------------------------------------------------------------------------------

@@ -513,6 +540,7 @@ showOptions =

513540 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"

514541 ++ ", unwrapUnaryRecords = False"

515542 ++ ", tagSingleConstructors = False"

543+ ++ ", rejectUnknownFields = False"

516544 ++ "}")

517545 (show defaultOptions)

518546

@@ -557,12 +585,138 @@ singleFieldCon :: Assertion

557585singleFieldCon =

558586 assertEqual "fromJSON" (Right (SingleFieldCon 0)) (eitherDecode "0")

559587

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+

661+testParser :: (Eq a, Show a)

662+ => String -> Parser a -> S.ByteString -> Either String a -> TestTree

663+testParser name json_ s expected =

664+ testCase name (parseOnly json_ s @?= expected)

665+

666+keyOrdering :: [TestTree]

667+keyOrdering =

668+ [ testParser "json" json

669+ "{\"k\":true,\"k\":false}" $

670+ Right (Object (HashMap.fromList [("k", Bool True)]))

671+ , testParser "jsonLast" jsonLast

672+ "{\"k\":true,\"k\":false}" $

673+ Right (Object (HashMap.fromList [("k", Bool False)]))

674+ , testParser "jsonAccum" jsonAccum

675+ "{\"k\":true,\"k\":false}" $

676+ Right (Object (HashMap.fromList [("k", Array (Vector.fromList [Bool True, Bool False]))]))

677+ , testParser "jsonNoDup" jsonNoDup

678+ "{\"k\":true,\"k\":false}" $

679+ Left "Failed reading: found duplicate key: \"k\""

680+

681+ , testParser "json'" json'

682+ "{\"k\":true,\"k\":false}" $

683+ Right (Object (HashMap.fromList [("k", Bool True)]))

684+ , testParser "jsonLast'" jsonLast'

685+ "{\"k\":true,\"k\":false}" $

686+ Right (Object (HashMap.fromList [("k", Bool False)]))

687+ , testParser "jsonAccum'" jsonAccum'

688+ "{\"k\":true,\"k\":false}" $

689+ Right (Object (HashMap.fromList [("k", Array (Vector.fromList [Bool True, Bool False]))]))

690+ , testParser "jsonNoDup'" jsonNoDup'

691+ "{\"k\":true,\"k\":false}" $

692+ Left "Failed reading: found duplicate key: \"k\""

693+ ]

694+

560695ratioDenominator0 :: Assertion

561696ratioDenominator0 =

562697 assertEqual "Ratio with denominator 0"

563698 (Left "Error in $: Ratio denominator was 0")

564699 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)

565700

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+

566720bigScientificExponent :: Assertion

567721bigScientificExponent =

568722 assertEqual "Encoding an integral scientific with a large exponent should normalize it"

@@ -599,3 +753,8 @@ deriveToJSON defaultOptions ''Foo

599753deriveToJSON1 defaultOptions ''Foo

600754

601755deriveJSON 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

66Error in $: parsing Types.Nullary failed, expected String, but encountered Array

77SomeType (tagged)

88Error in $.contents: parsing Int failed, expected Number, but encountered Boolean

9−Error in $: parsing Types.SomeType(Unary) failed, key "contents" not present

10−Error in $: parsing Types.SomeType(Record) failed, key "testone" 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 found

1111Error in $.testone: parsing Double failed, unexpected Boolean

1212Error 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

1414Error in $: parsing Types.SomeType failed, expected Object, but encountered Array

1515SomeType (single-field)

1616Error 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

3131Error in $: parsing Types.SomeType failed, expected Array, but encountered Object

3232Error in $: not enough input. Expecting ',' or ']'

3333Error 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"]

3442EitherTextInt

3543Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected tag "nonenullary", but found tag "X"

3644Error 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 */

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

77stack --version

99case $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+ ;;

1015 stack)

1116 stack --no-terminal --skip-ghc-check setup

1217 stack --no-terminal --skip-ghc-check test --only-snapshot

@@ -44,4 +49,10 @@ case $BUILD in

4449 cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;

4550 fi

4651 ;;

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+ ;;

4758esac

travis/script.sh+4−2

@@ -19,9 +19,11 @@ case $BUILD in

1919 SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&

2020 (cd dist && cabal install --force-reinstalls "$SRC_TGZ")

2121 ;;

22+ cabal2)

23+ cabal v2-build --enable-tests --enable-benchmarks

24+ cabal v2-test --enable-tests --enable-benchmarks

25+ ;;

2226 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

2527 make lint

2628 ;;

2729esac