378ff14...master · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

.gitignore+1

since splitsnapshots

unifiedsplit

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

5cabal.sandbox.config

6.stack-work/

7.stack-work-bench/

8+*.yaml.lock

9*.o

10*.o

10*.hi

11*.hi

.hlint.yamlnew file+11

@@ -0,0 +1,11 @@

1+# Ignore some builtin hints

2+- ignore:

3+ name: "Reduce duplication"

4+ within:

5+ - Data.Aeson.Types.ToJSON

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:

12 - $HOME/.stack

13 - $HOME/.cabsnap

14 - $HOME/.cabal/packages

15+ - $HOME/.cabal/store

16before_cache:

17before_cache:

17 - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

18 - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

18− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar

19+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

20+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

21+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

22+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

20matrix:

25matrix:

21 include:

26 include:

27+

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

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

23− compiler: ": #GHC 8.4.3"

29+ compiler: ": #GHC 8.4.4"

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

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

31+

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

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

26− compiler: ": #GHC 8.4.3"

33+ compiler: ": #GHC 8.6.5"

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

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

35+

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

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

29− compiler: ": #GHC 8.4.3"

37+ compiler: ": #GHC 8.6.5"

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

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

31−

39+

40+ - env: BUILD=cabal2 CABALVER=3.0 GHCVER=8.8.1

41+ compiler: ": #GHC 8.8.1"

42+ addons: {apt: {packages: [cabal-install-3.0,ghc-8.8.1], sources: [hvr-ghc]}}

43+

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

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

33− compiler: ": #GHC 8.6.1"

45+ compiler: ": #GHC 8.6.5"

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

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

47+

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

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

36− compiler: ": #GHC 8.4.3"

49+ compiler: ": #GHC 8.4.4"

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

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

51+

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

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

39 compiler: ": #GHC 8.2.2"

53 compiler: ": #GHC 8.2.2"

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

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

55+

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

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

42 compiler: ": #GHC 8.0.2"

57 compiler: ": #GHC 8.0.2"

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

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

59+

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

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

45 compiler: ": #GHC 7.10.3"

61 compiler: ": #GHC 7.10.3"

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

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

63+

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

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

48 compiler: ": #GHC 7.8.4"

65 compiler: ": #GHC 7.8.4"

49 addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}

66 addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}

50− - env: BUILD=cabal CABALVER=1.18 GHCVER=7.6.3

51− compiler: ": #GHC 7.6.3"

52− addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}

53− - env: BUILD=cabal CABALVER=1.18 GHCVER=7.4.2

54− compiler: ": #GHC 7.4.2"

55− addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}}

57before_install:

68before_install:

58 - unset CC

69 - unset CC

CONTRIBUTING.md+38

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

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

59import qualified A

60```

61+

62+## Development Workflow (If you plan on using Stack)

63+

64+Here we outline a general workflow new contributors could adopt for a nice incremental development experience.

65+

66+The root folder consists of two stack-*.yaml config files.

67+

68+1. stack-nightly.yaml - Config file defines all the settings to build and test any changes.

69+2. stack-bench.yaml - Used to run benchmark tests.

70+3. stack-ffi-unescape.yaml - This is for replacing certain parts with a C-implementation.

71+

72+Therefore, a ghci development experience would be:

73+

74+1. `stack ghci --stack-yaml stack-nightly.yaml --test`

75+2. :r to recompile

76+3. `main` to run all tests, or `:main --pattern Foo` to run specific tests matched by pattern.

77+

78+Some discussion on this topic can also be found here [here](https://github.com/bos/aeson/issues/733)

79+

80+Of course before submitting a PR, the following steps are recommended:

81+

82+1. 'stack test --stack-yaml stack-nightly.yaml` - Run the entire suite of tests

83+2. `make hlint` - Run hlint on the source folders.

84+3. 'stack test --stack-yaml stack-bench.yaml` - Run the benchmark tests if you believe your changes could affect the benchmarks.

85+

86+## Development Workflow (If you plan on using Cabal)

87+

88+A ghci development experience would be:

89+

90+1. `cabal new-repl test:tests`

91+2. `:r` to recompile

92+3. `Main.main` to run all tests, or `:m Main; :main --pattern Foo` to run specific tests matched by pattern.

93+

94+Of course before submitting a PR, the following steps are recommended:

95+

96+1. `cabal new-test` - Run the entire suite of tests

97+2. `make hlint` - Run hlint on the source folders.

98+3. Uncomment the `benchmarks` line in `cabal.project` - Run the benchmark tests if you believe your changes could affect the benchmarks.

Data/Aeson.hs+9

@@ -70,6 +70,11 @@ module Data.Aeson

70 , ToJSONKeyFunction(..)

71 , FromJSONKey(..)

72 , FromJSONKeyFunction(..)

73+ -- *** Generic keys

74+ , GToJSONKey()

75+ , genericToJSONKey

76+ , GFromJSONKey()

77+ , genericFromJSONKey

73 -- ** Liftings to unary and binary type constructors

78 -- ** Liftings to unary and binary type constructors

74 , FromJSON1(..)

79 , FromJSON1(..)

75 , parseJSON1

80 , parseJSON1

@@ -111,6 +116,10 @@ module Data.Aeson

111 , SumEncoding(..)

116 , SumEncoding(..)

112 , camelTo2

117 , camelTo2

113 , defaultTaggedObject

118 , defaultTaggedObject

119+ -- ** Options for object keys

120+ , JSONKeyOptions

121+ , keyModifier

122+ , defaultJSONKeyOptions

114

123

115 -- * Inspecting @'Value's@

124 -- * Inspecting @'Value's@

116 , withObject

125 , withObject

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.hs+11−1

@@ -35,10 +35,20 @@ module Data.Aeson.Parser

35 , value

36 , jstring

37 , scientific

38+ -- ** Handling objects with duplicate keys

39+ , jsonWith

40+ , jsonLast

41+ , jsonAccum

42+ , jsonNoDup

38 -- * Strict parsers

43 -- * Strict parsers

39 -- $strict

44 -- $strict

40 , json'

45 , json'

41 , value'

46 , value'

47+ -- ** Handling objects with duplicate keys

48+ , jsonWith'

49+ , jsonLast'

50+ , jsonAccum'

51+ , jsonNoDup'

42 -- * Decoding without FromJSON instances

52 -- * Decoding without FromJSON instances

43 , decodeWith

53 , decodeWith

44 , decodeStrictWith

54 , decodeStrictWith

@@ -47,7 +57,7 @@ module Data.Aeson.Parser

47 ) where

57 ) where

50−import Data.Aeson.Parser.Internal (decodeStrictWith, decodeWith, eitherDecodeStrictWith, eitherDecodeWith, json, json', jstring, scientific, value, value')

60+import Data.Aeson.Parser.Internal

52-- $lazy

62-- $lazy

53--

63--

Data/Aeson/Parser/Internal.hs+155−40

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

5#if MIN_VERSION_ghc_prim(0,3,1)

6{-# LANGUAGE MagicHash #-}

7#endif

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

9+-- Work around a compiler bug

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

11+#endif

8-- |

12-- |

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

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

@@ -21,29 +25,43 @@ module Data.Aeson.Parser.Internal

21 (

25 (

22 -- * Lazy parsers

26 -- * Lazy parsers

23 json, jsonEOF

27 json, jsonEOF

28+ , jsonWith

29+ , jsonLast

30+ , jsonAccum

31+ , jsonNoDup

24 , value

32 , value

25 , jstring

33 , jstring

26 , jstring_

34 , jstring_

27 , scientific

35 , scientific

28 -- * Strict parsers

36 -- * Strict parsers

29 , json', jsonEOF'

37 , json', jsonEOF'

38+ , jsonWith'

39+ , jsonLast'

40+ , jsonAccum'

41+ , jsonNoDup'

30 , value'

42 , value'

31 -- * Helpers

43 -- * Helpers

32 , decodeWith

44 , decodeWith

33 , decodeStrictWith

45 , decodeStrictWith

34 , eitherDecodeWith

46 , eitherDecodeWith

35 , eitherDecodeStrictWith

47 , eitherDecodeStrictWith

48+ -- ** Handling objects with duplicate keys

49+ , fromListAccum

50+ , parseListNoDup

36 ) where

51 ) where

38import Prelude.Compat

53import Prelude.Compat

40import Control.Applicative ((<|>))

55import Control.Applicative ((<|>))

41import Control.Monad (void, when)

56import Control.Monad (void, when)

42−import Data.Aeson.Types.Internal (IResult(..), JSONPath, Result(..), Value(..))

57+import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Value(..))

43import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)

58import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)

59+import Data.Function (fix)

60+import Data.Functor.Compat (($>))

44import Data.Scientific (Scientific)

61import Data.Scientific (Scientific)

45import Data.Text (Text)

62import Data.Text (Text)

63+import Data.Vector (Vector)

46−import Data.Vector as Vector (Vector, empty, fromListN, reverse)

64+import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)

47import qualified Data.Attoparsec.ByteString as A

65import qualified Data.Attoparsec.ByteString as A

48import qualified Data.Attoparsec.Lazy as L

66import qualified Data.Attoparsec.Lazy as L

49import qualified Data.ByteString as B

67import qualified Data.ByteString as B

@@ -75,7 +93,7 @@ import qualified Data.Text.Encoding as TE

75#define C_n 110

93#define C_n 110

76#define C_t 116

94#define C_t 116

78−-- | Parse a top-level JSON value.

96+-- | Parse any JSON value.

79--

97--

80-- The conversion of a parsed value to a Haskell value is deferred

98-- The conversion of a parsed value to a Haskell value is deferred

81-- until the Haskell value is needed. This may improve performance if

99-- until the Haskell value is needed. This may improve performance if

@@ -85,10 +103,15 @@ import qualified Data.Text.Encoding as TE

85-- This function is an alias for 'value'. In aeson 0.8 and earlier, it

103-- This function is an alias for 'value'. In aeson 0.8 and earlier, it

86-- parsed only object or array types, in conformance with the

104-- parsed only object or array types, in conformance with the

87-- now-obsolete RFC 4627.

105-- now-obsolete RFC 4627.

106+--

107+-- ==== Warning

108+--

109+-- If an object contains duplicate keys, only the first one will be kept.

110+-- For a more flexible alternative, see 'jsonWith'.

88json :: Parser Value

111json :: Parser Value

89json = value

112json = value

113

91−-- | Parse a top-level JSON value.

114+-- | Parse any JSON value.

92--

115--

93-- This is a strict version of 'json' which avoids building up thunks

116-- This is a strict version of 'json' which avoids building up thunks

94-- during parsing; it performs all conversions immediately. Prefer

117-- during parsing; it performs all conversions immediately. Prefer

@@ -97,23 +120,35 @@ json = value

97-- This function is an alias for 'value''. In aeson 0.8 and earlier, it

120-- This function is an alias for 'value''. In aeson 0.8 and earlier, it

98-- parsed only object or array types, in conformance with the

121-- parsed only object or array types, in conformance with the

99-- now-obsolete RFC 4627.

122-- now-obsolete RFC 4627.

123+--

124+-- ==== Warning

125+--

126+-- If an object contains duplicate keys, only the first one will be kept.

127+-- For a more flexible alternative, see 'jsonWith''.

100json' :: Parser Value

128json' :: Parser Value

101json' = value'

129json' = value'

102

130

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

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

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

134+

103−object_ :: Parser Value

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

104−object_ = {-# SCC "object_" #-} Object <$> objectValues jstring value

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

137+{-# INLINE object_ #-}

105

138

106−object_' :: Parser Value

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

107−object_' = {-# SCC "object_'" #-} do

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

108− !vals <- objectValues jstring' value'

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

109 return (Object vals)

142 return (Object vals)

110 where

143 where

111 jstring' = do

144 jstring' = do

112 !s <- jstring

145 !s <- jstring

113 return s

146 return s

147+{-# INLINE object_' #-}

114

148

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

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

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

116−objectValues str val = do

151+objectValues mkObject str val = do

117 skipSpace

152 skipSpace

118 w <- A.peekWord8'

153 w <- A.peekWord8'

119 if w == CLOSE_CURLY

154 if w == CLOSE_CURLY

@@ -129,16 +164,20 @@ objectValues str val = do

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

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

130 if ch == COMMA

165 if ch == COMMA

131 then skipSpace >> loop acc'

166 then skipSpace >> loop acc'

132− else return (H.fromList acc')

167+ else case mkObject acc' of

168+ Left err -> fail err

169+ Right obj -> pure obj

133{-# INLINE objectValues #-}

170{-# INLINE objectValues #-}

134

171

135−array_ :: Parser Value

172+array_ :: Parser Value -> Parser Value

136−array_ = {-# SCC "array_" #-} Array <$> arrayValues value

173+array_ val = {-# SCC "array_" #-} Array <$> arrayValues val

174+{-# INLINE array_ #-}

137

175

138−array_' :: Parser Value

176+array_' :: Parser Value -> Parser Value

139−array_' = {-# SCC "array_'" #-} do

177+array_' val = {-# SCC "array_'" #-} do

140− !vals <- arrayValues value'

178+ !vals <- arrayValues val

141 return (Array vals)

179 return (Array vals)

180+{-# INLINE array_' #-}

142

181

143arrayValues :: Parser Value -> Parser (Vector Value)

182arrayValues :: Parser Value -> Parser (Vector Value)

144arrayValues val = do

183arrayValues val = do

@@ -156,50 +195,126 @@ arrayValues val = do

156 else return (Vector.reverse (Vector.fromListN len (v:acc)))

195 else return (Vector.reverse (Vector.fromListN len (v:acc)))

157{-# INLINE arrayValues #-}

196{-# INLINE arrayValues #-}

158

197

159−-- | Parse any JSON value. You should usually 'json' in preference to

198+-- | Parse any JSON value. Synonym of 'json'.

160−-- this function, as this function relaxes the object-or-array

161−-- requirement of RFC 4627.

162−--

163−-- In particular, be careful in using this function if you think your

164−-- code might interoperate with Javascript. A naïve Javascript

165−-- library that parses JSON data using @eval@ is vulnerable to attack

166−-- unless the encoded data represents an object or an array. JSON

167−-- implementations in other languages conform to that same restriction

168−-- to preserve interoperability and security.

169value :: Parser Value

199value :: Parser Value

170−value = do

200+value = jsonWith (pure . H.fromList)

201+

202+-- | Parse any JSON value.

203+--

204+-- This parser is parameterized by a function to construct an 'Object'

205+-- from a raw list of key-value pairs, where duplicates are preserved.

206+-- The pairs appear in __reverse order__ from the source.

207+--

208+-- ==== __Examples__

209+--

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

211+--

212+-- @

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

214+-- @

215+--

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

217+-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.

218+--

219+-- @

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

221+-- @

222+--

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

224+-- 'fromListAccum'.

225+--

226+-- @

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

228+-- @

229+--

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

231+--

232+-- @

233+-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'

234+-- @

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

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

171 skipSpace

237 skipSpace

172 w <- A.peekWord8'

238 w <- A.peekWord8'

173 case w of

239 case w of

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

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

175− OPEN_CURLY -> A.anyWord8 *> object_

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

176− OPEN_SQUARE -> A.anyWord8 *> array_

242+ OPEN_SQUARE -> A.anyWord8 *> array_ value_

177− C_f -> string "false" *> pure (Bool False)

243+ C_f -> string "false" $> Bool False

178− C_t -> string "true" *> pure (Bool True)

244+ C_t -> string "true" $> Bool True

179− C_n -> string "null" *> pure Null

245+ C_n -> string "null" $> Null

180 _ | w >= 48 && w <= 57 || w == 45

246 _ | w >= 48 && w <= 57 || w == 45

181 -> Number <$> scientific

247 -> Number <$> scientific

182 | otherwise -> fail "not a valid json value"

248 | otherwise -> fail "not a valid json value"

249+{-# INLINE jsonWith #-}

250+

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

252+jsonLast :: Parser Value

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

254+

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

256+-- key-value pairs with the same keys.

257+jsonAccum :: Parser Value

258+jsonAccum = jsonWith (Right . fromListAccum)

259+

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

261+jsonNoDup :: Parser Value

262+jsonNoDup = jsonWith parseListNoDup

183

263

264+-- | @'fromListAccum' kvs@ is an object mapping keys to arrays containing all

265+-- associated values from the original list @kvs@.

266+--

267+-- >>> fromListAccum [("apple", Bool True), ("apple", Bool False), ("orange", Bool False)]

268+-- fromList [("apple", [Bool False, Bool True]), ("orange", [Bool False])]

269+fromListAccum :: [(Text, Value)] -> Object

270+fromListAccum =

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

272+

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

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

275+parseListNoDup =

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

277+ where

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

279+ unwrap _ (Just v) = Right v

280+

184−-- | Strict version of 'value'. See also 'json''.

281+-- | Strict version of 'value'. Synonym of 'json''.

185value' :: Parser Value

282value' :: Parser Value

186−value' = do

283+value' = jsonWith' (pure . H.fromList)

284+

285+-- | Strict version of 'jsonWith'.

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

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

187 skipSpace

288 skipSpace

188 w <- A.peekWord8'

289 w <- A.peekWord8'

189 case w of

290 case w of

190 DOUBLE_QUOTE -> do

291 DOUBLE_QUOTE -> do

191 !s <- A.anyWord8 *> jstring_

292 !s <- A.anyWord8 *> jstring_

192 return (String s)

293 return (String s)

193− OPEN_CURLY -> A.anyWord8 *> object_'

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

194− OPEN_SQUARE -> A.anyWord8 *> array_'

295+ OPEN_SQUARE -> A.anyWord8 *> array_' value_

195− C_f -> string "false" *> pure (Bool False)

296+ C_f -> string "false" $> Bool False

196− C_t -> string "true" *> pure (Bool True)

297+ C_t -> string "true" $> Bool True

197− C_n -> string "null" *> pure Null

298+ C_n -> string "null" $> Null

198 _ | w >= 48 && w <= 57 || w == 45

299 _ | w >= 48 && w <= 57 || w == 45

199 -> do

300 -> do

200 !n <- scientific

301 !n <- scientific

201 return (Number n)

302 return (Number n)

202 | otherwise -> fail "not a valid json value"

303 | otherwise -> fail "not a valid json value"

304+{-# INLINE jsonWith' #-}

305+

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

307+jsonLast' :: Parser Value

308+jsonLast' = jsonWith' (pure . H.fromListWith (const id))

309+

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

311+-- key-value pairs with the same keys.

312+jsonAccum' :: Parser Value

313+jsonAccum' = jsonWith' (pure . fromListAccum)

314+

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

316+jsonNoDup' :: Parser Value

317+jsonNoDup' = jsonWith' parseListNoDup

203

318

204-- | Parse a quoted JSON string.

319-- | Parse a quoted JSON string.

205jstring :: Parser Text

320jstring :: Parser Text

Data/Aeson/TH.hs+24−40

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

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

136import qualified Data.Monoid as Monoid

137import Data.Set (Set)

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

139import Language.Haskell.TH hiding (Arity)

138import Language.Haskell.TH hiding (Arity)

140−#else

141−import Language.Haskell.TH

142−#endif

143import Language.Haskell.TH.Datatype

139import Language.Haskell.TH.Datatype

144−#if MIN_VERSION_template_haskell(2,7,0) && !(MIN_VERSION_template_haskell(2,8,0))

145−import Language.Haskell.TH.Lib (starK)

146−#endif

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

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

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

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

149#endif

142#endif

150import Text.Printf (printf)

143import Text.Printf (printf)

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

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

152import qualified Data.Foldable as F (all)

145import qualified Data.Foldable as F (all)

153−import qualified Data.HashMap.Strict as H (lookup, toList)

146+import qualified Data.HashMap.Strict as H (difference, fromList, keys, lookup, toList)

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

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

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

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

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

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

@@ -159,8 +152,6 @@ import qualified Data.Text as T (Text, pack, unpack)

159import qualified Data.Vector as V (unsafeIndex, null, length, create, empty)

152import qualified Data.Vector as V (unsafeIndex, null, length, create, empty)

160import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)

153import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)

161

154

162−{-# ANN module "Hlint: ignore Reduce duplication" #-}

163−

164--------------------------------------------------------------------------------

155--------------------------------------------------------------------------------

165-- Convenience

156-- Convenience

166--------------------------------------------------------------------------------

157--------------------------------------------------------------------------------

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

931 -> Name

922 -> Name

932 -> [Name]

923 -> [Name]

933 -> Name

924 -> Name

925+ -> Bool

934 -> ExpQ

926 -> ExpQ

935−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) $

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

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

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

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

938 xs

933 xs

939 where

934 where

935+ tagFieldNameAppender =

936+ if inTaggedObject then (tagFieldName (sumEncoding opts) :) else id

937+ knownFields = appE [|H.fromList|] $ listE $

938+ map (\knownName -> tupE [appE [|T.pack|] $ litE $ stringL knownName, [|()|]]) $

939+ tagFieldNameAppender $ map nameBase fields

940+ checkUnknownRecords =

941+ caseE (appE [|H.keys|] $ infixApp (varE obj) [|H.difference|] knownFields)

942+ [ match (listP []) (normalB [|return ()|]) []

943+ , newName "unknownFields" >>=

944+ \unknownFields -> match (varP unknownFields)

945+ (normalB $ appE [|fail|] $ infixApp

946+ (litE (stringL "Unknown fields: "))

947+ [|(++)|]

948+ (appE [|show|] (varE unknownFields)))

949+ []

950+ ]

940 x:xs = [ [|lookupField|]

951 x:xs = [ [|lookupField|]

941 `appE` dispatchParseJSON jc conName tvMap argTy

952 `appE` dispatchParseJSON jc conName tvMap argTy

942 `appE` litE (stringL $ show tName)

953 `appE` litE (stringL $ show tName)

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

1011 , constructorFields = argTys }

1022 , constructorFields = argTys }

1012 (Left (_, obj)) = do

1023 (Left (_, obj)) = do

1013 argTys' <- mapM resolveTypeSynonyms argTys

1024 argTys' <- mapM resolveTypeSynonyms argTys

1014− parseRecord jc tvMap argTys' opts tName conName fields obj

1025+ parseRecord jc tvMap argTys' opts tName conName fields obj True

1015parseArgs jc tvMap tName opts

1026parseArgs jc tvMap tName opts

1016 info@ConstructorInfo { constructorName = conName

1027 info@ConstructorInfo { constructorName = conName

1017 , constructorVariant = RecordConstructor fields

1028 , constructorVariant = RecordConstructor fields

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

1026 argTys' <- mapM resolveTypeSynonyms argTys

1037 argTys' <- mapM resolveTypeSynonyms argTys

1027 caseE (varE valName)

1038 caseE (varE valName)

1028 [ match (conP 'Object [varP obj]) (normalB $

1039 [ match (conP 'Object [varP obj]) (normalB $

1029− parseRecord jc tvMap argTys' opts tName conName fields obj) []

1040+ parseRecord jc tvMap argTys' opts tName conName fields obj False) []

1030 , matchFailed tName conName "Object"

1041 , matchFailed tName conName "Object"

1031 ]

1042 ]

1032

1043

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

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

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

1593hasKindStar :: Type -> Bool

1604hasKindStar :: Type -> Bool

1594hasKindStar VarT{} = True

1605hasKindStar VarT{} = True

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

1596hasKindStar (SigT _ StarT) = True

1606hasKindStar (SigT _ StarT) = True

1597−#else

1598−hasKindStar (SigT _ StarK) = True

1599−#endif

1600hasKindStar _ = False

1607hasKindStar _ = False

1601

1608

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

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

1603isStarOrVar :: Kind -> Bool

1610isStarOrVar :: Kind -> Bool

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

1605isStarOrVar StarT = True

1611isStarOrVar StarT = True

1606isStarOrVar VarT{} = True

1612isStarOrVar VarT{} = True

1607−#else

1608−isStarOrVar StarK = True

1609−#endif

1610isStarOrVar _ = False

1613isStarOrVar _ = False

1611

1614

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

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

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

1664#else

1667#else

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

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

1666#endif

1669#endif

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

1668 FamilyI ClosedTypeFamilyD{} _ -> True

1670 FamilyI ClosedTypeFamilyD{} _ -> True

1669−#endif

1670 _ -> False

1671 _ -> False

1671isTyFamily _ = return False

1672isTyFamily _ = return False

1672

1673

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

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

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

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

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

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

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

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

1698 || go _k names

1699−#endif

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

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

1701 go _ _ = False

1700 go _ _ = False

1702

1701

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

1752

1751

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

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

1754uncurryKind :: Kind -> NonEmpty Kind

1753uncurryKind :: Kind -> NonEmpty Kind

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

1756uncurryKind = snd . uncurryTy

1754uncurryKind = snd . uncurryTy

1757−#else

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

1759−uncurryKind k = k :| []

1760−#endif

1761

1755

1762createKindChain :: Int -> Kind

1756createKindChain :: Int -> Kind

1763createKindChain = go starK

1757createKindChain = go starK

1764 where

1758 where

1765 go :: Kind -> Int -> Kind

1759 go :: Kind -> Int -> Kind

1766 go k 0 = k

1760 go k 0 = k

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

1768 go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)

1761 go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)

1769−#else

1770− go k !n = go (ArrowK StarK k) (n - 1)

1771−#endif

1772

1762

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

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

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

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

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

1822-------------------------------------------------------------------------------

1812-------------------------------------------------------------------------------

1823

1813

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

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

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

1826applySubstitutionKind = applySubstitution

1815applySubstitutionKind = applySubstitution

1827−#else

1828−applySubstitutionKind _ t = t

1829−#endif

1830

1816

1831substNameWithKind :: Name -> Kind -> Type -> Type

1817substNameWithKind :: Name -> Kind -> Type -> Type

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

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

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

1990canRealizeKindStar :: Type -> StarKindStatus

1976canRealizeKindStar :: Type -> StarKindStatus

1991canRealizeKindStar t = case t of

1977canRealizeKindStar t = case t of

1992 _ | hasKindStar t -> KindStar

1978 _ | hasKindStar t -> KindStar

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

1994 SigT _ (VarT k) -> IsKindVar k

1979 SigT _ (VarT k) -> IsKindVar k

1995−#endif

1996 _ -> NotKindStar

1980 _ -> NotKindStar

1997

1981

1998-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.

1982-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.

Data/Aeson/Types.hs+19

@@ -53,6 +53,12 @@ module Data.Aeson.Types

53 , coerceFromJSONKeyFunction

54 , mapFromJSONKeyFunction

56+ -- *** Generic keys

57+ , GToJSONKey()

58+ , genericToJSONKey

59+ , GFromJSONKey()

60+ , genericFromJSONKey

61+

56 -- ** Liftings to unary and binary type constructors

62 -- ** Liftings to unary and binary type constructors

57 , FromJSON1(..)

63 , FromJSON1(..)

58 , parseJSON1

64 , parseJSON1

@@ -118,6 +124,7 @@ module Data.Aeson.Types

118 , sumEncoding

124 , sumEncoding

119 , unwrapUnaryRecords

125 , unwrapUnaryRecords

120 , tagSingleConstructors

126 , tagSingleConstructors

127+ , rejectUnknownFields

121

128

122 -- ** Options utilities

129 -- ** Options utilities

123 , SumEncoding(..)

130 , SumEncoding(..)

@@ -125,6 +132,18 @@ module Data.Aeson.Types

125 , camelTo2

132 , camelTo2

126 , defaultOptions

133 , defaultOptions

127 , defaultTaggedObject

134 , defaultTaggedObject

135+

136+ -- ** Options for object keys

137+ , JSONKeyOptions

138+ , keyModifier

139+ , defaultJSONKeyOptions

140+

141+ -- * Parsing context

142+ , (<?>)

143+ , JSONPath

144+ , JSONPathElement(..)

145+ , formatPath

146+ , formatRelativePath

128 ) where

147 ) where

129

148

130import Prelude.Compat

149import Prelude.Compat

Data/Aeson/Types/Class.hs+5−1

@@ -6,7 +6,6 @@

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE NoImplicitPrelude #-}

8{-# LANGUAGE ScopedTypeVariables #-}

9−{-# LANGUAGE TypeSynonymInstances #-}

11-- |

10-- |

12-- Module: Data.Aeson.Types.Class

11-- Module: Data.Aeson.Types.Class

@@ -59,6 +58,11 @@ module Data.Aeson.Types.Class

59 , fromJSONKeyCoerce

58 , fromJSONKeyCoerce

60 , coerceFromJSONKeyFunction

59 , coerceFromJSONKeyFunction

61 , mapFromJSONKeyFunction

60 , mapFromJSONKeyFunction

61+ -- ** Generic keys

62+ , GToJSONKey()

63+ , genericToJSONKey

64+ , GFromJSONKey()

65+ , genericFromJSONKey

62 -- * Object key-value pairs

66 -- * Object key-value pairs

63 , KeyValue(..)

67 , KeyValue(..)

Data/Aeson/Types/FromJSON.hs+204−88

@@ -5,20 +5,16 @@

5{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE GADTs #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

8−{-# LANGUAGE NamedFieldPuns #-}

9{-# LANGUAGE NoImplicitPrelude #-}

8{-# LANGUAGE NoImplicitPrelude #-}

10{-# LANGUAGE OverloadedStrings #-}

9{-# LANGUAGE OverloadedStrings #-}

10+{-# LANGUAGE PolyKinds #-}

11{-# LANGUAGE RecordWildCards #-}

12{-# LANGUAGE ScopedTypeVariables #-}

13{-# LANGUAGE TypeOperators #-}

14−{-# LANGUAGE TypeSynonymInstances #-}

14+{-# LANGUAGE TupleSections #-}

15{-# LANGUAGE UndecidableInstances #-}

16{-# LANGUAGE ViewPatterns #-}

18−#if __GLASGOW_HASKELL__ >= 706

19−{-# LANGUAGE PolyKinds #-}

20−#endif

21−

22#include "incoherent-compat.h"

18#include "incoherent-compat.h"

23#include "overlapping-compat.h"

19#include "overlapping-compat.h"

@@ -46,6 +42,9 @@ module Data.Aeson.Types.FromJSON

46 , coerceFromJSONKeyFunction

42 , coerceFromJSONKeyFunction

47 , mapFromJSONKeyFunction

43 , mapFromJSONKeyFunction

45+ , GFromJSONKey()

46+ , genericFromJSONKey

47+

49 -- * List functions

48 -- * List functions

50 , listParser

49 , listParser

@@ -88,7 +87,7 @@ import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF)

88import Data.Aeson.Types.Generic

87import Data.Aeson.Types.Generic

89import Data.Aeson.Types.Internal

88import Data.Aeson.Types.Internal

90import Data.Bits (unsafeShiftR)

89import Data.Bits (unsafeShiftR)

91−import Data.Fixed (Fixed, HasResolution)

90+import Data.Fixed (Fixed, HasResolution (resolution), Nano)

92import Data.Functor.Compose (Compose(..))

91import Data.Functor.Compose (Compose(..))

93import Data.Functor.Identity (Identity(..))

92import Data.Functor.Identity (Identity(..))

94import Data.Functor.Product (Product(..))

93import Data.Functor.Product (Product(..))

@@ -104,8 +103,10 @@ import Data.Scientific (Scientific, base10Exponent)

104import Data.Tagged (Tagged(..))

103import Data.Tagged (Tagged(..))

105import Data.Text (Text, pack, unpack)

104import Data.Text (Text, pack, unpack)

106import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)

105import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)

107−import Data.Time.Format (parseTime)

106+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))

107+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))

108+import Data.Time.Clock.System.Compat (SystemTime (..))

108−import Data.Time.Locale.Compat (defaultTimeLocale)

109+import Data.Time.Format.Compat (parseTimeM, defaultTimeLocale)

109import Data.Traversable as Tr (sequence)

110import Data.Traversable as Tr (sequence)

110import Data.Vector (Vector)

111import Data.Vector (Vector)

111import Data.Version (Version, parseVersion)

112import Data.Version (Version, parseVersion)

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

117import Numeric.Natural (Natural)

118import Numeric.Natural (Natural)

118import Text.ParserCombinators.ReadP (readP_to_S)

119import Text.ParserCombinators.ReadP (readP_to_S)

119import Unsafe.Coerce (unsafeCoerce)

120import Unsafe.Coerce (unsafeCoerce)

120−import qualified Data.Aeson.Compat as Compat

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

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

123+import qualified Data.ByteString.Lazy as L

123import qualified Data.DList as DList

124import qualified Data.DList as DList

124import qualified Data.HashMap.Strict as H

125import qualified Data.HashMap.Strict as H

125import qualified Data.HashSet as HashSet

126import qualified Data.HashSet as HashSet

@@ -148,22 +149,14 @@ import qualified Data.Primitive.SmallArray as PM

148import qualified Data.Primitive.Types as PM

149import qualified Data.Primitive.Types as PM

149

150

150#if MIN_VERSION_primitive(0,6,4)

151#if MIN_VERSION_primitive(0,6,4)

152+#if !MIN_VERSION_primitive(0,7,0)

151import qualified Data.Primitive.UnliftedArray as PM

153import qualified Data.Primitive.UnliftedArray as PM

154+#endif

152import qualified Data.Primitive.PrimArray as PM

155import qualified Data.Primitive.PrimArray as PM

153#endif

156#endif

154

157

155−#ifndef HAS_COERCIBLE

156−#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)

157−#endif

158

159−#if HAS_COERCIBLE

160import Data.Coerce (Coercible, coerce)

159import Data.Coerce (Coercible, coerce)

161−coerce' :: Coercible a b => a -> b

162−coerce' = coerce

163−#else

164−coerce' :: a -> b

165−coerce' = unsafeCoerce

166−#endif

167

160

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

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

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

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

@@ -403,6 +396,16 @@ class FromJSON a where

403-- > newtype SomeId = SomeId { getSomeId :: Text }

396-- > newtype SomeId = SomeId { getSomeId :: Text }

404-- > deriving (Eq,Ord,Hashable,FromJSONKey)

397-- > deriving (Eq,Ord,Hashable,FromJSONKey)

405--

398--

399+-- If you have a sum of nullary constructors, you may use the generic

400+-- implementation:

401+--

402+-- @

403+-- data Color = Red | Green | Blue

404+-- deriving Generic

405+--

406+-- instance 'FromJSONKey' Color where

407+-- 'fromJSONKey' = 'genericFromJSONKey' 'defaultJSONKeyOptions'

408+-- @

406class FromJSONKey a where

409class FromJSONKey a where

407 -- | Strategy for parsing the key of a map-like container.

410 -- | Strategy for parsing the key of a map-like container.

408 fromJSONKey :: FromJSONKeyFunction a

411 fromJSONKey :: FromJSONKeyFunction a

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

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

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

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

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

427data CoerceText a where

430data CoerceText a where

428−#if HAS_COERCIBLE

429 CoerceText :: Coercible Text a => CoerceText a

431 CoerceText :: Coercible Text a => CoerceText a

430−#else

431− CoerceText :: CoerceText a

432−#endif

433

432

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

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

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

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

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

449

448

450-- | Only law abiding up to interpretation

449-- | Only law abiding up to interpretation

451instance Functor FromJSONKeyFunction where

450instance Functor FromJSONKeyFunction where

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

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

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

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

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

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

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

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

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

463--

462--

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

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

465fromJSONKeyCoerce ::

464fromJSONKeyCoerce ::

466−#if HAS_COERCIBLE

467 Coercible Text a =>

465 Coercible Text a =>

468−#endif

469 FromJSONKeyFunction a

466 FromJSONKeyFunction a

470fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

467fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

471

468

@@ -473,34 +470,52 @@ fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

473--

470--

474-- See note on 'fromJSONKeyCoerce'.

471-- See note on 'fromJSONKeyCoerce'.

475coerceFromJSONKeyFunction ::

472coerceFromJSONKeyFunction ::

476−#if HAS_COERCIBLE

477 Coercible a b =>

473 Coercible a b =>

478−#endif

479 FromJSONKeyFunction a -> FromJSONKeyFunction b

474 FromJSONKeyFunction a -> FromJSONKeyFunction b

480−#if HAS_COERCIBLE

481coerceFromJSONKeyFunction = coerce

475coerceFromJSONKeyFunction = coerce

482−#else

483−coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText

484−coerceFromJSONKeyFunction (FromJSONKeyText f) = FromJSONKeyText (coerce' . f)

485−coerceFromJSONKeyFunction (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap coerce' . f)

486−coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fmap coerce' . f)

487−#endif

488

476

489{-# RULES

477{-# RULES

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

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

491 fmap id x = x

479 fmap id x = x

492 #-}

480 #-}

493−#if HAS_COERCIBLE

494{-# RULES

481{-# RULES

495 "FromJSONKeyCoerce: fmap coerce" forall x .

482 "FromJSONKeyCoerce: fmap coerce" forall x .

496 fmap coerce x = coerceFromJSONKeyFunction x

483 fmap coerce x = coerceFromJSONKeyFunction x

497 #-}

484 #-}

498−#endif

499

485

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

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

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

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

502mapFromJSONKeyFunction = fmap

488mapFromJSONKeyFunction = fmap

503

489

490+-- | 'fromJSONKey' for 'Generic' types.

491+-- These types must be sums of nullary constructors, whose names will be used

492+-- as keys for JSON objects.

493+--

494+-- See also 'genericToJSONKey'.

495+--

496+-- === __Example__

497+--

498+-- @

499+-- data Color = Red | Green | Blue

500+-- deriving 'Generic'

501+--

502+-- instance 'FromJSONKey' Color where

503+-- 'fromJSONKey' = 'genericFromJSONKey' 'defaultJSONKeyOptions'

504+-- @

505+genericFromJSONKey :: forall a. (Generic a, GFromJSONKey (Rep a))

506+ => JSONKeyOptions

507+ -> FromJSONKeyFunction a

508+genericFromJSONKey opts = FromJSONKeyTextParser $ \t ->

509+ case parseSumFromString (keyModifier opts) t of

510+ Nothing -> fail $

511+ "invalid key " ++ show t ++ ", expected one of " ++ show cnames

512+ Just k -> pure (to k)

513+ where

514+ cnames = unTagged2 (constructorTags (keyModifier opts) :: Tagged2 (Rep a) [String])

515+

516+class (ConstructorNames f, SumFromString f) => GFromJSONKey f where

517+instance (ConstructorNames f, SumFromString f) => GFromJSONKey f where

518+

504-------------------------------------------------------------------------------

519-------------------------------------------------------------------------------

505-- Functions needed for documentation

520-- Functions needed for documentation

506-------------------------------------------------------------------------------

521-------------------------------------------------------------------------------

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

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

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

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

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

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

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

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

771+withBoundedScientific_ whenFail f (Number scientific) =

757− if exponent > 1024

772+ if exp10 > 1024

758 then whenFail (fail msg)

773 then whenFail (fail msg)

759 else f scientific

774 else f scientific

760 where

775 where

761− exponent = base10Exponent scientific

776+ exp10 = base10Exponent scientific

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

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

763withBoundedScientific_ whenFail _ v =

778withBoundedScientific_ whenFail _ v =

764 whenFail (typeMismatch "Number" v)

779 whenFail (typeMismatch "Number" v)

765{-# INLINE withBoundedScientific_ #-}

780{-# INLINE withBoundedScientific_ #-}

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

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

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

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

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

781withEmbeddedJSON _ innerParser (String txt) =

796withEmbeddedJSON _ innerParser (String txt) =

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

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

783 where

798 where

784 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON

799 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON

785 eitherFormatError = either (Left . uncurry formatError) Right

800 eitherFormatError = either (Left . uncurry formatError) Right

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

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

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

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

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

850explicitParseField p obj key = case H.lookup key obj of

865explicitParseField p obj key = case H.lookup key obj of

851− Nothing -> fail $ "key " ++ show key ++ " not present"

866+ Nothing -> fail $ "key " ++ show key ++ " not found"

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

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

853{-# INLINE explicitParseField #-}

868{-# INLINE explicitParseField #-}

854

869

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

907contextType :: TypeName -> Parser a -> Parser a

922contextType :: TypeName -> Parser a -> Parser a

908contextType = prependContext

923contextType = prependContext

909

924

925+-- | Add the tagKey that will be looked up while building an ADT

926+-- | Produce the error equivalent to

927+-- | Left "Error in $: parsing T failed, expected an object with keys "tag" and

928+-- | "contents", where "tag" i-- |s associated to one of ["Foo", "Bar"],

929+-- | The parser returned error was: could not find key "tag"

930+contextTag :: Text -> [String] -> Parser a -> Parser a

931+contextTag tagKey cnames = prependFailure

932+ ("expected Object with key \"" ++ unpack tagKey ++ "\"" ++

933+ " containing one of " ++ show cnames ++ ", ")

934+

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

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

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

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

912contextCons cname tname = prependContext (showCons cname tname)

937contextCons cname tname = prependContext (showCons cname tname)

@@ -1017,41 +1042,46 @@ parseAllNullarySum :: (SumFromString f, ConstructorNames f)

1017parseAllNullarySum tname opts =

1042parseAllNullarySum tname opts =

1018 withText tname $ \tag ->

1043 withText tname $ \tag ->

1019 maybe (badTag tag) return $

1044 maybe (badTag tag) return $

1020− parseSumFromString opts tag

1045+ parseSumFromString modifier tag

1021 where

1046 where

1022− badTag tag = failWithCTags tname opts $ \cnames ->

1047+ badTag tag = failWithCTags tname modifier $ \cnames ->

1023 "expected one of the tags " ++ show cnames ++

1048 "expected one of the tags " ++ show cnames ++

1024 ", but found tag " ++ show tag

1049 ", but found tag " ++ show tag

1050+ modifier = constructorTagModifier opts

1025

1051

1026-- | Fail with an informative error message about a mismatched tag.

1052-- | Fail with an informative error message about a mismatched tag.

1027-- The error message is parameterized by the list of expected tags,

1053-- The error message is parameterized by the list of expected tags,

1028-- to be inferred from the result type of the parser.

1054-- to be inferred from the result type of the parser.

1029failWithCTags

1055failWithCTags

1030− :: forall f a. ConstructorNames f

1056+ :: forall f a t. ConstructorNames f

1031− => TypeName -> Options -> ([String] -> String) -> Parser (f a)

1057+ => TypeName -> (String -> t) -> ([t] -> String) -> Parser (f a)

1032−failWithCTags tname opts f =

1058+failWithCTags tname modifier f =

1033 contextType tname . fail $ f cnames

1059 contextType tname . fail $ f cnames

1034 where

1060 where

1035− cnames = unTagged2 (constructorTags opts :: Tagged2 f [String])

1061+ cnames = unTagged2 (constructorTags modifier :: Tagged2 f [t])

1036

1062

1037class SumFromString f where

1063class SumFromString f where

1038− parseSumFromString :: Options -> Text -> Maybe (f a)

1064+ parseSumFromString :: (String -> String) -> Text -> Maybe (f a)

1039

1065

1040instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where

1066instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where

1041 parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>

1067 parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>

1042 (R1 <$> parseSumFromString opts key)

1068 (R1 <$> parseSumFromString opts key)

1043

1069

1044instance (Constructor c) => SumFromString (C1 c U1) where

1070instance (Constructor c) => SumFromString (C1 c U1) where

1045− parseSumFromString opts key | key == name = Just $ M1 U1

1071+ parseSumFromString modifier key

1072+ | key == name = Just $ M1 U1

1046− | otherwise = Nothing

1073+ | otherwise = Nothing

1047− where

1074+ where

1048− name = pack $ constructorTagModifier opts $

1049− conName (undefined :: M1 _i c _f _p)

1075+ name = pack $ modifier $ conName (undefined :: M1 _i c _f _p)

1076+

1077+-- For genericFromJSONKey

1078+instance SumFromString a => SumFromString (D1 d a) where

1079+ parseSumFromString modifier key = M1 <$> parseSumFromString modifier key

1050

1080

1051-- | List of all constructor tags.

1081-- | List of all constructor tags.

1052−constructorTags :: ConstructorNames a => Options -> Tagged2 a [String]

1082+constructorTags :: ConstructorNames a => (String -> t) -> Tagged2 a [t]

1053−constructorTags opts =

1083+constructorTags modifier =

1054− fmap DList.toList (constructorNames' (constructorTagModifier opts))

1084+ fmap DList.toList (constructorNames' modifier)

1055

1085

1056-- | List of all constructor names of an ADT, after a given conversion

1086-- | List of all constructor names of an ADT, after a given conversion

1057-- function. (Better inlining.)

1087-- function. (Better inlining.)

@@ -1072,9 +1102,16 @@ instance Constructor c => ConstructorNames (C1 c a) where

1072 where

1102 where

1073 cname = conName (undefined :: M1 _i c _f _p)

1103 cname = conName (undefined :: M1 _i c _f _p)

1074

1104

1075−--------------------------------------------------------------------------------

1105+-- For genericFromJSONKey

1106+instance ConstructorNames a => ConstructorNames (D1 d a) where

1107+ constructorNames' = retag . constructorNames'

1108+ where

1109+ retag :: Tagged2 a u -> Tagged2 (D1 d a) u

1110+ retag (Tagged2 x) = Tagged2 x

1076

1111

1112+--------------------------------------------------------------------------------

1077−parseNonAllNullarySum :: ( FromPair arity f

1113+parseNonAllNullarySum :: forall f c arity.

1114+ ( FromPair arity f

1078 , FromTaggedObject arity f

1115 , FromTaggedObject arity f

1079 , FromUntaggedValue arity f

1116 , FromUntaggedValue arity f

1080 , ConstructorNames f

1117 , ConstructorNames f

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

1084 case sumEncoding opts of

1121 case sumEncoding opts of

1085 TaggedObject{..} ->

1122 TaggedObject{..} ->

1086 withObject tname $ \obj -> do

1123 withObject tname $ \obj -> do

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

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

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

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

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

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

1090 where

1127 where

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

1092 badTag tag = failWith_ $ \cnames ->

1129 badTag tag = failWith_ $ \cnames ->

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

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

1094 ", but found tag " ++ show tag

1131 ", but found tag " ++ show tag

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

1095

1133

1096 ObjectWithSingleField ->

1134 ObjectWithSingleField ->

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

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

@@ -1123,7 +1161,7 @@ parseNonAllNullarySum p@(tname :* opts :* _) =

1123

1161

1124 UntaggedValue -> parseUntaggedValue p

1162 UntaggedValue -> parseUntaggedValue p

1125 where

1163 where

1126− failWith_ = failWithCTags tname opts

1164+ failWith_ = failWithCTags tname (constructorTagModifier opts)

1127

1165

1128--------------------------------------------------------------------------------

1166--------------------------------------------------------------------------------

1129

1167

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

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

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

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

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

1165

1203

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

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

1167 -- Records are unpacked in the tagged object

1205 -- Records are unpacked in the tagged object

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

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

1169

1207

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

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

1171 -- Nonnullary nonrecords are encoded in the contents field

1209 -- Nonnullary nonrecords are encoded in the contents field

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

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

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

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

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

1208 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs

1246 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs

1209− | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON p)

1247+ | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))

1210

1248

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

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

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

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

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

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

1214

1252

1215instance OVERLAPPING_

1253instance OVERLAPPING_

1216 ConsFromJSON' arity U1 False where

1254 ConsFromJSON' arity U1 False where

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

1236

1274

1237--------------------------------------------------------------------------------

1275--------------------------------------------------------------------------------

1238

1276

1277+class FieldNames f where

1278+ fieldNames :: f a -> [Text] -> [Text]

1279+

1280+instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where

1281+ fieldNames _ =

1282+ fieldNames (undefined :: a x) .

1283+ fieldNames (undefined :: b y)

1284+

1285+instance (Selector s) => FieldNames (S1 s f) where

1286+ fieldNames _ = (pack (selName (undefined :: M1 _i s _f _p)) :)

1287+

1239class RecordFromJSON arity f where

1288class RecordFromJSON arity f where

1240 recordParseJSON

1289 recordParseJSON

1290+ :: Bool :* ConName :* TypeName :* Options :* FromArgs arity a

1291+ -> Object -> Parser (f a)

1292+

1293+instance ( FieldNames f

1294+ , RecordFromJSON' arity f

1295+ ) => RecordFromJSON arity f where

1296+ recordParseJSON (fromTaggedSum :* p@(cname :* tname :* opts :* _)) =

1297+ \obj -> checkUnknown obj >> recordParseJSON' p obj

1298+ where

1299+ knownFields :: H.HashMap Text ()

1300+ knownFields = H.fromList $ map (,()) $

1301+ fieldNames (undefined :: f a)

1302+ [pack (tagFieldName (sumEncoding opts)) | fromTaggedSum]

1303+ checkUnknown =

1304+ if not (rejectUnknownFields opts)

1305+ then \_ -> return ()

1306+ else \obj -> case H.keys (H.difference obj knownFields) of

1307+ [] -> return ()

1308+ unknownFields -> contextCons cname tname $

1309+ fail ("unknown fields: " ++ show unknownFields)

1310+

1311+class RecordFromJSON' arity f where

1312+ recordParseJSON'

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

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

1242 -> Object -> Parser (f a)

1314 -> Object -> Parser (f a)

1243

1315

1244−instance ( RecordFromJSON arity a

1316+instance ( RecordFromJSON' arity a

1245− , RecordFromJSON arity b

1317+ , RecordFromJSON' arity b

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

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

1247− recordParseJSON p obj =

1319+ recordParseJSON' p obj =

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

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

1249− <*> recordParseJSON p obj

1321+ <*> recordParseJSON' p obj

1250

1322

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

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

1252− RecordFromJSON arity (S1 s a) where

1324+ RecordFromJSON' arity (S1 s a) where

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

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

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

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

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

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

1256 where

1328 where

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

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

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

1259

1331

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

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

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

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

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

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

1263 where

1335 where

1264 label = fieldLabelModifier opts sname

1336 label = fieldLabelModifier opts sname

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

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

1266

1338

1267-- Parse an Option like a Maybe.

1339-- Parse an Option like a Maybe.

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

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

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

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

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

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

1271 where

1343 where

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

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

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

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

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

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

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

1505

1577

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

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

1579+ parseJSON (Number x)

1580+ | exp10 <= 1024

1581+ , exp10 >= -1024 = return $! realToFrac x

1582+ | otherwise = prependContext "Ratio" $ fail msg

1583+ where

1584+ exp10 = base10Exponent x

1585+ msg = "found a number with exponent " ++ show exp10

1586+ ++ ", but it must not be greater than 1024 or less than -1024"

1587+ parseJSON o = objParser o

1588+ where

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

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

1508− numerator <- obj .: "numerator"

1590+ numerator <- obj .: "numerator"

1509− denominator <- obj .: "denominator"

1591+ denominator <- obj .: "denominator"

1510− if denominator == 0

1592+ if denominator == 0

1511− then fail "Ratio denominator was 0"

1593+ then fail "Ratio denominator was 0"

1512− else pure $ numerator % denominator

1594+ else pure $ numerator % denominator

1513 {-# INLINE parseJSON #-}

1595 {-# INLINE parseJSON #-}

1514

1596

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

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

@@ -1660,7 +1742,7 @@ instance FromJSON1 NonEmpty where

1660 liftParseJSON p _ = withArray "NonEmpty" $

1742 liftParseJSON p _ = withArray "NonEmpty" $

1661 (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList

1743 (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList

1662 where

1744 where

1663− ne [] = fail "parsing NonEmpty failed, unpexpected empty list"

1745+ ne [] = fail "parsing NonEmpty failed, unexpected empty list"

1664 ne (x:xs) = pure (x :| xs)

1746 ne (x:xs) = pure (x :| xs)

1665 {-# INLINE liftParseJSON #-}

1747 {-# INLINE liftParseJSON #-}

1666

1748

@@ -1915,7 +1997,7 @@ instance FromJSON DotNetTime where

1915 parseJSON = withText "DotNetTime" $ \t ->

1997 parseJSON = withText "DotNetTime" $ \t ->

1916 let (s,m) = T.splitAt (T.length t - 5) t

1998 let (s,m) = T.splitAt (T.length t - 5) t

1917 t' = T.concat [s,".",m]

1999 t' = T.concat [s,".",m]

1918− in case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of

2000+ in case parseTimeM True defaultTimeLocale "/Date(%s%Q)/" (unpack t') of

1919 Just d -> pure (DotNetTime d)

2001 Just d -> pure (DotNetTime d)

1920 _ -> fail "could not parse .NET time"

2002 _ -> fail "could not parse .NET time"

1921 {-# INLINE parseJSON #-}

2003 {-# INLINE parseJSON #-}

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

1924-- primitive

2006-- primitive

1925-------------------------------------------------------------------------------

2007-------------------------------------------------------------------------------

1926

2008

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

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

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

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

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

1930 -- constructor in Data.Vector.

2011 -- constructor in Data.Vector.

@@ -1937,6 +2018,7 @@ instance FromJSON a => FromJSON (PM.SmallArray a) where

1937instance (PM.Prim a,FromJSON a) => FromJSON (PM.PrimArray a) where

2018instance (PM.Prim a,FromJSON a) => FromJSON (PM.PrimArray a) where

1938 parseJSON = fmap Exts.fromList . parseJSON

2019 parseJSON = fmap Exts.fromList . parseJSON

1939

2020

2021+#if !MIN_VERSION_primitive(0,7,0)

1940instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where

2022instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where

1941 parseJSON = fmap Exts.fromList . parseJSON

2023 parseJSON = fmap Exts.fromList . parseJSON

1942#endif

2024#endif

@@ -2009,6 +2091,40 @@ instance FromJSON DiffTime where

2009 parseJSON = withBoundedScientific "DiffTime" $ pure . realToFrac

2091 parseJSON = withBoundedScientific "DiffTime" $ pure . realToFrac

2010 {-# INLINE parseJSON #-}

2092 {-# INLINE parseJSON #-}

2011

2093

2094+instance FromJSON SystemTime where

2095+ parseJSON v = prependContext "SystemTime" $ do

2096+ n <- parseJSON v

2097+ let n' = floor (n * fromInteger (resolution n) :: Nano)

2098+ let (secs, nano) = n' `divMod` resolution n

2099+ return (MkSystemTime (fromInteger secs) (fromInteger nano))

2100+

2101+instance FromJSON CalendarDiffTime where

2102+ parseJSON = withObject "CalendarDiffTime" $ \obj -> CalendarDiffTime

2103+ <$> obj .: "months"

2104+ <*> obj .: "time"

2105+

2106+instance FromJSON CalendarDiffDays where

2107+ parseJSON = withObject "CalendarDiffDays" $ \obj -> CalendarDiffDays

2108+ <$> obj .: "months"

2109+ <*> obj .: "days"

2110+

2111+instance FromJSON DayOfWeek where

2112+ parseJSON = withText "DaysOfWeek" parseDayOfWeek

2113+

2114+parseDayOfWeek :: T.Text -> Parser DayOfWeek

2115+parseDayOfWeek t = case T.toLower t of

2116+ "monday" -> return Monday

2117+ "tuesday" -> return Tuesday

2118+ "wednesday" -> return Wednesday

2119+ "thursday" -> return Thursday

2120+ "friday" -> return Friday

2121+ "saturday" -> return Saturday

2122+ "sunday" -> return Sunday

2123+ _ -> fail "Invalid week day"

2124+

2125+instance FromJSONKey DayOfWeek where

2126+ fromJSONKey = FromJSONKeyTextParser parseDayOfWeek

2127+

2012-------------------------------------------------------------------------------

2128-------------------------------------------------------------------------------

2013-- base Monoid/Semigroup

2129-- base Monoid/Semigroup

2014-------------------------------------------------------------------------------

2130-------------------------------------------------------------------------------

Data/Aeson/Types/Generic.hs−1

@@ -5,7 +5,6 @@

5{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE FunctionalDependencies #-}

7{-# LANGUAGE KindSignatures #-}

8−{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE NoImplicitPrelude #-}

8{-# LANGUAGE NoImplicitPrelude #-}

10{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE TypeOperators #-}

10{-# LANGUAGE TypeOperators #-}

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

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

49 , parserThrowError

50 , parserCatchError

51 , formatError

52+ , formatPath

53+ , formatRelativePath

52 , (<?>)

54 , (<?>)

53 -- * Constructors and accessors

55 -- * Constructors and accessors

54 , object

56 , object

@@ -62,11 +64,14 @@ module Data.Aeson.Types.Internal

62 , sumEncoding

64 , sumEncoding

63 , unwrapUnaryRecords

65 , unwrapUnaryRecords

64 , tagSingleConstructors

66 , tagSingleConstructors

67+ , rejectUnknownFields

65 )

68 )

67 , SumEncoding(..)

70 , SumEncoding(..)

71+ , JSONKeyOptions(keyModifier)

68 , defaultOptions

72 , defaultOptions

69 , defaultTaggedObject

73 , defaultTaggedObject

74+ , defaultJSONKeyOptions

71 -- * Used for changing CamelCase names into something else.

76 -- * Used for changing CamelCase names into something else.

72 , camelTo

77 , camelTo

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

97import Data.Typeable (Typeable)

102import Data.Typeable (Typeable)

98import Data.Vector (Vector)

103import Data.Vector (Vector)

99import GHC.Generics (Generic)

104import GHC.Generics (Generic)

105+import qualified Control.Monad as Monad

100import qualified Control.Monad.Fail as Fail

106import qualified Control.Monad.Fail as Fail

101import qualified Data.HashMap.Strict as H

107import qualified Data.HashMap.Strict as H

102import qualified Data.Scientific as S

108import qualified Data.Scientific as S

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

150 fmap _ (Error err) = Error err

156 fmap _ (Error err) = Error err

151 {-# INLINE fmap #-}

157 {-# INLINE fmap #-}

152

158

153−instance Monad IResult where

159+instance Monad.Monad IResult where

154 return = pure

160 return = pure

155 {-# INLINE return #-}

161 {-# INLINE return #-}

156

162

@@ -158,14 +164,16 @@ instance Monad IResult where

158 IError path err >>= _ = IError path err

164 IError path err >>= _ = IError path err

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

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

160

166

167+#if !(MIN_VERSION_base(4,13,0))

161 fail = Fail.fail

168 fail = Fail.fail

162 {-# INLINE fail #-}

169 {-# INLINE fail #-}

170+#endif

163

171

164instance Fail.MonadFail IResult where

172instance Fail.MonadFail IResult where

165 fail err = IError [] err

173 fail err = IError [] err

166 {-# INLINE fail #-}

174 {-# INLINE fail #-}

167

175

168−instance Monad Result where

176+instance Monad.Monad Result where

169 return = pure

177 return = pure

170 {-# INLINE return #-}

178 {-# INLINE return #-}

171

179

@@ -173,8 +181,10 @@ instance Monad Result where

173 Error err >>= _ = Error err

181 Error err >>= _ = Error err

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

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

175

183

184+#if !(MIN_VERSION_base(4,13,0))

176 fail = Fail.fail

185 fail = Fail.fail

177 {-# INLINE fail #-}

186 {-# INLINE fail #-}

187+#endif

178

188

179instance Fail.MonadFail Result where

189instance Fail.MonadFail Result where

180 fail err = Error err

190 fail err = Error err

@@ -282,14 +292,17 @@ newtype Parser a = Parser {

282 -> f r

292 -> f r

283 }

293 }

284

294

285−instance Monad Parser where

295+instance Monad.Monad Parser where

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

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

287 in runParser m path kf ks'

297 in runParser m path kf ks'

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

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

289 return = pure

299 return = pure

290 {-# INLINE return #-}

300 {-# INLINE return #-}

301+

302+#if !(MIN_VERSION_base(4,13,0))

291 fail = Fail.fail

303 fail = Fail.fail

292 {-# INLINE fail #-}

304 {-# INLINE fail #-}

305+#endif

293

306

294instance Fail.MonadFail Parser where

307instance Fail.MonadFail Parser where

295 fail msg = Parser $ \path kf _ks -> kf (reverse path) msg

308 fail msg = Parser $ \path kf _ks -> kf (reverse path) msg

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

448-- | Annotate an error message with a

461-- | Annotate an error message with a

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

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

450formatError :: JSONPath -> String -> String

463formatError :: JSONPath -> String -> String

451−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

452 where

475 where

453 format :: String -> JSONPath -> String

476 format :: String -> JSONPath -> String

454 format pfx [] = pfx

477 format pfx [] = pfx

@@ -561,6 +584,39 @@ data Options = Options

561 -- ^ If 'True' record fields with a 'Nothing' value will be

584 -- ^ If 'True' record fields with a 'Nothing' value will be

562 -- omitted from the resulting object. If 'False' the resulting

585 -- omitted from the resulting object. If 'False' the resulting

563 -- object will include those fields mapping to @null@.

586 -- object will include those fields mapping to @null@.

587+ --

588+ -- === Note

589+ --

590+ -- Setting 'omitNothingFields' to 'True' only affects fields which are of

591+ -- type 'Maybe' /uniformly/ in the 'ToJSON' or 'FromJSON' instance. In

592+ -- particular, if the type of a field is declared as a type variable, it

593+ -- will not be omitted from the JSON object, unless the field is

594+ -- specialized upfront in the instance.

595+ --

596+ -- ==== __Example__

597+ --

598+ -- The generic instance for the following type @Fruit@ depends on whether

599+ -- the instance head is @Fruit a@ or @Fruit (Maybe a)@.

600+ --

601+ -- @

602+ -- data Fruit a =

603+ -- { apples :: a -- A field whose type is a type variable.

604+ -- , oranges :: 'Maybe' Int

605+ -- }

606+ --

607+ -- options :: 'Options'

608+ -- options = 'defaultOptions' { 'omitNothingFields' = 'True' }

609+ --

610+ -- -- apples required, oranges optional

611+ -- -- Even if 'Data.Aeson.fromJSON' is then specialized to (Fruit ('Maybe' a)).

612+ -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit a) where

613+ -- 'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options

614+ --

615+ -- -- apples optional, oranges optional

616+ -- -- In this instance, the field apples is uniformly of type ('Maybe' a).

617+ -- instance 'Data.Aeson.FromJSON' a => 'Data.Aeson.FromJSON' (Fruit ('Maybe' a)) where

618+ -- 'Data.Aeson.fromJSON' = 'Data.Aeson.genericFromJSON' options

619+ -- @

564 , sumEncoding :: SumEncoding

620 , sumEncoding :: SumEncoding

565 -- ^ Specifies how to encode constructors of a sum datatype.

621 -- ^ Specifies how to encode constructors of a sum datatype.

566 , unwrapUnaryRecords :: Bool

622 , unwrapUnaryRecords :: Bool

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

569 , tagSingleConstructors :: Bool

625 , tagSingleConstructors :: Bool

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

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

571 -- so that `allNullaryToStringTag` and `sumEncoding` apply.

627 -- so that `allNullaryToStringTag` and `sumEncoding` apply.

628+ , rejectUnknownFields :: Bool

629+ -- ^ Applies only to 'Data.Aeson.FromJSON' instances. If a field appears in

630+ -- the parsed object map, but does not appear in the target object, parsing

631+ -- will fail, with an error message indicating which fields were unknown.

572 }

632 }

573

633

574instance Show Options where

634instance Show Options where

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

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

576 "Options {"

636 "Options {"

577 ++ intercalate ", "

637 ++ intercalate ", "

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

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

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

582 , "sumEncoding = " ++ show s

642 , "sumEncoding = " ++ show s

583 , "unwrapUnaryRecords = " ++ show u

643 , "unwrapUnaryRecords = " ++ show u

584 , "tagSingleConstructors = " ++ show t

644 , "tagSingleConstructors = " ++ show t

645+ , "rejectUnknownFields = " ++ show r

585 ]

646 ]

586 ++ "}"

647 ++ "}"

587

648

@@ -625,6 +686,33 @@ data SumEncoding =

625 -- contents of the constructor.

686 -- contents of the constructor.

626 deriving (Eq, Show)

687 deriving (Eq, Show)

627

688

689+-- | Options for encoding keys with 'Data.Aeson.Types.genericFromJSONKey' and

690+-- 'Data.Aeson.Types.genericToJSONKey'.

691+data JSONKeyOptions = JSONKeyOptions

692+ { keyModifier :: String -> String

693+ -- ^ Function applied to keys. Its result is what goes into the encoded

694+ -- 'Value'.

695+ --

696+ -- === __Example__

697+ --

698+ -- The following instances encode the constructor @Bar@ to lower-case keys

699+ -- @\"bar\"@.

700+ --

701+ -- @

702+ -- data Foo = Bar

703+ -- deriving 'Generic'

704+ --

705+ -- opts :: 'JSONKeyOptions'

706+ -- opts = 'defaultJSONKeyOptions' { 'keyModifier' = 'toLower' }

707+ --

708+ -- instance 'ToJSONKey' Foo where

709+ -- 'toJSONKey' = 'genericToJSONKey' opts

710+ --

711+ -- instance 'FromJSONKey' Foo where

712+ -- 'fromJSONKey' = 'genericFromJSONKey' opts

713+ -- @

714+ }

715+

628-- | Default encoding 'Options':

716-- | Default encoding 'Options':

629--

717--

630-- @

718-- @

@@ -636,6 +724,7 @@ data SumEncoding =

636-- , 'sumEncoding' = 'defaultTaggedObject'

724-- , 'sumEncoding' = 'defaultTaggedObject'

637-- , 'unwrapUnaryRecords' = False

725-- , 'unwrapUnaryRecords' = False

638-- , 'tagSingleConstructors' = False

726-- , 'tagSingleConstructors' = False

727+-- , 'rejectUnknownFields' = False

639-- }

728-- }

640-- @

729-- @

641defaultOptions :: Options

730defaultOptions :: Options

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

647 , sumEncoding = defaultTaggedObject

736 , sumEncoding = defaultTaggedObject

648 , unwrapUnaryRecords = False

737 , unwrapUnaryRecords = False

649 , tagSingleConstructors = False

738 , tagSingleConstructors = False

739+ , rejectUnknownFields = False

650 }

740 }

651

741

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

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

@@ -663,6 +753,16 @@ defaultTaggedObject = TaggedObject

663 , contentsFieldName = "contents"

753 , contentsFieldName = "contents"

664 }

754 }

665

755

756+-- | Default 'JSONKeyOptions':

757+--

758+-- @

759+-- defaultJSONKeyOptions = 'JSONKeyOptions'

760+-- { 'keyModifier' = 'id'

761+-- }

762+-- @

763+defaultJSONKeyOptions :: JSONKeyOptions

764+defaultJSONKeyOptions = JSONKeyOptions id

765+

666-- | Converts from CamelCase to another lower case, interspersing

766-- | Converts from CamelCase to another lower case, interspersing

667-- the character between all capital letters and their previous

767-- the character between all capital letters and their previous

668-- entries, except those capital letters that appear together,

768-- entries, except those capital letters that appear together,

Data/Aeson/Types/ToJSON.hs+98−52

@@ -5,21 +5,15 @@

5{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE FunctionalDependencies #-}

7{-# LANGUAGE GADTs #-}

8−{-# LANGUAGE MultiParamTypeClasses #-}

9−{-# LANGUAGE NamedFieldPuns #-}

10{-# LANGUAGE NoImplicitPrelude #-}

8{-# LANGUAGE NoImplicitPrelude #-}

11{-# LANGUAGE OverloadedStrings #-}

9{-# LANGUAGE OverloadedStrings #-}

12{-# LANGUAGE PatternGuards #-}

10{-# LANGUAGE PatternGuards #-}

11+{-# LANGUAGE PolyKinds #-}

13{-# LANGUAGE RecordWildCards #-}

12{-# LANGUAGE RecordWildCards #-}

14{-# LANGUAGE ScopedTypeVariables #-}

13{-# LANGUAGE ScopedTypeVariables #-}

15{-# LANGUAGE TypeOperators #-}

14{-# LANGUAGE TypeOperators #-}

16−{-# LANGUAGE TypeSynonymInstances #-}

17{-# LANGUAGE UndecidableInstances #-}

15{-# LANGUAGE UndecidableInstances #-}

19−#if __GLASGOW_HASKELL__ >= 706

20−{-# LANGUAGE PolyKinds #-}

21−#endif

22−

23#include "overlapping-compat.h"

17#include "overlapping-compat.h"

24#include "incoherent-compat.h"

18#include "incoherent-compat.h"

@@ -49,6 +43,10 @@ module Data.Aeson.Types.ToJSON

49 , ToJSONKeyFunction(..)

43 , ToJSONKeyFunction(..)

50 , toJSONKeyText

44 , toJSONKeyText

51 , contramapToJSONKeyFunction

45 , contramapToJSONKeyFunction

46+

47+ , GToJSONKey()

48+ , genericToJSONKey

49+

52 -- * Object key-value pairs

50 -- * Object key-value pairs

53 , KeyValue(..)

51 , KeyValue(..)

54 , KeyValuePair(..)

52 , KeyValuePair(..)

@@ -71,7 +69,7 @@ import Data.Aeson.Types.Internal

71import Data.Attoparsec.Number (Number(..))

69import Data.Attoparsec.Number (Number(..))

72import Data.Bits (unsafeShiftR)

70import Data.Bits (unsafeShiftR)

73import Data.DList (DList)

71import Data.DList (DList)

74−import Data.Fixed (Fixed, HasResolution)

72+import Data.Fixed (Fixed, HasResolution, Nano)

75import Data.Foldable (toList)

73import Data.Foldable (toList)

76import Data.Functor.Compose (Compose(..))

74import Data.Functor.Compose (Compose(..))

77import Data.Functor.Contravariant (Contravariant (..))

75import Data.Functor.Contravariant (Contravariant (..))

@@ -88,8 +86,10 @@ import Data.Scientific (Scientific)

88import Data.Tagged (Tagged(..))

86import Data.Tagged (Tagged(..))

89import Data.Text (Text, pack)

87import Data.Text (Text, pack)

90import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)

88import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)

89+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))

90+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))

91+import Data.Time.Clock.System.Compat (SystemTime (..))

91−import Data.Time.Format (FormatTime, formatTime)

92+import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)

92−import Data.Time.Locale.Compat (defaultTimeLocale)

93import Data.Vector (Vector)

94import Data.Version (Version, showVersion)

95import Data.Void (Void, absurd)

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

100import Numeric.Natural (Natural)

101import qualified Data.Aeson.Encoding as E

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

103−import qualified Data.ByteString as S

104import qualified Data.ByteString.Lazy as L

103import qualified Data.ByteString.Lazy as L

105import qualified Data.DList as DList

104import qualified Data.DList as DList

106import qualified Data.HashMap.Strict as H

105import qualified Data.HashMap.Strict as H

@@ -135,20 +134,12 @@ import qualified Data.Primitive.SmallArray as PM

135import qualified Data.Primitive.Types as PM

134import qualified Data.Primitive.Types as PM

136

135

137#if MIN_VERSION_primitive(0,6,4)

136#if MIN_VERSION_primitive(0,6,4)

137+#if !MIN_VERSION_primitive(0,7,0)

138import qualified Data.Primitive.UnliftedArray as PM

139−import qualified Data.Primitive.PrimArray as PM

140#endif

139#endif

141−

142−#if !(MIN_VERSION_bytestring(0,10,0))

143−import Foreign.ForeignPtr (withForeignPtr)

144−import Foreign.Marshal.Utils (copyBytes)

145−import Foreign.Ptr (plusPtr)

146−import qualified Data.ByteString.Internal as S

140+import qualified Data.Primitive.PrimArray as PM

147−import qualified Data.ByteString.Lazy.Internal as L

148#endif

141#endif

149

142

150−{-# ANN module ("HLint: ignore Reduce duplication"::String) #-}

151−

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

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

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

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

154{-# INLINE toJSONPair #-}

145{-# INLINE toJSONPair #-}

@@ -411,7 +402,7 @@ instance KeyValue Object where

411-- newtype wrapper around 'Text'. The recommended approach is to use

402-- newtype wrapper around 'Text'. The recommended approach is to use

412-- generalized newtype deriving:

403-- generalized newtype deriving:

413--

404--

414−-- > newtype RecordId = RecordId { getRecordId :: Text}

405+-- > newtype RecordId = RecordId { getRecordId :: Text }

415-- > deriving (Eq,Ord,ToJSONKey)

406-- > deriving (Eq,Ord,ToJSONKey)

416--

407--

417-- Then we may write:

408-- Then we may write:

@@ -426,8 +417,18 @@ instance KeyValue Object where

426--

417--

427-- It is possible to get the 'ToJSONKey' instance for free as we did

418-- It is possible to get the 'ToJSONKey' instance for free as we did

428-- with 'Foo'. However, in this case, we have a natural way to go to

419-- with 'Foo'. However, in this case, we have a natural way to go to

429−-- and from 'Text' that does not require any escape sequences. So, in

420+-- and from 'Text' that does not require any escape sequences. So

430−-- this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.

421+-- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps

422+-- as objects instead of arrays of pairs. This instance may be

423+-- implemented using generics as follows:

424+--

425+-- @

426+-- instance 'ToJSONKey' Color where

427+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'

428+-- @

429+--

430+-- === __Low-level implementations__

431+--

431-- The 'Show' instance can be used to help write 'ToJSONKey':

432-- The 'Show' instance can be used to help write 'ToJSONKey':

432--

433--

433-- > instance ToJSONKey Color where

434-- > instance ToJSONKey Color where

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

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

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

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

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

504 . T.decodeLatin1

505 . T.decodeLatin1

505− . lazyToStrictByteString

506+ . L.toStrict

506 . E.encodingToLazyByteString

507 . E.encodingToLazyByteString

507 . e

508 . e

508

509

@@ -515,6 +516,29 @@ contramapToJSONKeyFunction h x = case x of

515 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)

516 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)

516 ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)

517 ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)

517

518

519+-- 'toJSONKey' for 'Generic' types.

520+-- Deriving is supported for enumeration types, i.e. the sums of nullary

521+-- constructors. The names of constructors will be used as keys for JSON

522+-- objects.

523+--

524+-- See also 'genericFromJSONKey'.

525+--

526+-- === __Example__

527+--

528+-- @

529+-- data Color = Red | Green | Blue

530+-- deriving 'Generic'

531+--

532+-- instance 'ToJSONKey' Color where

533+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'

534+-- @

535+genericToJSONKey :: (Generic a, GToJSONKey (Rep a))

536+ => JSONKeyOptions -> ToJSONKeyFunction a

537+genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)

538+

539+class GetConName f => GToJSONKey f

540+instance GetConName f => GToJSONKey f

541+

518-------------------------------------------------------------------------------

542-------------------------------------------------------------------------------

519-- Lifings of FromJSON and ToJSON to unary and binary type constructors

543-- Lifings of FromJSON and ToJSON to unary and binary type constructors

520-------------------------------------------------------------------------------

544-------------------------------------------------------------------------------

@@ -944,6 +968,9 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where

944instance (Constructor c) => GetConName (C1 c a) where

968instance (Constructor c) => GetConName (C1 c a) where

945 getConName = conName

969 getConName = conName

946

970

971+-- For genericToJSONKey

972+instance GetConName a => GetConName (D1 d a) where

973+ getConName (M1 x) = getConName x

947

974

948--------------------------------------------------------------------------------

975--------------------------------------------------------------------------------

949

976

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

1943-- primitive

1970-- primitive

1944-------------------------------------------------------------------------------

1971-------------------------------------------------------------------------------

1945

1972

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

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

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

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

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

1949 -- constructor in Data.Vector.

1975 -- constructor in Data.Vector.

@@ -1959,6 +1985,7 @@ instance (PM.Prim a,ToJSON a) => ToJSON (PM.PrimArray a) where

1959 toJSON = toJSON . Exts.toList

1985 toJSON = toJSON . Exts.toList

1960 toEncoding = toEncoding . Exts.toList

1986 toEncoding = toEncoding . Exts.toList

1961

1987

1988+#if !MIN_VERSION_primitive(0,7,0)

1962instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where

1989instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where

1963 toJSON = toJSON . Exts.toList

1990 toJSON = toJSON . Exts.toList

1964 toEncoding = toEncoding . Exts.toList

1991 toEncoding = toEncoding . Exts.toList

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

2013stringEncoding = String

2040stringEncoding = String

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

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

2015 . T.decodeLatin1

2042 . T.decodeLatin1

2016− . lazyToStrictByteString

2043+ . L.toStrict

2017 . E.encodingToLazyByteString

2044 . E.encodingToLazyByteString

2018{-# INLINE stringEncoding #-}

2045{-# INLINE stringEncoding #-}

2019

2046

@@ -2033,6 +2060,50 @@ instance ToJSON DiffTime where

2033 toEncoding = E.scientific . realToFrac

2060 toEncoding = E.scientific . realToFrac

2034 {-# INLINE toEncoding #-}

2061 {-# INLINE toEncoding #-}

2035

2062

2063+-- | Encoded as number

2064+instance ToJSON SystemTime where

2065+ toJSON (MkSystemTime secs nsecs) =

2066+ toJSON (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)

2067+ toEncoding (MkSystemTime secs nsecs) =

2068+ toEncoding (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)

2069+

2070+instance ToJSON CalendarDiffTime where

2071+ toJSON (CalendarDiffTime m nt) = object

2072+ [ "months" .= m

2073+ , "time" .= nt

2074+ ]

2075+ toEncoding (CalendarDiffTime m nt) = E.pairs

2076+ ("months" .= m <> "time" .= nt)

2077+

2078+instance ToJSON CalendarDiffDays where

2079+ toJSON (CalendarDiffDays m d) = object

2080+ [ "months" .= m

2081+ , "days" .= d

2082+ ]

2083+ toEncoding (CalendarDiffDays m d) = E.pairs

2084+ ("months" .= m <> "days" .= d)

2085+

2086+instance ToJSON DayOfWeek where

2087+ toJSON Monday = "monday"

2088+ toJSON Tuesday = "tuesday"

2089+ toJSON Wednesday = "wednesday"

2090+ toJSON Thursday = "thursday"

2091+ toJSON Friday = "friday"

2092+ toJSON Saturday = "saturday"

2093+ toJSON Sunday = "sunday"

2094+

2095+toEncodingDayOfWeek :: DayOfWeek -> E.Encoding' Text

2096+toEncodingDayOfWeek Monday = E.unsafeToEncoding "\"monday\""

2097+toEncodingDayOfWeek Tuesday = E.unsafeToEncoding "\"tuesday\""

2098+toEncodingDayOfWeek Wednesday = E.unsafeToEncoding "\"wednesday\""

2099+toEncodingDayOfWeek Thursday = E.unsafeToEncoding "\"thursday\""

2100+toEncodingDayOfWeek Friday = E.unsafeToEncoding "\"friday\""

2101+toEncodingDayOfWeek Saturday = E.unsafeToEncoding "\"saturday\""

2102+toEncodingDayOfWeek Sunday = E.unsafeToEncoding "\"sunday\""

2103+

2104+instance ToJSONKey DayOfWeek where

2105+ toJSONKey = toJSONKeyTextEnc toEncodingDayOfWeek

2106+

2036-------------------------------------------------------------------------------

2107-------------------------------------------------------------------------------

2037-- base Monoid/Semigroup

2108-- base Monoid/Semigroup

2038-------------------------------------------------------------------------------

2109-------------------------------------------------------------------------------

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

2776 toEncoding = toEncoding2

2847 toEncoding = toEncoding2

2777 {-# INLINE toEncoding #-}

2848 {-# INLINE toEncoding #-}

2778

2849

2779−-------------------------------------------------------------------------------

2780−-- pre-bytestring-0.10 compatibility

2781−-------------------------------------------------------------------------------

2782−

2783−{-# INLINE lazyToStrictByteString #-}

2784−lazyToStrictByteString :: L.ByteString -> S.ByteString

2785−#if MIN_VERSION_bytestring(0,10,0)

2786−lazyToStrictByteString = L.toStrict

2787−#else

2788−lazyToStrictByteString = packChunks

2789−

2790−-- packChunks is taken from the blaze-builder package.

2791−

2792−-- | Pack the chunks of a lazy bytestring into a single strict bytestring.

2793−packChunks :: L.ByteString -> S.ByteString

2794−packChunks lbs =

2795− S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)

2796− where

2797− copyChunks L.Empty _pf = return ()

2798− copyChunks (L.Chunk (S.PS fpbuf o l) lbs') pf = do

2799− withForeignPtr fpbuf $ \pbuf ->

2800− copyBytes pf (pbuf `plusPtr` o) l

2801− copyChunks lbs' (pf `plusPtr` l)

2802−#endif

2803−

2804--------------------------------------------------------------------------------

2850--------------------------------------------------------------------------------

2805

2851

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

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

HLint.hsdeleted−12

@@ -1,12 +0,0 @@

1−module HLint.HLint where

2−

3−import "hint" HLint.Default

4−import "hint" HLint.Builtin.All

5−import "hint" HLint.Dollar

6−

7−ignore "Avoid lambda"

8−ignore "Eta reduce"

9−ignore "Functor law"

10−ignore "Use >=>"

11−ignore "Use lambda-case"

12−ignore "Use $>"

Makefile+1−1

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

1lint:

2− hlint --cpp-include include/ --cpp-file .stack-work/dist/*/*Cabal-*/build/autogen/cabal_macros.h Data/ attoparsec-iso8601/ benchmarks/ examples/ ffi/ pure/ tests/

2+ ./run-hlint.sh --cpp-include include/ --cpp-file travis/cabal_macros.h Data/ attoparsec-iso8601/ benchmarks/ examples/ ffi/ pure/ tests/

aeson.cabal+20−23

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

1name: aeson

2−version: 1.4.3.0

2+version: 1.4.6.0

3license: BSD3

4license-file: LICENSE

5category: Text, Web, JSON

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

88 Data.Aeson.Encode

90 other-modules:

91− Data.Aeson.Compat

92 Data.Aeson.Encoding.Builder

91 Data.Aeson.Encoding.Builder

93 Data.Aeson.Internal.Functions

92 Data.Aeson.Internal.Functions

94 Data.Aeson.Parser.Unescape

93 Data.Aeson.Parser.Unescape

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

103

102

104 -- GHC bundled libs

103 -- GHC bundled libs

105 build-depends:

104 build-depends:

106− base >= 4.5.0.0 && < 5,

105+ base >= 4.7.0.0 && < 5,

106+ bytestring >= 0.10.4.0 && < 0.11,

107− containers >= 0.4.2.1 && < 0.7,

107+ containers >= 0.5.5.1 && < 0.7,

108 deepseq >= 1.3.0.0 && < 1.5,

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

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

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

111 text >= 1.2.3.0 && < 1.3,

112− time >= 1.4 && < 1.9

112+ time >= 1.4 && < 1.10

113+

114+ if impl(ghc >= 8.0)

115+ build-depends: bytestring >= 0.10.8.1

113

116

114 -- Compat

117 -- Compat

115 build-depends:

118 build-depends:

116− base-compat >= 0.9.1 && < 0.11

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

117−

120+ time-compat >= 1.9.2.2 && < 1.10

118− if flag(bytestring-builder)

119− build-depends: bytestring >= 0.9.2 && < 0.10.4,

120− bytestring-builder >= 0.10.4 && < 1

121− else

122− build-depends: bytestring >= 0.10.4 && < 0.11

123

121

124 if !impl(ghc >= 8.6)

122 if !impl(ghc >= 8.6)

125 build-depends:

123 build-depends:

@@ -128,7 +126,7 @@ library

128 if !impl(ghc >= 8.0)

126 if !impl(ghc >= 8.0)

129 -- `Data.Semigroup` and `Control.Monad.Fail` and `Control.Monad.IO.Class` are available in base only since GHC 8.0 / base 4.9

127 -- `Data.Semigroup` and `Control.Monad.Fail` and `Control.Monad.IO.Class` are available in base only since GHC 8.0 / base 4.9

130 build-depends:

128 build-depends:

131− semigroups >= 0.18.5 && < 0.19,

129+ semigroups >= 0.18.5 && < 0.20,

132 transformers >= 0.3.0.0 && < 0.6,

130 transformers >= 0.3.0.0 && < 0.6,

133 transformers-compat >= 0.6.2 && < 0.7,

131 transformers-compat >= 0.6.2 && < 0.7,

134 fail == 4.9.*

132 fail == 4.9.*

@@ -144,16 +142,15 @@ library

144

142

145 -- not in LTS-12.10

143 -- not in LTS-12.10

146 tagged >= 0.8.5 && < 0.9,

144 tagged >= 0.8.5 && < 0.9,

147− primitive >= 0.6.3.0 && < 0.7

145+ primitive >= 0.6.3.0 && < 0.8

148

146

149 -- Other dependencies

147 -- Other dependencies

150 build-depends:

148 build-depends:

151 attoparsec >= 0.13.2.2 && < 0.14,

149 attoparsec >= 0.13.2.2 && < 0.14,

152 dlist >= 0.8.0.4 && < 0.9,

150 dlist >= 0.8.0.4 && < 0.9,

153− hashable >= 1.2.7.0 && < 1.3,

151+ hashable >= 1.2.7.0 && < 1.4,

154 scientific >= 0.3.6.2 && < 0.4,

152 scientific >= 0.3.6.2 && < 0.4,

155 th-abstraction >= 0.2.8.0 && < 0.4,

153 th-abstraction >= 0.2.8.0 && < 0.4,

156− time-locale-compat >= 0.1.1.5 && < 0.2,

157 uuid-types >= 1.0.3 && < 1.1,

154 uuid-types >= 1.0.3 && < 1.1,

158 vector >= 0.12.0.1 && < 0.13

155 vector >= 0.12.0.1 && < 0.13

159

156

@@ -211,7 +208,7 @@ test-suite tests

211 UnitTests.NullaryConstructors

208 UnitTests.NullaryConstructors

212

209

213 build-depends:

210 build-depends:

214− QuickCheck >= 2.10.0.1 && < 2.13,

211+ QuickCheck >= 2.10.0.1 && < 2.14,

215 aeson,

212 aeson,

216 integer-logarithms >= 1 && <1.1,

213 integer-logarithms >= 1 && <1.1,

217 attoparsec,

214 attoparsec,

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

222 containers,

219 containers,

223 directory,

220 directory,

224 dlist,

221 dlist,

225− Diff,

222+ Diff >= 0.4 && < 0.5,

226 filepath,

223 filepath,

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

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

228 ghc-prim >= 0.2,

225 ghc-prim >= 0.2,

229 hashable >= 1.2.4.0,

226 hashable >= 1.2.4.0,

230 scientific,

227 scientific,

@@ -236,11 +233,11 @@ test-suite tests

236 tasty-quickcheck,

233 tasty-quickcheck,

237 text,

234 text,

238 time,

235 time,

239− time-locale-compat,

236+ time-compat,

240 unordered-containers,

237 unordered-containers,

241 uuid-types,

238 uuid-types,

242 vector,

239 vector,

243− quickcheck-instances >= 0.3.16

240+ quickcheck-instances >= 0.3.21 && <0.4

244

241

245 if flag(bytestring-builder)

242 if flag(bytestring-builder)

246 build-depends: bytestring >= 0.9 && < 0.10.4,

243 build-depends: bytestring >= 0.9 && < 0.10.4,

@@ -250,7 +247,7 @@ test-suite tests

250

247

251 if !impl(ghc >= 8.0)

248 if !impl(ghc >= 8.0)

252 build-depends:

249 build-depends:

253− semigroups >= 0.18.2 && < 0.19,

250+ semigroups >= 0.18.2 && < 0.20,

254 transformers >= 0.2.2.0,

251 transformers >= 0.2.2.0,

255 transformers-compat >= 0.3

252 transformers-compat >= 0.3

256

253

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

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

30#endif

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

33−

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

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

36−#else

37−

38−import Data.Fixed (Pico)

39−

40−#endif

41−

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

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

44diffTimeToPicoseconds :: DiffTime -> Integer

36diffTimeToPicoseconds :: DiffTime -> Integer

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

47#endif

39#endif

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

50−

51toPico :: Integer -> Pico

41toPico :: Integer -> Pico

52toPico = MkFixed

42toPico = MkFixed

54fromPico :: Pico -> Integer

44fromPico :: Pico -> Integer

55fromPico (MkFixed i) = i

45fromPico (MkFixed i) = i

57−#else

58−

59−toPico :: Integer -> Pico

60−toPico = unsafeCoerce

61−

62−fromPico :: Pico -> Integer

63−fromPico = unsafeCoerce

64−

65−#endif

66−

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

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

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

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

69 {-# UNPACK #-} !Int

49 {-# UNPACK #-} !Int

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

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

36 Data.Attoparsec.Time

37 build-depends:

38 attoparsec >= 0.13.0.1,

39− base >= 4.5 && < 5,

39+ base >= 4.7 && < 5,

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

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

41 text >= 1.1.1.0,

42 time >= 1.1.1.4

benchmarks/AesonEncode.hs+1−1

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

7import Prelude.Compat

9import Control.DeepSeq

10−import Control.Monad

10+import Control.Monad (forM_)

11import Data.Aeson

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

13import Data.Char (isDigit)

benchmarks/Compare/JsonBench.hs+4−3

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

20import Data.Monoid ((<>))

21import Data.Text (Text)

22import Typed.Common (load)

23+import qualified Control.Monad.Fail as Fail

23import qualified Data.Aeson as Aeson

24import qualified Data.Aeson as Aeson

24import qualified Data.BufferBuilder.Json as Json

25import qualified Data.BufferBuilder.Json as Json

@@ -68,10 +69,10 @@ instance NFData Gender where rnf !_ = ()

68instance NFData Fruit where rnf !_ = ()

69instance NFData Fruit where rnf !_ = ()

70instance NFData Friend where

71instance NFData Friend where

71− rnf Friend {..} = rnf fId `seq` rnf fName `seq` ()

72+ rnf Friend {..} = rnf fId `seq` rnf fName

73instance NFData User where

74instance NFData User where

74− rnf User {..} = rnf uId `seq` rnf uIndex `seq` rnf uGuid `seq` rnf uIsActive `seq` rnf uBalance `seq` rnf uPicture `seq` rnf uAge `seq` rnf uEyeColor `seq` rnf uName `seq` rnf uGender `seq` rnf uCompany `seq` rnf uEmail `seq` rnf uPhone `seq` rnf uAddress `seq` rnf uAbout `seq` rnf uRegistered `seq` rnf uLatitude `seq` rnf uLongitude `seq` rnf uTags `seq` rnf uFriends `seq` rnf uGreeting `seq` rnf uFavouriteFruit `seq` ()

75+ rnf User {..} = rnf uId `seq` rnf uIndex `seq` rnf uGuid `seq` rnf uIsActive `seq` rnf uBalance `seq` rnf uPicture `seq` rnf uAge `seq` rnf uEyeColor `seq` rnf uName `seq` rnf uGender `seq` rnf uCompany `seq` rnf uEmail `seq` rnf uPhone `seq` rnf uAddress `seq` rnf uAbout `seq` rnf uRegistered `seq` rnf uLatitude `seq` rnf uLongitude `seq` rnf uTags `seq` rnf uFriends `seq` rnf uGreeting `seq` rnf uFavouriteFruit

76eyeColorTable :: [(Text, EyeColor)]

77eyeColorTable :: [(Text, EyeColor)]

77eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]

78eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]

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

82fruitTable :: [(Text, Fruit)]

83fruitTable :: [(Text, Fruit)]

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

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

85−enumFromJson :: Monad m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum

86+enumFromJson :: Fail.MonadFail m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum

86enumFromJson enumName table extract v = do

87enumFromJson enumName table extract v = do

87 s <- extract v

88 s <- extract v

88 case lookup s table of

89 case lookup s table of

benchmarks/CompareWithJSON.hs+1−1

@@ -27,7 +27,7 @@ instance (NFData v) => NFData (J.JSObject v) where

27instance NFData J.JSValue where

28 rnf J.JSNull = ()

29 rnf (J.JSBool b) = rnf b

30− rnf (J.JSRational a b) = rnf a `seq` rnf b `seq` ()

30+ rnf (J.JSRational a b) = rnf a `seq` rnf b

31 rnf (J.JSString s) = rnf (J.fromJSString s)

32 rnf (J.JSArray lst) = rnf lst

33 rnf (J.JSObject o) = rnf o

benchmarks/Issue673.hs+1

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

18import Prelude.Compat

19import Data.Int (Int64)

20import Data.Scientific (Scientific)

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

21import Data.Aeson.Parser (scientific)

22import Data.Aeson.Parser (scientific)

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

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

benchmarks/JsonParse.hs+1−1

@@ -17,7 +17,7 @@ import Text.JSON

17instance NFData JSValue where

18 rnf JSNull = ()

19 rnf (JSBool b) = rnf b

20− rnf (JSRational b r) = rnf b `seq` rnf r `seq` ()

20+ rnf (JSRational b r) = rnf b `seq` rnf r

21 rnf (JSString s) = rnf (fromJSString s)

22 rnf (JSArray vs) = rnf vs

23 rnf (JSObject kvs) = rnf (fromJSObject kvs)

benchmarks/aeson-benchmarks.cabal+32−28

@@ -28,44 +28,42 @@ library

28 hs-source-dirs: .. ../ffi ../pure ../attoparsec-iso8601

29 c-sources: ../cbits/unescape_string.c

30 build-depends:

31− attoparsec >= 0.13.0.1,

31+ attoparsec,

32− base == 4.*,

32+ base,

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

33+ base-compat,

34− time-locale-compat >=0.1.1 && <0.2,

35 containers,

34 containers,

36 deepseq,

35 deepseq,

37− dlist >= 0.2,

36+ dlist,

38− fail == 4.9.*,

37+ fail,

39− ghc-prim >= 0.2,

38+ ghc-prim,

40− hashable >= 1.1.2.0,

39+ hashable,

41 mtl,

40 mtl,

42− primitive >= 0.6.1,

41+ primitive,

43− scientific >= 0.3.4.7 && < 0.4,

42+ scientific,

44 syb,

43 syb,

45− tagged >=0.8.3 && <0.9,

44+ tagged,

46− template-haskell >= 2.4,

45+ template-haskell,

47− text >= 1.2.3,

46+ text,

48− th-abstraction >= 0.2.2 && < 0.4,

47+ th-abstraction,

48+ time-compat,

49 time,

50 transformers,

51− unordered-containers >= 0.2.3.0,

51+ unordered-containers,

52− uuid-types >= 1.0.3 && <1.1,

52+ uuid-types,

53− vector >= 0.7.1

53+ vector

54−

55− if !impl(ghc >= 7.10)

56− -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8

57− build-depends: nats >= 1 && < 1.2

59− if impl(ghc >=7.8)

55+ if !impl(ghc >= 8.6)

60− cpp-options: -DHAS_COERCIBLE

56+ build-depends: contravariant

62 if !impl(ghc >= 8.0)

58 if !impl(ghc >= 8.0)

63 -- `Data.Semigroup` is available in base only since GHC 8.0 / base 4.9

59 -- `Data.Semigroup` is available in base only since GHC 8.0 / base 4.9

64− build-depends: semigroups >= 0.18.2 && < 0.19

60+ build-depends: semigroups,

61+ transformers-compat

66− if !impl(ghc >= 8.6)

63+ if !impl(ghc >= 7.10)

64+ -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8

67− build-depends:

65+ build-depends: nats,

68− contravariant >=1.4.1 && <1.6

66+ void

70 include-dirs: ../include

68 include-dirs: ../include

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

75 exposed-modules:

73 exposed-modules:

76 Data.Aeson

74 Data.Aeson

77− Data.Aeson.Compat

78 Data.Aeson.Encoding

75 Data.Aeson.Encoding

79 Data.Aeson.Encoding.Builder

76 Data.Aeson.Encoding.Builder

80 Data.Aeson.Encoding.Internal

77 Data.Aeson.Encoding.Internal

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

178 Compare.JsonBuilder

175 Compare.JsonBuilder

179 build-depends:

176 build-depends:

180 json-builder

177 json-builder

178+ if impl(ghc < 8.0)

179+ build-depends:

180+ semigroups

181

182executable aeson-benchmark-micro

183 default-language: Haskell2010

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

224 bytestring-builder >= 0.10.4 && < 1

225 else

226 build-depends: bytestring >= 0.10.4

227+ if impl(ghc < 8.0)

228+ build-depends: semigroups

227

229

228executable aeson-benchmark-compare-with-json

230executable aeson-benchmark-compare-with-json

229 default-language: Haskell2010

231 default-language: Haskell2010

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

339 scientific,

341 scientific,

340 base-compat,

342 base-compat,

341 criterion >= 1.0

343 criterion >= 1.0

344+ if impl(ghc < 8.0)

345+ build-depends: semigroups

cabal.project+4−1

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

1with-compiler: ghc

2+packages: .

2−packages: ., attoparsec-iso8601, benchmarks

3+packages: attoparsec-iso8601

4+-- packages: benchmarks

5+tests: true

changelog.md+56

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

1For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).

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+

3### 1.4.3.0

59### 1.4.3.0

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

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

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

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

run-hlint.shnew file+7

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

1+#!/bin/bash

3+if hash hlint 2>/dev/null; then

4+ hlint "$@"

5+else

6+ ./hlint.sh "$@"

7+fi

stack-bench.yaml+2−1

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

1−resolver: lts-12.10

1+resolver: nightly-2019-09-21

2# We use aeson in the snapshot to

3# - avoid recompilation of criterion

4# - compare against it

@@ -9,3 +9,4 @@ resolver: lts-12.10

9work-dir: .stack-work-bench

10packages:

11- benchmarks

12+extra-deps: []

stack-ffi-unescape.yaml+2−2

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

1−resolver: lts-12.10

1+resolver: nightly-2019-09-21

2packages:

3- '.'

4flags:

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

6 fast: true

7 cffi: true

8extra-deps:

9−- hashable-time-0.2.0.1

9+- Diff-0.4.0

stack-lts12.yaml+6−1

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

1−resolver: lts-12.10

1+resolver: lts-12.26

2packages:

3- '.'

4- attoparsec-iso8601

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

7 fast: true

8 cffi: true

9extra-deps:

10+- base-orphans-0.8.1

10- hashable-time-0.2.0.1

11- hashable-time-0.2.0.1

12+- QuickCheck-2.13.1

13+- quickcheck-instances-0.3.21

14+- splitmix-0.0.2

15+- time-compat-1.9.2.2

stack-nightly.yaml+3−1

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

1−resolver: nightly-2018-09-26

1+resolver: nightly-2019-10-14

2packages:

3- '.'

4- attoparsec-iso8601

@@ -7,3 +7,5 @@ flags:

7 fast: true

8 attoparsec-iso8601:

9 fast: true

10+extra-deps:

11+- generic-deriving-1.12.4

tests/Encoders.hs+38−6

@@ -6,6 +6,7 @@

6module Encoders (module Encoders) where

8import Prelude.Compat

9+import Data.Text (Text)

10import Data.Aeson.TH

11import Data.Aeson.TH

11import Data.Aeson.Types

12import Data.Aeson.Types

@@ -96,6 +97,18 @@ gNullaryToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingle

96gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary

97gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary

97gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField

98gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField

100+keyOptions :: JSONKeyOptions

101+keyOptions = defaultJSONKeyOptions { keyModifier = ('k' :) }

102+

103+gNullaryToJSONKey :: Nullary -> Either String Text

104+gNullaryToJSONKey x = case genericToJSONKey keyOptions of

105+ ToJSONKeyText p _ -> Right (p x)

106+ _ -> Left "Should be a ToJSONKeyText"

107+

108+gNullaryFromJSONKey :: Text -> Parser Nullary

109+gNullaryFromJSONKey t = case genericFromJSONKey keyOptions of

110+ FromJSONKeyTextParser p -> p t

111+ _ -> fail "Not a TextParser"

112

100--------------------------------------------------------------------------------

113--------------------------------------------------------------------------------

101-- SomeType encoders/decoders

114-- SomeType encoders/decoders

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

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

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

176gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray

189gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray

177

190

178−#if __GLASGOW_HASKELL__ >= 706

179gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a

191gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a

180gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray

192gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray

181

193

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

184

196

185gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a

197gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a

186gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray

198gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray

187−#endif

188

199

189

200

190gSomeTypeToJSONTaggedObject :: SomeType Int -> Value

201gSomeTypeToJSONTaggedObject :: SomeType Int -> Value

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

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

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

197gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject

208gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject

198

209

199−#if __GLASGOW_HASKELL__ >= 706

200gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a

210gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a

201gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject

211gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject

202

212

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

205

215

206gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a

216gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a

207gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject

217gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject

208−#endif

209

218

210

219

211gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value

220gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value

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

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

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

218gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField

227gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField

219

228

220−#if __GLASGOW_HASKELL__ >= 706

221gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a

229gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a

222gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField

230gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField

223

231

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

226

234

227gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a

235gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a

228gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField

236gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField

229−#endif

230

237

231

238

232gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value

239gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value

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

236gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields

243gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields

237

244

238

245

246+thSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)

247+thSomeTypeParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''SomeType)

248+

249+gSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)

250+gSomeTypeParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields

251+

252+

253+--------------------------------------------------------------------------------

254+-- Foo decoders

255+--------------------------------------------------------------------------------

256+

257+thFooParseJSONRejectUnknownFields :: Value -> Parser Foo

258+thFooParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''Foo)

259+

260+gFooParseJSONRejectUnknownFields :: Value -> Parser Foo

261+gFooParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields

262+

263+

264+thFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo

265+thFooParseJSONRejectUnknownFieldsTagged = $(mkParseJSON optsRejectUnknownFieldsTagged ''Foo)

266+

267+gFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo

268+gFooParseJSONRejectUnknownFieldsTagged = genericParseJSON optsRejectUnknownFieldsTagged

269+

270+

239--------------------------------------------------------------------------------

271--------------------------------------------------------------------------------

240-- Option fields

272-- Option fields

241--------------------------------------------------------------------------------

273--------------------------------------------------------------------------------

tests/ErrorMessages.hs+27−1

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

13import Data.Aeson.Types (Parser)

14import Data.Aeson.Parser (eitherDecodeWith)

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

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

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

17import Data.Proxy (Proxy(..))

18import Data.Semigroup ((<>))

19import Data.Sequence (Seq)

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

136 , "[1,"

137 ]

138

139+ , testWithSomeType "SomeType (reject unknown fields)"

140+ (select

141+ thSomeTypeParseJSONRejectUnknownFields

142+ gSomeTypeParseJSONRejectUnknownFields)

143+ [ "{\"tag\": \"record\", \"testOne\": 1.0, \"testZero\": 1}"

144+ , "{\"testZero\": 1}"

145+ , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"

146+ ]

147+

148+ , testWithFoo "Foo (reject unknown fields)"

149+ (select

150+ thFooParseJSONRejectUnknownFields

151+ gFooParseJSONRejectUnknownFields)

152+ [ "{\"tag\": \"foo\"}"

153+ ]

154+

155+ , testWithFoo "Foo (reject unknown fields, tagged single)"

156+ (select

157+ thFooParseJSONRejectUnknownFieldsTagged

158+ gFooParseJSONRejectUnknownFieldsTagged)

159+ [ "{\"tag\": \"foo\", \"unknownField\": 0}"

160+ ]

161+

139 , testWith "EitherTextInt"

162 , testWith "EitherTextInt"

140 (select

163 (select

141 thEitherTextIntParseJSONUntaggedValue

164 thEitherTextIntParseJSONUntaggedValue

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

196

219

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

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

198testWithSomeType = testWith

221testWithSomeType = testWith

222+

223+testWithFoo :: String -> (Value -> Parser Foo) -> [L.ByteString] -> Output

224+testWithFoo = testWith

tests/Instances.hs+1−4

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

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE FlexibleContexts #-}

1{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleInstances #-}

2{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE NoImplicitPrelude #-}

3{-# LANGUAGE NoImplicitPrelude #-}

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

26import Data.Orphans ()

25import Data.Orphans ()

27import Test.QuickCheck.Instances ()

26import Test.QuickCheck.Instances ()

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

29import Data.Hashable.Time ()

27import Data.Hashable.Time ()

30−#endif

32-- "System" types.

29-- "System" types.

34instance Arbitrary DotNetTime where

31instance Arbitrary DotNetTime where

35− arbitrary = DotNetTime `liftM` arbitrary

32+ arbitrary = DotNetTime `fmap` arbitrary

36 shrink = map DotNetTime . shrink . fromDotNetTime

33 shrink = map DotNetTime . shrink . fromDotNetTime

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

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

tests/Options.hs+11

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

55 { fieldLabelModifier = const "field"

56 , omitNothingFields = True

57 }

58+

59+optsRejectUnknownFields :: Options

60+optsRejectUnknownFields = optsDefault

61+ { rejectUnknownFields = True

62+ }

63+

64+optsRejectUnknownFieldsTagged :: Options

65+optsRejectUnknownFieldsTagged = optsDefault

66+ { rejectUnknownFields = True

67+ , tagSingleConstructors = True

68+ }

tests/PropertyGeneric.hs−8

@@ -44,11 +44,9 @@ genericTests =

44 , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)

45 , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)

47−#if __GLASGOW_HASKELL__ >= 706

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

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

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

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

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

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

51−#endif

52 ]

50 ]

53 ]

51 ]

54 , testGroup "OneConstructor" [

52 , testGroup "OneConstructor" [

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

86 , testProperty "SomeType2ElemArray" $

84 , testProperty "SomeType2ElemArray" $

87 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray

85 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray

88−#if __GLASGOW_HASKELL__ >= 706

89 , testProperty "SomeType2ElemArray unary" $

86 , testProperty "SomeType2ElemArray unary" $

90 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray

87 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray

91 , testProperty "SomeType2ElemArray unary agree" $

88 , testProperty "SomeType2ElemArray unary agree" $

92 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray

89 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray

93−#endif

95 , testProperty "SomeTypeTaggedObject" $

91 , testProperty "SomeTypeTaggedObject" $

96 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject

92 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject

97−#if __GLASGOW_HASKELL__ >= 706

98 , testProperty "SomeTypeTaggedObject unary" $

93 , testProperty "SomeTypeTaggedObject unary" $

99 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject

94 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject

100 , testProperty "SomeTypeTaggedObject unary agree" $

95 , testProperty "SomeTypeTaggedObject unary agree" $

101 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject

96 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject

102−#endif

103

104 , testProperty "SomeTypeObjectWithSingleField" $

98 , testProperty "SomeTypeObjectWithSingleField" $

105 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField

99 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField

106−#if __GLASGOW_HASKELL__ >= 706

107 , testProperty "SomeTypeObjectWithSingleField unary" $

100 , testProperty "SomeTypeObjectWithSingleField unary" $

108 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField

101 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField

109 , testProperty "SomeTypeObjectWithSingleField unary agree" $

102 , testProperty "SomeTypeObjectWithSingleField unary agree" $

110 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField

103 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField

111−#endif

112

104

113 , testProperty "SomeTypeOmitNothingFields" $

105 , testProperty "SomeTypeOmitNothingFields" $

114 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields

106 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields

tests/PropertyKeys.hs−3

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

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE NoImplicitPrelude #-}

1{-# LANGUAGE NoImplicitPrelude #-}

4module PropertyKeys ( keysTests ) where

3module PropertyKeys ( keysTests ) where

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

39−#endif

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

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

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

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

42 , testProperty "UUID" $ roundTripKey UUID.nil

39 , testProperty "UUID" $ roundTripKey UUID.nil

tests/PropertyRoundTrip.hs+7

@@ -14,6 +14,9 @@ import Data.Sequence (Seq)

14import Data.Tagged (Tagged)

15import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)

16import Data.Version (Version)

17+import Data.Time.Calendar.Compat (CalendarDiffDays, DayOfWeek)

18+import Data.Time.LocalTime.Compat (CalendarDiffTime)

19+import Data.Time.Clock.System.Compat (SystemTime)

17import Instances ()

20import Instances ()

18import Numeric.Natural (Natural)

21import Numeric.Natural (Natural)

19import Test.Tasty (TestTree, testGroup)

22import Test.Tasty (TestTree, testGroup)

@@ -47,6 +50,10 @@ roundTripTests =

47 , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)

50 , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)

48 , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)

51 , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)

49 , testProperty "DiffTime" $ roundTripEq (undefined :: DiffTime)

52 , testProperty "DiffTime" $ roundTripEq (undefined :: DiffTime)

53+ , testProperty "DayOfWeek" $ roundTripEq (undefined :: DayOfWeek)

54+ , testProperty "SystemTime" $ roundTripEq (undefined :: SystemTime)

55+ , testProperty "CalendarDiffTime" $ roundTripEq (undefined :: CalendarDiffTime)

56+ , testProperty "CalendarDiffDays" $ roundTripEq (undefined :: CalendarDiffDays)

50 , testProperty "Version" $ roundTripEq (undefined :: Version)

57 , testProperty "Version" $ roundTripEq (undefined :: Version)

51 , testProperty "Natural" $ roundTripEq (undefined :: Natural)

58 , testProperty "Natural" $ roundTripEq (undefined :: Natural)

52 , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)

59 , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)

tests/SerializationFormatSpec.hs+47−23

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

3{-# LANGUAGE GADTs #-}

4{-# LANGUAGE NoImplicitPrelude #-}

5{-# LANGUAGE OverloadedStrings #-}

6−#if __GLASGOW_HASKELL__ >= 708

7{-# LANGUAGE DataKinds #-}

6{-# LANGUAGE DataKinds #-}

8−#endif

10------------------------------------------------------------------------------

8------------------------------------------------------------------------------

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

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

@@ -32,6 +30,9 @@ import Data.Proxy (Proxy(..))

32import Data.Scientific (Scientific)

30import Data.Scientific (Scientific)

33import Data.Tagged (Tagged(..))

31import Data.Tagged (Tagged(..))

34import Data.Time (fromGregorian)

32import Data.Time (fromGregorian)

33+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))

34+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))

35+import Data.Time.Clock.System.Compat (SystemTime (..))

35import Data.Word (Word8)

36import Data.Word (Word8)

36import GHC.Generics (Generic)

37import GHC.Generics (Generic)

37import Instances ()

38import Instances ()

@@ -68,13 +69,14 @@ jsonExamples =

68 example "Either Left" "{\"Left\":1}" (Left 1 :: Either Int Int)

69 example "Either Left" "{\"Left\":1}" (Left 1 :: Either Int Int)

69 , example "Either Right" "{\"Right\":1}" (Right 1 :: Either Int Int)

70 , example "Either Right" "{\"Right\":1}" (Right 1 :: Either Int Int)

70 , example "Nothing" "null" (Nothing :: Maybe Int)

71 , example "Nothing" "null" (Nothing :: Maybe Int)

72+ -- Maybe serialising is lossy

73+ -- https://github.com/bos/aeson/issues/376

74+ , Example "Just Nothing" ["null"] (Just Nothing :: Maybe (Maybe Int)) Nothing

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

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

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

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

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

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

74−#if __GLASGOW_HASKELL__ >= 708

75 -- Test Tagged instance is polykinded

78 -- Test Tagged instance is polykinded

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

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

77−#endif

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

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

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

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

80 , example "NonEmpty" "[1,2,3]" (1 :| [2, 3] :: NonEmpty Int)

82 , example "NonEmpty" "[1,2,3]" (1 :| [2, 3] :: NonEmpty Int)

@@ -82,22 +84,22 @@ jsonExamples =

82 , example "DList" "[1,2,3]" (DList.fromList [1, 2, 3] :: DList.DList Int)

84 , example "DList" "[1,2,3]" (DList.fromList [1, 2, 3] :: DList.DList Int)

83 , example "()" "[]" ()

85 , example "()" "[]" ()

85− , Example "HashMap Int Int"

87+ , ndExample "HashMap Int Int"

86 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

88 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

87 (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)

89 (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)

88− , Example "Map Int Int"

90+ , ndExample "Map Int Int"

89 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

91 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

90 (M.fromList [(0,1),(2,3)] :: M.Map Int Int)

92 (M.fromList [(0,1),(2,3)] :: M.Map Int Int)

91− , Example "Map (Tagged Int Int) Int"

93+ , ndExample "Map (Tagged Int Int) Int"

92 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

94 [ "{\"0\":1,\"2\":3}", "{\"2\":3,\"0\":1}"]

93 (M.fromList [(Tagged 0,1),(Tagged 2,3)] :: M.Map (Tagged Int Int) Int)

95 (M.fromList [(Tagged 0,1),(Tagged 2,3)] :: M.Map (Tagged Int Int) Int)

94 , example "Map [Int] Int"

96 , example "Map [Int] Int"

95 "[[[0],1],[[2],3]]"

97 "[[[0],1],[[2],3]]"

96 (M.fromList [([0],1),([2],3)] :: M.Map [Int] Int)

98 (M.fromList [([0],1),([2],3)] :: M.Map [Int] Int)

97− , Example "Map [Char] Int"

99+ , ndExample "Map [Char] Int"

98 [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]

100 [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]

99 (M.fromList [("ab",1),("cd",3)] :: M.Map String Int)

101 (M.fromList [("ab",1),("cd",3)] :: M.Map String Int)

100− , Example "Map [I Char] Int"

102+ , ndExample "Map [I Char] Int"

101 [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]

103 [ "{\"ab\":1,\"cd\":3}", "{\"cd\":3,\"ab\":1}" ]

102 (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)

104 (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)

103

105

@@ -193,16 +195,27 @@ jsonExamples =

193 , example "Semigroup.WrappedMonoid Int" "2" (Semigroup.WrapMonoid 2 :: Semigroup.WrappedMonoid Int)

195 , example "Semigroup.WrappedMonoid Int" "2" (Semigroup.WrapMonoid 2 :: Semigroup.WrappedMonoid Int)

194 , example "Semigroup.Option Just" "2" (pure 2 :: Semigroup.Option Int)

196 , example "Semigroup.Option Just" "2" (pure 2 :: Semigroup.Option Int)

195 , example "Semigroup.Option Nothing" "null" (Semigroup.Option (Nothing :: Maybe Bool))

197 , example "Semigroup.Option Nothing" "null" (Semigroup.Option (Nothing :: Maybe Bool))

198+

199+ -- time 1.9

200+ , example "SystemTime" "123.123456789" (MkSystemTime 123 123456789)

201+ , Example "SystemTime" ["124.23456789"]

202+ (MkSystemTime 123 1234567890)

203+ (MkSystemTime 124 234567890)

204+ , ndExample "CalendarDiffTime"

205+ [ "{\"months\":12,\"time\":456.789}", "{\"time\":456.789,\"months\":12}" ]

206+ (CalendarDiffTime 12 456.789)

207+ , ndExample "CalendarDiffDays"

208+ [ "{\"months\":12,\"days\":20}", "{\"days\":20,\"months\":12}" ]

209+ (CalendarDiffDays 12 20)

210+ , example "DayOfWeek" "\"monday\"" Monday

196 ]

211 ]

197

212

198jsonEncodingExamples :: [Example]

213jsonEncodingExamples :: [Example]

199jsonEncodingExamples =

214jsonEncodingExamples =

200 [

215 [

201− -- Maybe serialising is lossy

202− -- https://github.com/bos/aeson/issues/376

203− example "Just Nothing" "null" (Just Nothing :: Maybe (Maybe Int))

204 -- infinities cannot be recovered, null is decoded as NaN

216 -- infinities cannot be recovered, null is decoded as NaN

217+ example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)

205− , example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)

218+ , example "-inf :: Double" "null" (Approx $ -1/0 :: Approx Double)

206 ]

219 ]

207

220

208jsonDecodingExamples :: [Example]

221jsonDecodingExamples :: [Example]

@@ -224,16 +237,27 @@ jsonDecodingExamples = [

224 ]

237 ]

225

238

226data Example where

239data Example where

227− Example

240+ Example

228− :: (Eq a, Show a, ToJSON a, FromJSON a)

241+ :: (Eq a, Show a, ToJSON a, FromJSON a)

242+ => String -- name

243+ -> [L.ByteString] -- encoded variants

244+ -> a -- input

245+ -> a -- decoded

229− => String -> [L.ByteString] -> a -> Example -- empty bytestring will fail, any p [] == False

246+ -> Example -- empty bytestring will fail, any p [] == False

247+

230− MaybeExample

248+ MaybeExample

231− :: (Eq a, Show a, FromJSON a)

249+ :: (Eq a, Show a, FromJSON a)

232− => String -> L.ByteString -> Maybe a -> Example

250+ => String -> L.ByteString -> Maybe a -> Example

233

251

234example :: (Eq a, Show a, ToJSON a, FromJSON a)

252example :: (Eq a, Show a, ToJSON a, FromJSON a)

235 => String -> L.ByteString -> a -> Example

253 => String -> L.ByteString -> a -> Example

236−example n bs x = Example n [bs] x

254+example n bs x = Example n [bs] x x

255+

256+-- | Non-deterministic example, input encodes to some of bytestrings.

257+ndExample :: (Eq a, Show a, ToJSON a, FromJSON a)

258+ => String -> [L.ByteString] -> a -> Example

259+ndExample n bss x = Example n bss x x

260+

237

261

238data MyEither a b = MyLeft a | MyRight b

262data MyEither a b = MyLeft a | MyRight b

239 deriving (Generic, Show, Eq)

263 deriving (Generic, Show, Eq)

@@ -246,16 +270,16 @@ instance (FromJSON a, FromJSON b) => FromJSON (MyEither a b) where

246 parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }

270 parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }

247

271

248assertJsonExample :: Example -> TestTree

272assertJsonExample :: Example -> TestTree

249−assertJsonExample (Example name bss val) = testCase name $ do

273+assertJsonExample (Example name bss val val') = testCase name $ do

250 assertSomeEqual "encode" bss (encode val)

274 assertSomeEqual "encode" bss (encode val)

251 assertSomeEqual "encode/via value" bss (encode $ toJSON val)

275 assertSomeEqual "encode/via value" bss (encode $ toJSON val)

252 for_ bss $ \bs ->

276 for_ bss $ \bs ->

253− assertEqual "decode" (Just val) (decode bs)

277+ assertEqual "decode" (Just val') (decode bs)

254assertJsonExample (MaybeExample name bs mval) = testCase name $

278assertJsonExample (MaybeExample name bs mval) = testCase name $

255 assertEqual "decode" mval (decode bs)

279 assertEqual "decode" mval (decode bs)

256

280

257assertJsonEncodingExample :: Example -> TestTree

281assertJsonEncodingExample :: Example -> TestTree

258−assertJsonEncodingExample (Example name bss val) = testCase name $ do

282+assertJsonEncodingExample (Example name bss val _) = testCase name $ do

259 assertSomeEqual "encode" bss (encode val)

283 assertSomeEqual "encode" bss (encode val)

260 assertSomeEqual "encode/via value" bss (encode $ toJSON val)

284 assertSomeEqual "encode/via value" bss (encode $ toJSON val)

261assertJsonEncodingExample (MaybeExample name _ _) = testCase name $

285assertJsonEncodingExample (MaybeExample name _ _) = testCase name $

tests/Types.hs−2

@@ -119,9 +119,7 @@ deriving instance Generic (Sum4 a b c d)

119deriving instance Generic (Approx a)

120deriving instance Generic Nullary

121deriving instance Generic (SomeType a)

122−#if __GLASGOW_HASKELL__ >= 706

123deriving instance Generic1 SomeType

122deriving instance Generic1 SomeType

124−#endif

125deriving instance Generic OptionField

123deriving instance Generic OptionField

126deriving instance Generic EitherTextInt

124deriving instance Generic EitherTextInt

127

125

tests/UnitTests.hs+164−6

@@ -29,35 +29,44 @@ import Data.Aeson.Internal (JSONPathElement(..), formatError)

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

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

31import Data.Aeson.Text (encodeToTextBuilder)

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

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

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

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

33import Data.Char (toUpper)

40import Data.Char (toUpper)

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

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

35import Data.Hashable (hash)

42import Data.Hashable (hash)

36import Data.HashMap.Strict (HashMap)

43import Data.HashMap.Strict (HashMap)

37−import Data.List (sort)

44+import Data.List (sort, isSuffixOf)

38import Data.Maybe (fromMaybe)

45import Data.Maybe (fromMaybe)

39import Data.Scientific (Scientific, scientific)

46import Data.Scientific (Scientific, scientific)

40import Data.Tagged (Tagged(..))

47import Data.Tagged (Tagged(..))

41import Data.Text (Text)

48import Data.Text (Text)

42import Data.Time (UTCTime)

49import Data.Time (UTCTime)

43−import Data.Time.Format (parseTime)

50+import Data.Time.Format.Compat (parseTimeM, defaultTimeLocale)

44−import Data.Time.Locale.Compat (defaultTimeLocale)

45import GHC.Generics (Generic)

51import GHC.Generics (Generic)

46import Instances ()

52import Instances ()

47import Numeric.Natural (Natural)

53import Numeric.Natural (Natural)

48import System.Directory (getDirectoryContents)

54import System.Directory (getDirectoryContents)

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

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

50import Test.Tasty (TestTree, testGroup)

56import Test.Tasty (TestTree, testGroup)

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

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

52import Text.Printf (printf)

58import Text.Printf (printf)

53import UnitTests.NullaryConstructors (nullaryConstructors)

59import UnitTests.NullaryConstructors (nullaryConstructors)

60+import qualified Data.ByteString as S

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

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

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

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

56import qualified Data.HashSet as HashSet

63import qualified Data.HashSet as HashSet

64+import qualified Data.HashMap.Lazy as HashMap

57import qualified Data.Text.Lazy as LT

65import qualified Data.Text.Lazy as LT

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

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

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

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

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

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

69+import qualified Data.Vector as Vector

61import qualified ErrorMessages

70import qualified ErrorMessages

62import qualified SerializationFormatSpec

71import qualified SerializationFormatSpec

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

103 , testGroup "SingleMaybeField" singleMaybeField

112 , testGroup "SingleMaybeField" singleMaybeField

104 , testCase "withEmbeddedJSON" withEmbeddedJSONTest

113 , testCase "withEmbeddedJSON" withEmbeddedJSONTest

105 , testCase "SingleFieldCon" singleFieldCon

114 , testCase "SingleFieldCon" singleFieldCon

115+ , testGroup "UnknownFields" unknownFields

116+ , testGroup "Ordering of object keys" keyOrdering

106 , testCase "Ratio with denominator 0" ratioDenominator0

117 , testCase "Ratio with denominator 0" ratioDenominator0

118+ , testCase "Rational parses number" rationalNumber

119+ , testCase "Big rational" bigRationalDecoding

120+ , testCase "Small rational" smallRationalDecoding

107 , testCase "Big scientific exponent" bigScientificExponent

121 , testCase "Big scientific exponent" bigScientificExponent

108 , testCase "Big integer decoding" bigIntegerDecoding

122 , testCase "Big integer decoding" bigIntegerDecoding

109 , testCase "Big natural decading" bigNaturalDecoding

123 , testCase "Big natural decading" bigNaturalDecoding

@@ -215,7 +229,7 @@ utcTimeGood = do

215 where

229 where

216 parseWithRead :: String -> LT.Text -> UTCTime

230 parseWithRead :: String -> LT.Text -> UTCTime

217 parseWithRead f s =

231 parseWithRead f s =

218− fromMaybe (error "parseTime input malformed") . parseTime defaultTimeLocale f . LT.unpack $ s

232+ fromMaybe (error "parseTime input malformed") . parseTimeM True defaultTimeLocale f . LT.unpack $ s

219 parseWithAeson :: LT.Text -> Maybe UTCTime

233 parseWithAeson :: LT.Text -> Maybe UTCTime

220 parseWithAeson s = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""]

234 parseWithAeson s = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""]

221

235

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

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

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

245 in assertEqual "formatError example" lhs rhs

259 in assertEqual "formatError example" lhs rhs

246

260

261+formatPathExample :: Assertion

262+formatPathExample =

263+ let rhs = formatPath [Key "x", Index 0]

264+ lhs = "$.x[0]"

265+ in assertEqual "formatPath example" lhs rhs

266+

267+formatRelativePathExample :: Assertion

268+formatRelativePathExample =

269+ let rhs = formatPath [Key "x", Index 0]

270+ lhs = ".x[0]"

271+ in assertEqual "formatRelativePath example" lhs rhs

272+

247------------------------------------------------------------------------------

273------------------------------------------------------------------------------

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

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

249------------------------------------------------------------------------------

275------------------------------------------------------------------------------

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

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

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

515 ++ ", unwrapUnaryRecords = False"

541 ++ ", unwrapUnaryRecords = False"

516 ++ ", tagSingleConstructors = False"

542 ++ ", tagSingleConstructors = False"

543+ ++ ", rejectUnknownFields = False"

517 ++ "}")

544 ++ "}")

518 (show defaultOptions)

545 (show defaultOptions)

519

546

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

558singleFieldCon =

585singleFieldCon =

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

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

560

587

588+newtype UnknownFields = UnknownFields { knownField :: Int }

589+ deriving (Eq, Show, Generic)

590+newtype UnknownFieldsTag = UnknownFieldsTag { tag :: Int }

591+ deriving (Eq, Show, Generic)

592+newtype UnknownFieldsUnaryTagged = UnknownFieldsUnaryTagged { knownFieldUnaryTagged :: Int }

593+ deriving (Eq, Show, Generic)

594+data UnknownFieldsSum

595+ = UnknownFields1 { knownField1 :: Int }

596+ | UnknownFields2 { knownField2 :: Int }

597+ deriving (Eq, Show, Generic)

598+

599+unknownFields :: [TestTree]

600+unknownFields = concat

601+ [ testsUnary

602+ "unary-unknown"

603+ (object [("knownField", Number 1), ("unknownField", Number 1)])

604+ (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFields)

605+ , testsUnary

606+ "unary-unknown-tag"

607+ (object [("knownField", Number 1), ("tag", String "UnknownFields")])

608+ (Error "nknown fields: [\"tag\"]" :: Result UnknownFields)

609+ , testsUnaryTag

610+ "unary-explicit-tag"

611+ (object [("tag", Number 1)])

612+ (Success $ UnknownFieldsTag 1)

613+ , testsSum

614+ "sum-tag"

615+ (object [("knownField1", Number 1), ("tag", String "UnknownFields1")])

616+ (Success $ UnknownFields1 1)

617+ , testsSum

618+ "sum-unknown-in-branch"

619+ (object [("knownField1", Number 1), ("knownField2", Number 1), ("tag", String "UnknownFields1")])

620+ (Error "nknown fields: [\"knownField2\"]" :: Result UnknownFieldsSum)

621+ , testsSum

622+ "sum-unknown"

623+ (object [("knownField1", Number 1), ("unknownField", Number 1), ("tag", String "UnknownFields1")])

624+ (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFieldsSum)

625+ , testsTagged

626+ "unary-tagged"

627+ (object [("knownFieldUnaryTagged", Number 1), ("tag", String "UnknownFieldsUnaryTagged")])

628+ (Success $ UnknownFieldsUnaryTagged 1)

629+ , -- Just a case to verify that the tag isn't optional, this is likely already tested by other unit tests

630+ testsTagged

631+ "unary-tagged-notag"

632+ (object [("knownFieldUnaryTagged", Number 1)])

633+ (Error "key \"tag\" not found" :: Result UnknownFieldsUnaryTagged)

634+ , testsTagged

635+ "unary-tagged-unknown"

636+ (object [ ("knownFieldUnaryTagged", Number 1), ("unknownField", Number 1)

637+ , ("tag", String "UnknownFieldsUnaryTagged")])

638+ (Error "nknown fields: [\"unknownField\"]" :: Result UnknownFieldsUnaryTagged)

639+ ]

640+ where

641+ opts = defaultOptions{rejectUnknownFields=True}

642+ taggedOpts = opts{tagSingleConstructors=True}

643+ assertApprox :: (Show a, Eq a) => Result a -> Result a -> IO ()

644+ assertApprox (Error expected) (Error actual) | expected `isSuffixOf` actual = return ()

645+ assertApprox expected actual = assertEqual "fromJSON" expected actual

646+ testsBase :: (Show a, Eq a) => (Value -> Result a) -> (Value -> Result a)

647+ -> String -> Value -> Result a -> [TestTree]

648+ testsBase th g name value expected =

649+ [ testCase (name ++ "-th") $ assertApprox expected (th value)

650+ , testCase (name ++ "-generic") $ assertApprox expected (g value)

651+ ]

652+ testsUnary :: String -> Value -> Result UnknownFields -> [TestTree]

653+ testsUnary = testsBase fromJSON (parse (genericParseJSON opts))

654+ testsUnaryTag :: String -> Value -> Result UnknownFieldsTag -> [TestTree]

655+ testsUnaryTag = testsBase fromJSON (parse (genericParseJSON opts))

656+ testsSum :: String -> Value -> Result UnknownFieldsSum -> [TestTree]

657+ testsSum = testsBase fromJSON (parse (genericParseJSON opts))

658+ testsTagged :: String -> Value -> Result UnknownFieldsUnaryTagged -> [TestTree]

659+ testsTagged = testsBase fromJSON (parse (genericParseJSON taggedOpts))

660+

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+

561ratioDenominator0 :: Assertion

695ratioDenominator0 :: Assertion

562ratioDenominator0 =

696ratioDenominator0 =

563 assertEqual "Ratio with denominator 0"

697 assertEqual "Ratio with denominator 0"

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

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

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

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

566

700

701+rationalNumber :: Assertion

702+rationalNumber =

703+ assertEqual "Ratio with denominator 0"

704+ (Right 1.37)

705+ (eitherDecode "1.37" :: Either String Rational)

706+

707+bigRationalDecoding :: Assertion

708+bigRationalDecoding =

709+ assertEqual "Decoding an Integer with a large exponent should fail"

710+ (Left "Error in $: parsing Ratio failed, found a number with exponent 2000, but it must not be greater than 1024 or less than -1024")

711+ ((eitherDecode :: L.ByteString -> Either String Rational) "1e2000")

712+

713+smallRationalDecoding :: Assertion

714+smallRationalDecoding =

715+ assertEqual "Decoding an Integer with a large exponent should fail"

716+ (Left "Error in $: parsing Ratio failed, found a number with exponent -2000, but it must not be greater than 1024 or less than -1024")

717+ ((eitherDecode :: L.ByteString -> Either String Rational) "1e-2000")

718+

719+

567bigScientificExponent :: Assertion

720bigScientificExponent :: Assertion

568bigScientificExponent =

721bigScientificExponent =

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

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

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

600deriveToJSON1 defaultOptions ''Foo

753deriveToJSON1 defaultOptions ''Foo

601

754

602deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField

755deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField

756+

757+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFields

758+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag

759+deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged

760+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum

tests/UnitTests/NullaryConstructors.hs+5

@@ -14,6 +14,7 @@ import Data.Aeson (decode, eitherDecode, fromEncoding, Value)

14import Data.Aeson.Internal (IResult (..), iparse)

15import Data.Aeson.Types (Parser)

16import Data.ByteString.Builder (toLazyByteString)

17+import Data.Foldable (for_)

17import Data.Maybe (fromJust)

18import Data.Maybe (fromJust)

18import Encoders

19import Encoders

19import Test.Tasty.HUnit ((@=?), Assertion)

20import Test.Tasty.HUnit ((@=?), Assertion)

@@ -52,6 +53,10 @@ nullaryConstructors =

52 -- Make sure that the old `"contents" : []' is still allowed

53 -- Make sure that the old `"contents" : []' is still allowed

53 , ISuccess C1 @=? parse thNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\",\"contents\":[]}")

54 , ISuccess C1 @=? parse thNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\",\"contents\":[]}")

54 , ISuccess C1 @=? parse gNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\",\"contents\":[]}")

55 , ISuccess C1 @=? parse gNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\",\"contents\":[]}")

56+

57+ , for_ [("kC1", C1), ("kC2", C2), ("kC3", C3)] $ \(jkey, key) -> do

58+ Right jkey @=? gNullaryToJSONKey key

59+ ISuccess key @=? parse gNullaryFromJSONKey jkey

55 ]

60 ]

56 where

61 where

57 enc = eitherDecode . toLazyByteString . fromEncoding

62 enc = eitherDecode . toLazyByteString . fromEncoding

tests/golden/generic.expected+11−3

@@ -6,11 +6,11 @@ Error in $: parsing Types.Nullary failed, expected one of the tags ["C1","C2","C

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

7SomeType (tagged)

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

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

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

10−Error in $: parsing Types.SomeType(Record) failed, key "testone" not present

10+Error in $: parsing Types.SomeType(Record) failed, key "testone" not found

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

12Error in $.tag: parsing Types.SomeType failed, expected tag field to be one of ["nullary","unary","product","record","list"], but found tag "X"

13−Error in $: parsing Types.SomeType failed, key "tag" not present

13+Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found

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

15SomeType (single-field)

16Error in $.unary: parsing Int failed, expected Number, but encountered Object

@@ -31,6 +31,14 @@ Error in $: parsing Types.SomeType failed, expected a 2-element Array, but encou

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

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

33Error in $: not enough input. Expecting json list value

34+SomeType (reject unknown fields)

35+Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testZero"]

36+Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found

37+Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testtwo","testone","testthree"]

38+Foo (reject unknown fields)

39+Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["tag"]

40+Foo (reject unknown fields, tagged single)

41+Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["unknownField"]

34EitherTextInt

42EitherTextInt

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

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

36Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected String, but encountered Array

44Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected String, but encountered Array

travis/cabal_macros.hnew file+448

@@ -0,0 +1,448 @@

1+/* DO NOT EDIT: This file is automatically generated by Cabal */

3+/* package aeson-1.4.4.0 */

4+#ifndef VERSION_aeson

5+#define VERSION_aeson "1.4.4.0"

6+#endif /* VERSION_aeson */

7+#ifndef MIN_VERSION_aeson

8+#define MIN_VERSION_aeson(major1,major2,minor) (\

9+ (major1) < 1 || \

10+ (major1) == 1 && (major2) < 4 || \

11+ (major1) == 1 && (major2) == 4 && (minor) <= 4)

12+#endif /* MIN_VERSION_aeson */

13+

14+/* package Diff-0.3.4 */

15+#ifndef VERSION_Diff

16+#define VERSION_Diff "0.3.4"

17+#endif /* VERSION_Diff */

18+#ifndef MIN_VERSION_Diff

19+#define MIN_VERSION_Diff(major1,major2,minor) (\

20+ (major1) < 0 || \

21+ (major1) == 0 && (major2) < 3 || \

22+ (major1) == 0 && (major2) == 3 && (minor) <= 4)

23+#endif /* MIN_VERSION_Diff */

24+

25+/* package QuickCheck-2.13.1 */

26+#ifndef VERSION_QuickCheck

27+#define VERSION_QuickCheck "2.13.1"

28+#endif /* VERSION_QuickCheck */

29+#ifndef MIN_VERSION_QuickCheck

30+#define MIN_VERSION_QuickCheck(major1,major2,minor) (\

31+ (major1) < 2 || \

32+ (major1) == 2 && (major2) < 13 || \

33+ (major1) == 2 && (major2) == 13 && (minor) <= 1)

34+#endif /* MIN_VERSION_QuickCheck */

35+

36+/* package aeson-1.4.4.0 */

37+#ifndef VERSION_aeson

38+#define VERSION_aeson "1.4.4.0"

39+#endif /* VERSION_aeson */

40+#ifndef MIN_VERSION_aeson

41+#define MIN_VERSION_aeson(major1,major2,minor) (\

42+ (major1) < 1 || \

43+ (major1) == 1 && (major2) < 4 || \

44+ (major1) == 1 && (major2) == 4 && (minor) <= 4)

45+#endif /* MIN_VERSION_aeson */

46+

47+/* package attoparsec-0.13.2.2 */

48+#ifndef VERSION_attoparsec

49+#define VERSION_attoparsec "0.13.2.2"

50+#endif /* VERSION_attoparsec */

51+#ifndef MIN_VERSION_attoparsec

52+#define MIN_VERSION_attoparsec(major1,major2,minor) (\

53+ (major1) < 0 || \

54+ (major1) == 0 && (major2) < 13 || \

55+ (major1) == 0 && (major2) == 13 && (minor) <= 2)

56+#endif /* MIN_VERSION_attoparsec */

57+

58+/* package base-4.12.0.0 */

59+#ifndef VERSION_base

60+#define VERSION_base "4.12.0.0"

61+#endif /* VERSION_base */

62+#ifndef MIN_VERSION_base

63+#define MIN_VERSION_base(major1,major2,minor) (\

64+ (major1) < 4 || \

65+ (major1) == 4 && (major2) < 12 || \

66+ (major1) == 4 && (major2) == 12 && (minor) <= 0)

67+#endif /* MIN_VERSION_base */

68+

69+/* package base-compat-0.10.5 */

70+#ifndef VERSION_base_compat

71+#define VERSION_base_compat "0.10.5"

72+#endif /* VERSION_base_compat */

73+#ifndef MIN_VERSION_base_compat

74+#define MIN_VERSION_base_compat(major1,major2,minor) (\

75+ (major1) < 0 || \

76+ (major1) == 0 && (major2) < 10 || \

77+ (major1) == 0 && (major2) == 10 && (minor) <= 5)

78+#endif /* MIN_VERSION_base_compat */

79+

80+/* package base-orphans-0.8.1 */

81+#ifndef VERSION_base_orphans

82+#define VERSION_base_orphans "0.8.1"

83+#endif /* VERSION_base_orphans */

84+#ifndef MIN_VERSION_base_orphans

85+#define MIN_VERSION_base_orphans(major1,major2,minor) (\

86+ (major1) < 0 || \

87+ (major1) == 0 && (major2) < 8 || \

88+ (major1) == 0 && (major2) == 8 && (minor) <= 1)

89+#endif /* MIN_VERSION_base_orphans */

90+

91+/* package base16-bytestring-0.1.1.6 */

92+#ifndef VERSION_base16_bytestring

93+#define VERSION_base16_bytestring "0.1.1.6"

94+#endif /* VERSION_base16_bytestring */

95+#ifndef MIN_VERSION_base16_bytestring

96+#define MIN_VERSION_base16_bytestring(major1,major2,minor) (\

97+ (major1) < 0 || \

98+ (major1) == 0 && (major2) < 1 || \

99+ (major1) == 0 && (major2) == 1 && (minor) <= 1)

100+#endif /* MIN_VERSION_base16_bytestring */

101+

102+/* package bytestring-0.10.8.2 */

103+#ifndef VERSION_bytestring

104+#define VERSION_bytestring "0.10.8.2"

105+#endif /* VERSION_bytestring */

106+#ifndef MIN_VERSION_bytestring

107+#define MIN_VERSION_bytestring(major1,major2,minor) (\

108+ (major1) < 0 || \

109+ (major1) == 0 && (major2) < 10 || \

110+ (major1) == 0 && (major2) == 10 && (minor) <= 8)

111+#endif /* MIN_VERSION_bytestring */

112+

113+/* package containers-0.6.0.1 */

114+#ifndef VERSION_containers

115+#define VERSION_containers "0.6.0.1"

116+#endif /* VERSION_containers */

117+#ifndef MIN_VERSION_containers

118+#define MIN_VERSION_containers(major1,major2,minor) (\

119+ (major1) < 0 || \

120+ (major1) == 0 && (major2) < 6 || \

121+ (major1) == 0 && (major2) == 6 && (minor) <= 0)

122+#endif /* MIN_VERSION_containers */

123+

124+/* package directory-1.3.3.0 */

125+#ifndef VERSION_directory

126+#define VERSION_directory "1.3.3.0"

127+#endif /* VERSION_directory */

128+#ifndef MIN_VERSION_directory

129+#define MIN_VERSION_directory(major1,major2,minor) (\

130+ (major1) < 1 || \

131+ (major1) == 1 && (major2) < 3 || \

132+ (major1) == 1 && (major2) == 3 && (minor) <= 3)

133+#endif /* MIN_VERSION_directory */

134+

135+/* package dlist-0.8.0.6 */

136+#ifndef VERSION_dlist

137+#define VERSION_dlist "0.8.0.6"

138+#endif /* VERSION_dlist */

139+#ifndef MIN_VERSION_dlist

140+#define MIN_VERSION_dlist(major1,major2,minor) (\

141+ (major1) < 0 || \

142+ (major1) == 0 && (major2) < 8 || \

143+ (major1) == 0 && (major2) == 8 && (minor) <= 0)

144+#endif /* MIN_VERSION_dlist */

145+

146+/* package filepath-1.4.2.1 */

147+#ifndef VERSION_filepath

148+#define VERSION_filepath "1.4.2.1"

149+#endif /* VERSION_filepath */

150+#ifndef MIN_VERSION_filepath

151+#define MIN_VERSION_filepath(major1,major2,minor) (\

152+ (major1) < 1 || \

153+ (major1) == 1 && (major2) < 4 || \

154+ (major1) == 1 && (major2) == 4 && (minor) <= 2)

155+#endif /* MIN_VERSION_filepath */

156+

157+/* package generic-deriving-1.12.4 */

158+#ifndef VERSION_generic_deriving

159+#define VERSION_generic_deriving "1.12.4"

160+#endif /* VERSION_generic_deriving */

161+#ifndef MIN_VERSION_generic_deriving

162+#define MIN_VERSION_generic_deriving(major1,major2,minor) (\

163+ (major1) < 1 || \

164+ (major1) == 1 && (major2) < 12 || \

165+ (major1) == 1 && (major2) == 12 && (minor) <= 4)

166+#endif /* MIN_VERSION_generic_deriving */

167+

168+/* package ghc-prim-0.5.3 */

169+#ifndef VERSION_ghc_prim

170+#define VERSION_ghc_prim "0.5.3"

171+#endif /* VERSION_ghc_prim */

172+#ifndef MIN_VERSION_ghc_prim

173+#define MIN_VERSION_ghc_prim(major1,major2,minor) (\

174+ (major1) < 0 || \

175+ (major1) == 0 && (major2) < 5 || \

176+ (major1) == 0 && (major2) == 5 && (minor) <= 3)

177+#endif /* MIN_VERSION_ghc_prim */

178+

179+/* package hashable-1.3.0.0 */

180+#ifndef VERSION_hashable

181+#define VERSION_hashable "1.3.0.0"

182+#endif /* VERSION_hashable */

183+#ifndef MIN_VERSION_hashable

184+#define MIN_VERSION_hashable(major1,major2,minor) (\

185+ (major1) < 1 || \

186+ (major1) == 1 && (major2) < 3 || \

187+ (major1) == 1 && (major2) == 3 && (minor) <= 0)

188+#endif /* MIN_VERSION_hashable */

189+

190+/* package hashable-time-0.2.0.2 */

191+#ifndef VERSION_hashable_time

192+#define VERSION_hashable_time "0.2.0.2"

193+#endif /* VERSION_hashable_time */

194+#ifndef MIN_VERSION_hashable_time

195+#define MIN_VERSION_hashable_time(major1,major2,minor) (\

196+ (major1) < 0 || \

197+ (major1) == 0 && (major2) < 2 || \

198+ (major1) == 0 && (major2) == 2 && (minor) <= 0)

199+#endif /* MIN_VERSION_hashable_time */

200+

201+/* package integer-logarithms-1.0.3 */

202+#ifndef VERSION_integer_logarithms

203+#define VERSION_integer_logarithms "1.0.3"

204+#endif /* VERSION_integer_logarithms */

205+#ifndef MIN_VERSION_integer_logarithms

206+#define MIN_VERSION_integer_logarithms(major1,major2,minor) (\

207+ (major1) < 1 || \

208+ (major1) == 1 && (major2) < 0 || \

209+ (major1) == 1 && (major2) == 0 && (minor) <= 3)

210+#endif /* MIN_VERSION_integer_logarithms */

211+

212+/* package quickcheck-instances-0.3.21 */

213+#ifndef VERSION_quickcheck_instances

214+#define VERSION_quickcheck_instances "0.3.21"

215+#endif /* VERSION_quickcheck_instances */

216+#ifndef MIN_VERSION_quickcheck_instances

217+#define MIN_VERSION_quickcheck_instances(major1,major2,minor) (\

218+ (major1) < 0 || \

219+ (major1) == 0 && (major2) < 3 || \

220+ (major1) == 0 && (major2) == 3 && (minor) <= 21)

221+#endif /* MIN_VERSION_quickcheck_instances */

222+

223+/* package scientific-0.3.6.2 */

224+#ifndef VERSION_scientific

225+#define VERSION_scientific "0.3.6.2"

226+#endif /* VERSION_scientific */

227+#ifndef MIN_VERSION_scientific

228+#define MIN_VERSION_scientific(major1,major2,minor) (\

229+ (major1) < 0 || \

230+ (major1) == 0 && (major2) < 3 || \

231+ (major1) == 0 && (major2) == 3 && (minor) <= 6)

232+#endif /* MIN_VERSION_scientific */

233+

234+/* package tagged-0.8.6 */

235+#ifndef VERSION_tagged

236+#define VERSION_tagged "0.8.6"

237+#endif /* VERSION_tagged */

238+#ifndef MIN_VERSION_tagged

239+#define MIN_VERSION_tagged(major1,major2,minor) (\

240+ (major1) < 0 || \

241+ (major1) == 0 && (major2) < 8 || \

242+ (major1) == 0 && (major2) == 8 && (minor) <= 6)

243+#endif /* MIN_VERSION_tagged */

244+

245+/* package tasty-1.2.3 */

246+#ifndef VERSION_tasty

247+#define VERSION_tasty "1.2.3"

248+#endif /* VERSION_tasty */

249+#ifndef MIN_VERSION_tasty

250+#define MIN_VERSION_tasty(major1,major2,minor) (\

251+ (major1) < 1 || \

252+ (major1) == 1 && (major2) < 2 || \

253+ (major1) == 1 && (major2) == 2 && (minor) <= 3)

254+#endif /* MIN_VERSION_tasty */

255+

256+/* package tasty-golden-2.3.2 */

257+#ifndef VERSION_tasty_golden

258+#define VERSION_tasty_golden "2.3.2"

259+#endif /* VERSION_tasty_golden */

260+#ifndef MIN_VERSION_tasty_golden

261+#define MIN_VERSION_tasty_golden(major1,major2,minor) (\

262+ (major1) < 2 || \

263+ (major1) == 2 && (major2) < 3 || \

264+ (major1) == 2 && (major2) == 3 && (minor) <= 2)

265+#endif /* MIN_VERSION_tasty_golden */

266+

267+/* package tasty-hunit-0.10.0.2 */

268+#ifndef VERSION_tasty_hunit

269+#define VERSION_tasty_hunit "0.10.0.2"

270+#endif /* VERSION_tasty_hunit */

271+#ifndef MIN_VERSION_tasty_hunit

272+#define MIN_VERSION_tasty_hunit(major1,major2,minor) (\

273+ (major1) < 0 || \

274+ (major1) == 0 && (major2) < 10 || \

275+ (major1) == 0 && (major2) == 10 && (minor) <= 0)

276+#endif /* MIN_VERSION_tasty_hunit */

277+

278+/* package tasty-quickcheck-0.10.1 */

279+#ifndef VERSION_tasty_quickcheck

280+#define VERSION_tasty_quickcheck "0.10.1"

281+#endif /* VERSION_tasty_quickcheck */

282+#ifndef MIN_VERSION_tasty_quickcheck

283+#define MIN_VERSION_tasty_quickcheck(major1,major2,minor) (\

284+ (major1) < 0 || \

285+ (major1) == 0 && (major2) < 10 || \

286+ (major1) == 0 && (major2) == 10 && (minor) <= 1)

287+#endif /* MIN_VERSION_tasty_quickcheck */

288+

289+/* package template-haskell-2.14.0.0 */

290+#ifndef VERSION_template_haskell

291+#define VERSION_template_haskell "2.14.0.0"

292+#endif /* VERSION_template_haskell */

293+#ifndef MIN_VERSION_template_haskell

294+#define MIN_VERSION_template_haskell(major1,major2,minor) (\

295+ (major1) < 2 || \

296+ (major1) == 2 && (major2) < 14 || \

297+ (major1) == 2 && (major2) == 14 && (minor) <= 0)

298+#endif /* MIN_VERSION_template_haskell */

299+

300+/* package text-1.2.3.1 */

301+#ifndef VERSION_text

302+#define VERSION_text "1.2.3.1"

303+#endif /* VERSION_text */

304+#ifndef MIN_VERSION_text

305+#define MIN_VERSION_text(major1,major2,minor) (\

306+ (major1) < 1 || \

307+ (major1) == 1 && (major2) < 2 || \

308+ (major1) == 1 && (major2) == 2 && (minor) <= 3)

309+#endif /* MIN_VERSION_text */

310+

311+/* package time-1.8.0.2 */

312+#ifndef VERSION_time

313+#define VERSION_time "1.8.0.2"

314+#endif /* VERSION_time */

315+#ifndef MIN_VERSION_time

316+#define MIN_VERSION_time(major1,major2,minor) (\

317+ (major1) < 1 || \

318+ (major1) == 1 && (major2) < 8 || \

319+ (major1) == 1 && (major2) == 8 && (minor) <= 0)

320+#endif /* MIN_VERSION_time */

321+

322+/* package time-compat-1.9.2.2 */

323+#ifndef VERSION_time_compat

324+#define VERSION_time_compat "1.9.2.2"

325+#endif /* VERSION_time_compat */

326+#ifndef MIN_VERSION_time_compat

327+#define MIN_VERSION_time_compat(major1,major2,minor) (\

328+ (major1) < 1 || \

329+ (major1) == 1 && (major2) < 9 || \

330+ (major1) == 1 && (major2) == 9 && (minor) <= 2)

331+#endif /* MIN_VERSION_time_compat */

332+

333+/* package unordered-containers-0.2.10.0 */

334+#ifndef VERSION_unordered_containers

335+#define VERSION_unordered_containers "0.2.10.0"

336+#endif /* VERSION_unordered_containers */

337+#ifndef MIN_VERSION_unordered_containers

338+#define MIN_VERSION_unordered_containers(major1,major2,minor) (\

339+ (major1) < 0 || \

340+ (major1) == 0 && (major2) < 2 || \

341+ (major1) == 0 && (major2) == 2 && (minor) <= 10)

342+#endif /* MIN_VERSION_unordered_containers */

343+

344+/* package uuid-types-1.0.3 */

345+#ifndef VERSION_uuid_types

346+#define VERSION_uuid_types "1.0.3"

347+#endif /* VERSION_uuid_types */

348+#ifndef MIN_VERSION_uuid_types

349+#define MIN_VERSION_uuid_types(major1,major2,minor) (\

350+ (major1) < 1 || \

351+ (major1) == 1 && (major2) < 0 || \

352+ (major1) == 1 && (major2) == 0 && (minor) <= 3)

353+#endif /* MIN_VERSION_uuid_types */

354+

355+/* package vector-0.12.0.3 */

356+#ifndef VERSION_vector

357+#define VERSION_vector "0.12.0.3"

358+#endif /* VERSION_vector */

359+#ifndef MIN_VERSION_vector

360+#define MIN_VERSION_vector(major1,major2,minor) (\

361+ (major1) < 0 || \

362+ (major1) == 0 && (major2) < 12 || \

363+ (major1) == 0 && (major2) == 12 && (minor) <= 0)

364+#endif /* MIN_VERSION_vector */

365+

366+/* tool gcc-4.2.1 */

367+#ifndef TOOL_VERSION_gcc

368+#define TOOL_VERSION_gcc "4.2.1"

369+#endif /* TOOL_VERSION_gcc */

370+#ifndef MIN_TOOL_VERSION_gcc

371+#define MIN_TOOL_VERSION_gcc(major1,major2,minor) (\

372+ (major1) < 4 || \

373+ (major1) == 4 && (major2) < 2 || \

374+ (major1) == 4 && (major2) == 2 && (minor) <= 1)

375+#endif /* MIN_TOOL_VERSION_gcc */

376+

377+/* tool ghc-8.6.5 */

378+#ifndef TOOL_VERSION_ghc

379+#define TOOL_VERSION_ghc "8.6.5"

380+#endif /* TOOL_VERSION_ghc */

381+#ifndef MIN_TOOL_VERSION_ghc

382+#define MIN_TOOL_VERSION_ghc(major1,major2,minor) (\

383+ (major1) < 8 || \

384+ (major1) == 8 && (major2) < 6 || \

385+ (major1) == 8 && (major2) == 6 && (minor) <= 5)

386+#endif /* MIN_TOOL_VERSION_ghc */

387+

388+/* tool ghc-pkg-8.6.5 */

389+#ifndef TOOL_VERSION_ghc_pkg

390+#define TOOL_VERSION_ghc_pkg "8.6.5"

391+#endif /* TOOL_VERSION_ghc_pkg */

392+#ifndef MIN_TOOL_VERSION_ghc_pkg

393+#define MIN_TOOL_VERSION_ghc_pkg(major1,major2,minor) (\

394+ (major1) < 8 || \

395+ (major1) == 8 && (major2) < 6 || \

396+ (major1) == 8 && (major2) == 6 && (minor) <= 5)

397+#endif /* MIN_TOOL_VERSION_ghc_pkg */

398+

399+/* tool haddock-2.22.0 */

400+#ifndef TOOL_VERSION_haddock

401+#define TOOL_VERSION_haddock "2.22.0"

402+#endif /* TOOL_VERSION_haddock */

403+#ifndef MIN_TOOL_VERSION_haddock

404+#define MIN_TOOL_VERSION_haddock(major1,major2,minor) (\

405+ (major1) < 2 || \

406+ (major1) == 2 && (major2) < 22 || \

407+ (major1) == 2 && (major2) == 22 && (minor) <= 0)

408+#endif /* MIN_TOOL_VERSION_haddock */

409+

410+/* tool hpc-0.67 */

411+#ifndef TOOL_VERSION_hpc

412+#define TOOL_VERSION_hpc "0.67"

413+#endif /* TOOL_VERSION_hpc */

414+#ifndef MIN_TOOL_VERSION_hpc

415+#define MIN_TOOL_VERSION_hpc(major1,major2,minor) (\

416+ (major1) < 0 || \

417+ (major1) == 0 && (major2) < 67 || \

418+ (major1) == 0 && (major2) == 67 && (minor) <= 0)

419+#endif /* MIN_TOOL_VERSION_hpc */

420+

421+/* tool hsc2hs-0.68.5 */

422+#ifndef TOOL_VERSION_hsc2hs

423+#define TOOL_VERSION_hsc2hs "0.68.5"

424+#endif /* TOOL_VERSION_hsc2hs */

425+#ifndef MIN_TOOL_VERSION_hsc2hs

426+#define MIN_TOOL_VERSION_hsc2hs(major1,major2,minor) (\

427+ (major1) < 0 || \

428+ (major1) == 0 && (major2) < 68 || \

429+ (major1) == 0 && (major2) == 68 && (minor) <= 5)

430+#endif /* MIN_TOOL_VERSION_hsc2hs */

431+

432+/* tool runghc-8.6.5 */

433+#ifndef TOOL_VERSION_runghc

434+#define TOOL_VERSION_runghc "8.6.5"

435+#endif /* TOOL_VERSION_runghc */

436+#ifndef MIN_TOOL_VERSION_runghc

437+#define MIN_TOOL_VERSION_runghc(major1,major2,minor) (\

438+ (major1) < 8 || \

439+ (major1) == 8 && (major2) < 6 || \

440+ (major1) == 8 && (major2) == 6 && (minor) <= 5)

441+#endif /* MIN_TOOL_VERSION_runghc */

442+

443+#ifndef CURRENT_COMPONENT_ID

444+#define CURRENT_COMPONENT_ID "aeson-1.4.4.0-inplace-tests"

445+#endif /* CURRENT_COMPONENT_ID */

446+#ifndef CURRENT_PACKAGE_VERSION

447+#define CURRENT_PACKAGE_VERSION "1.4.4.0"

448+#endif /* CURRENT_PACKAGE_VERSION */

travis/install.sh+11

@@ -7,6 +7,11 @@ echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo

7stack --version

9case $BUILD in

10+ hlint)

11+ echo "Downloading hlint"

12+ curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh > hlint.sh

13+ chmod +x hlint.sh

14+ ;;

10 stack)

15 stack)

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

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

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

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

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

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

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

45 fi

50 fi

46 ;;

51 ;;

52+ cabal2)

53+ cabal v2-update -v

54+ sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

55+

56+ cabal v2-build --only-dependencies --enable-tests --enable-benchmarks --dry

57+ ;;

47esac

58esac

travis/script.sh+4−2

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

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

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

21 ;;

22+ cabal2)

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

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

25+ ;;

22 hlint)

26 hlint)

23− stack build --fast aeson --stack-yaml stack-nightly.yaml --system-ghc --no-terminal

24− stack install hlint --stack-yaml stack-nightly.yaml --system-ghc --no-terminal

25 make lint

27 make lint

26 ;;

28 ;;

27esac

29esac