on d398724 help sign in
.gitattributesdeleted−1
since splitsnapshots
unifiedsplit
@@ -1 +0,0 @@
1−tests/JSONTestSuite/* linguist-vendored
.gitignore−12
@@ -1,21 +1,9 @@
1dist
1dist
2−dist-newstyle
3−.ghc.environment.*
4.cabal-sandbox/
2.cabal-sandbox/
5cabal.sandbox.config
3cabal.sandbox.config
6−.stack-work/
7−.stack-work-bench/
8−*.yaml.lock
9
4
10*.o
5*.o
11*.hi
6*.hi
12−*.nix
13−*.swp
14−.\#*
15−\#*
16−
17−# Emacs backup files
18−*~
19
7
20benchmarks/AesonEncode
8benchmarks/AesonEncode
21
9
.hgignore+1−1
@@ -1,6 +1,6 @@
1.*\.(?:aux|h[ip]|o|orig|out|pdf|prof|ps|rej)$
1.*\.(?:aux|h[ip]|o|orig|out|pdf|prof|ps|rej)$
2^(?:dist|\.DS_Store)$
2^(?:dist|\.DS_Store)$
3−^(?:benchmarks|examples)/dist$
3+^benchmarks/dist$
4^tests/(?:qc)
4^tests/(?:qc)
5
5
6syntax: glob
6syntax: glob
.hgtags−1
@@ -40,4 +40,3 @@ da25c578cf0466cecbf073a061692627d95bc224 0.8.0.2
40dec5d42c267b92ee45c0338714814e60807ec1de 0.8.1.1
40dec5d42c267b92ee45c0338714814e60807ec1de 0.8.1.1
419f84aecacebcbb3d65d761258c675da7e504c9f3 0.9.0.0
419f84aecacebcbb3d65d761258c675da7e504c9f3 0.9.0.0
42a6826d161cc5bb2b4b2f5d56e53c6361583671a3 0.9.0.1
42a6826d161cc5bb2b4b2f5d56e53c6361583671a3 0.9.0.1
43−921050855dc465282954cabb6b13a510fc534786 0.10.0.0
.hlint.yamldeleted−11
@@ -1,11 +0,0 @@
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.ymldeleted−83
@@ -1,83 +0,0 @@
1−# This file has been modified from generated version
2−# see https://github.com/hvr/multi-ghc-travis
3−language: c
4−sudo: false
5−
6−# Bryan threatens to turn off Travis-CI if he gets any email :-)
7−notifications:
8− email: false
9−
10−cache:
11− directories:
12− - $HOME/.stack
13− - $HOME/.cabsnap
14− - $HOME/.cabal/packages
15− - $HOME/.cabal/store
16−
17−before_cache:
18− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
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
24−
25−matrix:
26− include:
27−
28− - env: BUILD=hlint CABALVER=2.2 GHCVER=8.4.4
29− compiler: ": #GHC 8.4.4"
30− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.4], sources: [hvr-ghc]}}
31−
32− - env: BUILD=stack CABALVER=2.4 GHCVER=8.6.5 STACK_YAML=stack-bench.yaml
33− compiler: ": #GHC 8.6.5"
34− addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.5], sources: [hvr-ghc]}}
35−
36− - env: BUILD=stack CABALVER=2.2 GHCVER=8.6.5 STACK_YAML=stack-ffi-unescape.yaml
37− compiler: ": #GHC 8.6.5"
38− addons: {apt: {packages: [cabal-install-2.2,ghc-8.6.5], sources: [hvr-ghc]}}
39−
40− - env: BUILD=cabal2 CABALVER=3.0 GHCVER=8.8.1
41− compiler: ": #GHC 8.8.1"
42− addons: {apt: {packages: [cabal-install-3.0,ghc-8.8.1], sources: [hvr-ghc]}}
43−
44− - env: BUILD=cabal CABALVER=2.4 GHCVER=8.6.5
45− compiler: ": #GHC 8.6.5"
46− addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.5], sources: [hvr-ghc]}}
47−
48− - env: BUILD=cabal CABALVER=2.2 GHCVER=8.4.4
49− compiler: ": #GHC 8.4.4"
50− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.4], sources: [hvr-ghc]}}
51−
52− - env: BUILD=cabal CABALVER=2.0 GHCVER=8.2.2
53− compiler: ": #GHC 8.2.2"
54− addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
55−
56− - env: BUILD=cabal CABALVER=2.0 GHCVER=8.0.2
57− compiler: ": #GHC 8.0.2"
58− addons: {apt: {packages: [cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}
59−
60− - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3
61− compiler: ": #GHC 7.10.3"
62− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
63−
64− - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4
65− compiler: ": #GHC 7.8.4"
66− addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
67−
68−before_install:
69− - unset CC
70− - export PATH=$HOME/.local/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
71− # Download and unpack the stack executable
72− - mkdir -p ~/.local/bin
73− - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
74−
75−install:
76− - travis/install.sh
77−
78−# Here starts the actual work to be performed for the package under test;
79−# any command which exits with a non-zero exit code causes the build to fail.
80−script:
81− - travis/script.sh
82−
83−# EOF
CONTRIBUTING.mddeleted−98
@@ -1,98 +0,0 @@
1−# Documenting changes
2−
3−Changes that affect users of aeson should be mentioned in `changelog.md`. It should contain
4−* A description
5−* The level of change, see [PVP](https://wiki.haskell.org/Package_versioning_policy)
6−* Where applicable
7− * How to migrate existing code
8− * When it should be used
9− * What it supersedes
10−
11−Add this entry under an `## Upcoming` header above existing releases.
12−
13−The exact format of entries is not important as we'll go through everything before a release is made.
14−
15−# Style guide
16−
17−* 4 space indentation
18−
19−## Pragmas
20−
21−* One pragma on each line
22−* No alignment
23−* Sort lexicographically
24−
25−```haskell
26−{-# LANGUAGE BangPatterns #-}
27−{-# LANGUAGE CPP #-}
28−{-# LANGUAGE DataKinds #-}
29−```
30−
31−## Module declaration and exports
32−
33−* Opening paren on its own line
34−* Prefix with commas
35−* End with `) where`
36−
37−```haskell
38−module Data.Aeson.Types.ToJSON
39− (
40− -- * Core JSON classes
41− ToJSON(..)
42− -- * Liftings to unary and binary type constructors
43− , ToJSON1(..)
44− , toJSON1
45− ) where
46−```
47−
48−## Imports
49−
50−* No alignment of import lists or qualifications
51−* Sort lexicographically (qualified imports will be last)
52−* No space between types and constructor lists
53−* Sort identifiers in import lists lexicographically
54−
55−```haskell
56−import BarBar as B ((<>), foo)
57−import Foo as F
58−import Qux (Q(..), q)
59−import 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+116−264
@@ -1,9 +1,8 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2-- |
1-- |
3-- Module: Data.Aeson
2-- Module: Data.Aeson
4−-- Copyright: (c) 2011-2016 Bryan O'Sullivan
3+-- Copyright: (c) 2011, 2012 Bryan O'Sullivan
5-- (c) 2011 MailRank, Inc.
4-- (c) 2011 MailRank, Inc.
6−-- License: BSD3
5+-- License: Apache
7-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Stability: experimental
7-- Stability: experimental
9-- Portability: portable
8-- Portability: portable
@@ -17,9 +16,6 @@ module Data.Aeson
17 -- * How to use this library
16 -- * How to use this library
18 -- $use
17 -- $use
19
18
20− -- ** Writing instances by hand
21− -- $manual
22−
23 -- ** Working with the AST
19 -- ** Working with the AST
24 -- $ast
20 -- $ast
25
21
@@ -29,30 +25,26 @@ module Data.Aeson
29 -- ** Decoding a mixed-type object
25 -- ** Decoding a mixed-type object
30 -- $mixed
26 -- $mixed
31
27
28+ -- ** Automatically decoding data types
29+ -- $typeable
30+
31+ -- ** Pitfalls
32+ -- $pitfalls
33+
32 -- * Encoding and decoding
34 -- * Encoding and decoding
33 -- $encoding_and_decoding
35 -- $encoding_and_decoding
34−
35− -- ** Direct encoding
36− -- $encoding
37 decode
36 decode
38 , decode'
37 , decode'
39 , eitherDecode
38 , eitherDecode
40 , eitherDecode'
39 , eitherDecode'
41 , encode
40 , encode
42− , encodeFile
43 -- ** Variants for strict bytestrings
41 -- ** Variants for strict bytestrings
44 , decodeStrict
42 , decodeStrict
45− , decodeFileStrict
46 , decodeStrict'
43 , decodeStrict'
47− , decodeFileStrict'
48 , eitherDecodeStrict
44 , eitherDecodeStrict
49− , eitherDecodeFileStrict
50 , eitherDecodeStrict'
45 , eitherDecodeStrict'
51− , eitherDecodeFileStrict'
52 -- * Core JSON types
46 -- * Core JSON types
53 , Value(..)
47 , Value(..)
54− , Encoding
55− , fromEncoding
56 , Array
48 , Array
57 , Object
49 , Object
58 -- * Convenience types
50 -- * Convenience types
@@ -62,107 +54,38 @@ module Data.Aeson
62 , Result(..)
54 , Result(..)
63 , fromJSON
55 , fromJSON
64 , ToJSON(..)
56 , ToJSON(..)
65− , KeyValue(..)
66− , (<?>)
67− , JSONPath
68− -- ** Keys for maps
69− , ToJSONKey(..)
70− , ToJSONKeyFunction(..)
71− , FromJSONKey(..)
72− , FromJSONKeyFunction(..)
73− -- *** Generic keys
74− , GToJSONKey()
75− , genericToJSONKey
76− , GFromJSONKey()
77− , genericFromJSONKey
78− -- ** Liftings to unary and binary type constructors
79− , FromJSON1(..)
80− , parseJSON1
81− , FromJSON2(..)
82− , parseJSON2
83− , ToJSON1(..)
84− , toJSON1
85− , toEncoding1
86− , ToJSON2(..)
87− , toJSON2
88− , toEncoding2
89− -- ** Generic JSON classes and options
57+ -- ** Generic JSON classes
90 , GFromJSON(..)
58 , GFromJSON(..)
91− , FromArgs(..)
92− , GToJSON
59+ , GToJSON(..)
93− , GToEncoding
94− , ToArgs(..)
95− , Zero
96− , One
97 , genericToJSON
60 , genericToJSON
98− , genericLiftToJSON
99− , genericToEncoding
100− , genericLiftToEncoding
101 , genericParseJSON
61 , genericParseJSON
102− , genericLiftParseJSON
103− -- ** Generic and TH encoding configuration
104− , Options
105− , defaultOptions
106− -- *** Options fields
107− -- $optionsFields
108− , fieldLabelModifier
109− , constructorTagModifier
110− , allNullaryToStringTag
111− , omitNothingFields
112− , sumEncoding
113− , unwrapUnaryRecords
114− , tagSingleConstructors
115− -- *** Options utilities
116− , SumEncoding(..)
117− , camelTo2
118− , defaultTaggedObject
119− -- ** Options for object keys
120− , JSONKeyOptions
121− , keyModifier
122− , defaultJSONKeyOptions
123
62
124 -- * Inspecting @'Value's@
63 -- * Inspecting @'Value's@
125 , withObject
64 , withObject
126 , withText
65 , withText
127 , withArray
66 , withArray
67+ , withNumber
128 , withScientific
68 , withScientific
129 , withBool
69 , withBool
130− , withEmbeddedJSON
131 -- * Constructors and accessors
70 -- * Constructors and accessors
132− , Series
71+ , (.=)
133− , pairs
134− , foldable
135 , (.:)
72 , (.:)
136 , (.:?)
73 , (.:?)
137− , (.:!)
138 , (.!=)
74 , (.!=)
139 , object
75 , object
140 -- * Parsing
76 -- * Parsing
141 , json
77 , json
142 , json'
78 , json'
143− , parseIndexedJSON
144 ) where
79 ) where
145
80
146−import Prelude.Compat
81+import Data.Aeson.Encode (encode)
147−
148−import Data.Aeson.Types.FromJSON (ifromJSON, parseIndexedJSON)
149−import Data.Aeson.Encoding (encodingToLazyByteString)
150−import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith, eitherDecodeWith, eitherDecodeStrictWith, jsonEOF, json, jsonEOF', json')
82+import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith,
83+ eitherDecodeWith, eitherDecodeStrictWith,
84+ jsonEOF, json, jsonEOF', json')
151import Data.Aeson.Types
85import Data.Aeson.Types
152−import Data.Aeson.Types.Internal (JSONPath, formatError, (<?>))
153import qualified Data.ByteString as B
86import qualified Data.ByteString as B
154import qualified Data.ByteString.Lazy as L
87import qualified Data.ByteString.Lazy as L
155
88
156−-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
157−--
158−-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.
159−encode :: (ToJSON a) => a -> L.ByteString
160−encode = encodingToLazyByteString . toEncoding
161−
162−-- | Efficiently serialize a JSON value as a lazy 'L.ByteString' and write it to a file.
163−encodeFile :: (ToJSON a) => FilePath -> a -> IO ()
164−encodeFile fp = L.writeFile fp . encode
165−
166-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
89-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
167-- If this fails due to incomplete or invalid input, 'Nothing' is
90-- If this fails due to incomplete or invalid input, 'Nothing' is
168-- returned.
91-- returned.
@@ -189,24 +112,15 @@ decodeStrict :: (FromJSON a) => B.ByteString -> Maybe a
189decodeStrict = decodeStrictWith jsonEOF fromJSON
112decodeStrict = decodeStrictWith jsonEOF fromJSON
190{-# INLINE decodeStrict #-}
113{-# INLINE decodeStrict #-}
191
114
192−-- | Efficiently deserialize a JSON value from a file.
193−-- If this fails due to incomplete or invalid input, 'Nothing' is
194−-- returned.
195−--
196−-- The input file's content must consist solely of a JSON document,
197−-- with no trailing data except for whitespace.
198−--
199−-- This function parses immediately, but defers conversion. See
200−-- 'json' for details.
201−decodeFileStrict :: (FromJSON a) => FilePath -> IO (Maybe a)
202−decodeFileStrict = fmap decodeStrict . B.readFile
203−
204-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
115-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
205-- If this fails due to incomplete or invalid input, 'Nothing' is
116-- If this fails due to incomplete or invalid input, 'Nothing' is
206-- returned.
117-- returned.
207--
118--
208-- The input must consist solely of a JSON document, with no trailing
119-- The input must consist solely of a JSON document, with no trailing
209−-- data except for whitespace.
120+-- data except for whitespace. This restriction is necessary to ensure
121+-- that if data is being lazily read from a file handle, the file
122+-- handle will be closed in a timely fashion once the document has
123+-- been parsed.
210--
124--
211-- This function parses and performs conversion immediately. See
125-- This function parses and performs conversion immediately. See
212-- 'json'' for details.
126-- 'json'' for details.
@@ -214,7 +128,7 @@ decode' :: (FromJSON a) => L.ByteString -> Maybe a
214decode' = decodeWith jsonEOF' fromJSON
128decode' = decodeWith jsonEOF' fromJSON
215{-# INLINE decode' #-}
129{-# INLINE decode' #-}
216
130
217−-- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.
131+-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
218-- If this fails due to incomplete or invalid input, 'Nothing' is
132-- If this fails due to incomplete or invalid input, 'Nothing' is
219-- returned.
133-- returned.
220--
134--
@@ -227,117 +141,43 @@ decodeStrict' :: (FromJSON a) => B.ByteString -> Maybe a
227decodeStrict' = decodeStrictWith jsonEOF' fromJSON
141decodeStrict' = decodeStrictWith jsonEOF' fromJSON
228{-# INLINE decodeStrict' #-}
142{-# INLINE decodeStrict' #-}
229
143
230−-- | Efficiently deserialize a JSON value from a file.
231−-- If this fails due to incomplete or invalid input, 'Nothing' is
232−-- returned.
233−--
234−-- The input file's content must consist solely of a JSON document,
235−-- with no trailing data except for whitespace.
236−--
237−-- This function parses and performs conversion immediately. See
238−-- 'json'' for details.
239−decodeFileStrict' :: (FromJSON a) => FilePath -> IO (Maybe a)
240−decodeFileStrict' = fmap decodeStrict' . B.readFile
241−
242−eitherFormatError :: Either (JSONPath, String) a -> Either String a
243−eitherFormatError = either (Left . uncurry formatError) Right
244−{-# INLINE eitherFormatError #-}
245−
246-- | Like 'decode' but returns an error message when decoding fails.
144-- | Like 'decode' but returns an error message when decoding fails.
247eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
145eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
248−eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
146+eitherDecode = eitherDecodeWith jsonEOF fromJSON
249{-# INLINE eitherDecode #-}
147{-# INLINE eitherDecode #-}
250
148
251-- | Like 'decodeStrict' but returns an error message when decoding fails.
149-- | Like 'decodeStrict' but returns an error message when decoding fails.
252eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
150eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
253−eitherDecodeStrict =
254− eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON
151+eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON
255{-# INLINE eitherDecodeStrict #-}
152{-# INLINE eitherDecodeStrict #-}
256
153
257−-- | Like 'decodeFileStrict' but returns an error message when decoding fails.
258−eitherDecodeFileStrict :: (FromJSON a) => FilePath -> IO (Either String a)
259−eitherDecodeFileStrict =
260− fmap (eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON) . B.readFile
261−{-# INLINE eitherDecodeFileStrict #-}
262−
263-- | Like 'decode'' but returns an error message when decoding fails.
154-- | Like 'decode'' but returns an error message when decoding fails.
264eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
155eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
265−eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' ifromJSON
156+eitherDecode' = eitherDecodeWith jsonEOF' fromJSON
266{-# INLINE eitherDecode' #-}
157{-# INLINE eitherDecode' #-}
267
158
268-- | Like 'decodeStrict'' but returns an error message when decoding fails.
159-- | Like 'decodeStrict'' but returns an error message when decoding fails.
269eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
160eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
270−eitherDecodeStrict' =
271− eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON
161+eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON
272{-# INLINE eitherDecodeStrict' #-}
162{-# INLINE eitherDecodeStrict' #-}
273
163
274−-- | Like 'decodeFileStrict'' but returns an error message when decoding fails.
275−eitherDecodeFileStrict' :: (FromJSON a) => FilePath -> IO (Either String a)
276−eitherDecodeFileStrict' =
277− fmap (eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON) . B.readFile
278−{-# INLINE eitherDecodeFileStrict' #-}
279−
280-- $use
164-- $use
281--
165--
282-- This section contains basic information on the different ways to
166-- This section contains basic information on the different ways to
283−-- work with data using this library. These range from simple but
167+-- decode data using this library. These range from simple but
284-- inflexible, to complex but flexible.
168-- inflexible, to complex but flexible.
285--
169--
286-- The most common way to use the library is to define a data type,
170-- The most common way to use the library is to define a data type,
287-- corresponding to some JSON data you want to work with, and then
171-- corresponding to some JSON data you want to work with, and then
288-- write either a 'FromJSON' instance, a to 'ToJSON' instance, or both
172-- write either a 'FromJSON' instance, a to 'ToJSON' instance, or both
289−-- for that type.
290−--
291−-- For example, given this JSON data:
173+-- for that type. For example, given this JSON data:
292--
174--
293-- > { "name": "Joe", "age": 12 }
175-- > { "name": "Joe", "age": 12 }
294--
176--
295-- we create a matching data type:
177-- we create a matching data type:
296--
178--
297−-- > {-# LANGUAGE DeriveGeneric #-}
298−-- >
299−-- > import GHC.Generics
300−-- >
301−-- > data Person = Person {
179+-- > data Person = Person
302−-- > name :: Text
303−-- > , age :: Int
304−-- > } deriving (Generic, Show)
305−--
306−-- The @LANGUAGE@ pragma and 'Generic' instance let us write empty
307−-- 'FromJSON' and 'ToJSON' instances for which the compiler will
308−-- generate sensible default implementations.
309−--
310−-- @
311−-- instance 'ToJSON' Person where
312−-- \-- No need to provide a 'toJSON' implementation.
313−--
314−-- \-- For efficiency, we write a simple 'toEncoding' implementation, as
315−-- \-- the default version uses 'toJSON'.
316−-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
317−--
318−-- instance 'FromJSON' Person
319−-- \-- No need to provide a 'parseJSON' implementation.
320−-- @
321−--
322−-- We can now encode a value like so:
323−--
324−-- > >>> encode (Person {name = "Joe", age = 12})
325−-- > "{\"name\":\"Joe\",\"age\":12}"
326−
327−-- $manual
328−--
329−-- When necessary, we can write 'ToJSON' and 'FromJSON' instances by
330−-- hand. This is valuable when the JSON-on-the-wire and Haskell data
331−-- are different or otherwise need some more carefully managed
332−-- translation. Let's revisit our JSON data:
333−--
334−-- > { "name": "Joe", "age": 12 }
335−--
336−-- We once again create a matching data type, without bothering to add
337−-- a 'Generic' instance this time:
338−--
339−-- > data Person = Person {
340−-- > name :: Text
180+-- > { name :: Text
341-- > , age :: Int
181-- > , age :: Int
342-- > } deriving Show
182-- > } deriving Show
343--
183--
@@ -346,28 +186,21 @@ eitherDecodeFileStrict' =
346-- > {-# LANGUAGE OverloadedStrings #-}
186-- > {-# LANGUAGE OverloadedStrings #-}
347-- >
187-- >
348-- > instance FromJSON Person where
188-- > instance FromJSON Person where
349−-- > parseJSON = withObject "Person" $ \v -> Person
189+-- > parseJSON (Object v) = Person <$>
350−-- > <$> v .: "name"
190+-- > v .: "name" <*>
351−-- > <*> v .: "age"
191+-- > v .: "age"
192+-- > -- A non-Object value is of the wrong type, so fail.
193+-- > parseJSON _ = mzero
352--
194--
353-- We can now parse the JSON data like so:
195-- We can now parse the JSON data like so:
354--
196--
355-- > >>> decode "{\"name\":\"Joe\",\"age\":12}" :: Maybe Person
197-- > >>> decode "{\"name\":\"Joe\",\"age\":12}" :: Maybe Person
356-- > Just (Person {name = "Joe", age = 12})
198-- > Just (Person {name = "Joe", age = 12})
357--
199--
358−-- To encode data, we need to define a 'ToJSON' instance. Let's begin
200+-- To encode data, we need to define a 'ToJSON' instance:
359−-- with an instance written entirely by hand.
360--
201--
361−-- @
362−-- instance ToJSON Person where
202+-- > instance ToJSON Person where
363−-- \-- this generates a 'Value'
364−-- 'toJSON' (Person name age) =
365−-- 'object' [\"name\" '.=' name, \"age\" '.=' age]
203+-- > toJSON (Person name age) = object ["name" .= name, "age" .= age]
366−--
367−-- \-- this encodes directly to a bytestring Builder
368−-- 'toEncoding' (Person name age) =
369−-- 'pairs' (\"name\" '.=' 'name' '<>' \"age\" '.=' age)
370−-- @
371--
204--
372-- We can now encode a value like so:
205-- We can now encode a value like so:
373--
206--
@@ -393,7 +226,7 @@ eitherDecodeFileStrict' =
393-- expectations.)
226-- expectations.)
394--
227--
395-- See the documentation of 'FromJSON' and 'ToJSON' for some examples
228-- See the documentation of 'FromJSON' and 'ToJSON' for some examples
396−-- of how you can automatically derive instances in many common
229+-- of how you can automatically derive instances in some
397-- circumstances.
230-- circumstances.
398
231
399-- $ast
232-- $ast
@@ -416,7 +249,8 @@ eitherDecodeFileStrict' =
416
249
417-- $haskell
250-- $haskell
418--
251--
419−-- We can decode to any instance of 'FromJSON':
252+-- Any instance of 'FromJSON' can be specified (but see the
253+-- \"Pitfalls\" section here&#8212;"Data.Aeson#pitfalls"):
420--
254--
421-- > λ> decode "[1,2,3]" :: Maybe [Int]
255-- > λ> decode "[1,2,3]" :: Maybe [Int]
422-- > Just [1,2,3]
256-- > Just [1,2,3]
@@ -425,7 +259,7 @@ eitherDecodeFileStrict' =
425-- can use them directly. For example, use the 'Data.Map.Map' type to
259-- can use them directly. For example, use the 'Data.Map.Map' type to
426-- get a map of 'Int's.
260-- get a map of 'Int's.
427--
261--
428−-- > λ> import Data.Map
262+-- > λ> :m + Data.Map
429-- > λ> decode "{\"foo\":1,\"bar\":2}" :: Maybe (Map String Int)
263-- > λ> decode "{\"foo\":1,\"bar\":2}" :: Maybe (Map String Int)
430-- > Just (fromList [("bar",2),("foo",1)])
264-- > Just (fromList [("bar",2),("foo",1)])
431
265
@@ -438,7 +272,7 @@ eitherDecodeFileStrict' =
438-- The 'Object' type contains JSON objects:
272-- The 'Object' type contains JSON objects:
439--
273--
440-- > λ> decode "{\"name\":\"Dave\",\"age\":2}" :: Maybe Object
274-- > λ> decode "{\"name\":\"Dave\",\"age\":2}" :: Maybe Object
441−-- > Just (fromList [("name",String "Dave"),("age",Number 2)])
275+-- > Just (fromList) [("name",String "Dave"),("age",Number 2)]
442--
276--
443-- You can extract values from it with a parser using 'parse',
277-- You can extract values from it with a parser using 'parse',
444-- 'parseEither' or, in this example, 'parseMaybe':
278-- 'parseEither' or, in this example, 'parseMaybe':
@@ -460,68 +294,86 @@ eitherDecodeFileStrict' =
460-- upside is that you have complete control over the way the JSON is
294-- upside is that you have complete control over the way the JSON is
461-- parsed.
295-- parsed.
462
296
463−-- $encoding_and_decoding
297+-- $typeable
464−--
298+--
465−-- Decoding is a two-step process.
299+-- If you don't want fine control and would prefer the JSON be parsed
466−--
300+-- to your own data types automatically according to some reasonably
467−-- * When decoding a value, the process is reversed: the bytes are
301+-- sensible isomorphic implementation, you can use the generic parser
468−-- converted to a 'Value', then the 'FromJSON' class is used to
302+-- based on 'Data.Typeable.Typeable' and 'Data.Data.Data'. Switch to
469−-- convert to the desired type.
303+-- the 'Data.Aeson.Generic' module, and you can do the following:
304+--
305+-- > λ> decode "[1]" :: Maybe [Int]
306+-- > Just [1]
307+-- > λ> :m + Data.Typeable Data.Data
308+-- > λ> :set -XDeriveDataTypeable
309+-- > λ> data Person = Person { personName :: String, personAge :: Int } deriving (Data,Typeable,Show)
310+-- > λ> encode Person { personName = "Chris", personAge = 123 }
311+-- > "{\"personAge\":123,\"personName\":\"Chris\"}"
312+-- > λ> decode "{\"personAge\":123,\"personName\":\"Chris\"}" :: Maybe Person
313+-- > Just (Person {
314+-- > personName = "Chris", personAge = 123
315+-- > })
316+--
317+-- Be aware that the encoding may not always be what you'd naively
318+-- expect:
319+--
320+-- > λ> data Foo = Foo Int Int deriving (Data,Typeable,Show)
321+-- > λ> encode (Foo 1 2)
322+-- > "[1,2]"
323+--
324+-- With this approach, it's best to treat the
325+-- 'Data.Aeson.Generic.decode' and 'Data.Aeson.Generic.encode'
326+-- functions as an isomorphism, and not to rely upon (or care about)
327+-- the specific intermediate representation.
328+
329+-- $pitfalls
330+-- #pitfalls#
331+--
332+-- Note that the JSON standard requires that the top-level value be
333+-- either an array or an object. If you try to use 'decode' with a
334+-- result type that is /not/ represented in JSON as an array or
335+-- object, your code will typecheck, but it will always \"fail\" at
336+-- runtime:
337+--
338+-- > >>> decode "1" :: Maybe Int
339+-- > Nothing
340+-- > >>> decode "1" :: Maybe String
341+-- > Nothing
342+--
343+-- So stick to objects (e.g. maps in Haskell) or arrays (lists or
344+-- vectors in Haskell):
470--
345--
471−-- There are two ways to encode a value.
346+-- > >>> decode "[1,2,3]" :: Maybe [Int]
347+-- > Just [1,2,3]
472--
348--
473−-- * Convert to a 'Value' using 'toJSON', then possibly further
349+-- When encoding to JSON you can encode anything that's an instance of
474−-- encode. This was the only method available in aeson 0.9 and
350+-- 'ToJSON', and this may include simple types. So beware that this
475−-- earlier.
351+-- aspect of the API is not isomorphic. You can round-trip arrays and
352+-- maps, but not simple values:
476--
353--
477−-- * Directly encode (to what will become a 'L.ByteString') using
354+-- > >>> encode [1,2,3]
478−-- 'toEncoding'. This is much more efficient (about 3x faster, and
355+-- > "[1,2,3]"
479−-- less memory intensive besides), but is only available in aeson
356+-- > >>> decode (encode [1]) :: Maybe [Int]
480−-- 0.10 and newer.
357+-- > Just [1]
358+-- > >>> encode 1
359+-- > "1"
360+-- > >>> decode (encode (1 :: Int)) :: Maybe Int
361+-- > Nothing
481--
362--
482−-- For convenience, the 'encode' and 'decode' functions combine both
363+-- Alternatively, see 'Data.Aeson.Parser.value' to parse non-top-level
483−-- steps.
364+-- JSON values.
484
365
485−-- $encoding
366+-- $encoding_and_decoding
486−--
487−-- In older versions of this library, encoding a Haskell value
488−-- involved converting to an intermediate 'Value', then encoding that.
489−--
490−-- A \"direct\" encoder converts straight from a source Haskell value
491−-- to a 'BL.ByteString' without constructing an intermediate 'Value'.
492−-- This approach is faster than 'toJSON', and allocates less memory.
493−-- The 'toEncoding' method makes it possible to implement direct
494−-- encoding with low memory overhead.
495−--
496−-- To complicate matters, the default implementation of 'toEncoding'
497−-- uses 'toJSON'. Why? The 'toEncoding' method was added to this
498−-- library much more recently than 'toJSON'. Using 'toJSON' ensures
499−-- that packages written against older versions of this library will
500−-- compile and produce correct output, but they will not see any
501−-- speedup from direct encoding.
502−--
503−-- To write a minimal implementation of direct encoding, your type
504−-- must implement GHC's 'Generic' class, and your code should look
505−-- like this:
506−--
507−-- @
508−-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
509−-- @
510−--
511−-- What if you have more elaborate encoding needs? For example,
512−-- perhaps you need to change the names of object keys, omit parts of
513−-- a value.
514--
367--
515−-- To encode to a JSON \"object\", use the 'pairs' function.
368+-- Encoding and decoding are each two-step processes.
516--
369--
517−-- @
370+-- * To encode a value, it is first converted to an abstract syntax
518−-- 'toEncoding' (Person name age) =
371+-- tree (AST), using 'ToJSON'. This generic representation is then
519−-- 'pairs' (\"name\" '.=' 'name' '<>' \"age\" '.=' age)
372+-- encoded as bytes.
520−-- @
521--
373--
522−-- Any container type that implements 'Foldable' can be encoded to a
374+-- * When decoding a value, the process is reversed: the bytes are
523−-- JSON \"array\" using 'foldable'.
375+-- converted to an AST, then the 'FromJSON' class is used to convert
376+-- to the desired type.
524--
377--
525−-- > > import Data.Sequence as Seq
378+-- For convenience, the 'encode' and 'decode' functions combine both
526−-- > > encode (Seq.fromList [1,2,3])
379+-- steps.
527−-- > "[1,2,3]"
Data/Aeson/Encode.hs+84−17
@@ -1,31 +1,98 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2+
2-- |
3-- |
3-- Module: Data.Aeson.Encode
4-- Module: Data.Aeson.Encode
4−-- Copyright: (c) 2012-2016 Bryan O'Sullivan
5+-- Copyright: (c) 2012 Bryan O'Sullivan
5-- (c) 2011 MailRank, Inc.
6-- (c) 2011 MailRank, Inc.
6−-- License: BSD3
7+-- License: Apache
7-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Stability: experimental
9-- Stability: experimental
9-- Portability: portable
10-- Portability: portable
10--
11--
11−-- This module is left to supply limited backwards-compatibility.
12+-- Efficiently serialize a JSON value.
13+--
14+-- Most frequently, you'll probably want to encode straight to UTF-8
15+-- (the standard JSON encoding) using 'encode'.
16+--
17+-- You can use the conversions to 'Builder's when embedding JSON messages as
18+-- parts of a protocol.
19+module Data.Aeson.Encode
20+ ( encode
12
21
13−module Data.Aeson.Encode {-# DEPRECATED "Use Data.Aeson or Data.Aeson.Text instead" #-}
22+ -- * Encoding to Builders
14− (
23+ , encodeToBuilder
15− encode
24+ , encodeToByteStringBuilder
16 , encodeToTextBuilder
25 , encodeToTextBuilder
26+
27+ -- * Deprecated
28+ , fromValue
17 ) where
29 ) where
18
30
31+import Data.Aeson.Types (Value(..))
32+import Data.Monoid ((<>))
33+import Data.Scientific (FPFormat(..), Scientific, base10Exponent)
34+import Data.Text.Lazy.Builder
35+import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
36+import Numeric (showHex)
37+import qualified Data.HashMap.Strict as H
38+import qualified Data.Text as T
39+import qualified Data.Vector as V
40+
41+import Data.Aeson.Encode.ByteString (encode, encodeToBuilder,
42+ encodeToByteStringBuilder)
43+
44+-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
45+-- embedded efficiently in a text-based protocol.
46+encodeToTextBuilder :: Value -> Builder
47+encodeToTextBuilder =
48+ go
49+ where
50+ go Null = {-# SCC "go/Null" #-} "null"
51+ go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"
52+ go (Number s) = {-# SCC "go/Number" #-} fromScientific s
53+ go (String s) = {-# SCC "go/String" #-} string s
54+ go (Array v)
55+ | V.null v = {-# SCC "go/Array" #-} "[]"
56+ | otherwise = {-# SCC "go/Array" #-}
57+ singleton '[' <>
58+ go (V.unsafeHead v) <>
59+ V.foldr f (singleton ']') (V.unsafeTail v)
60+ where f a z = singleton ',' <> go a <> z
61+ go (Object m) = {-# SCC "go/Object" #-}
62+ case H.toList m of
63+ (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs
64+ _ -> "{}"
65+ where f a z = singleton ',' <> one a <> z
66+ one (k,v) = string k <> singleton ':' <> go v
67+
68+{-# DEPRECATED fromValue "Use 'encodeToTextBuilder' instead" #-}
69+fromValue :: Value -> Builder
70+fromValue = encodeToTextBuilder
19
71
20−import Data.ByteString.Lazy (ByteString)
72+string :: T.Text -> Builder
21−import Data.Text.Lazy.Builder (Builder)
73+string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'
22−import qualified Data.Aeson as A
74+ where
23−import qualified Data.Aeson.Text as A
75+ quote q = case T.uncons t of
76+ Nothing -> fromText h
77+ Just (!c,t') -> fromText h <> escape c <> quote t'
78+ where (h,t) = {-# SCC "break" #-} T.break isEscape q
79+ isEscape c = c == '\"' ||
80+ c == '\\' ||
81+ c < '\x20'
82+ escape '\"' = "\\\""
83+ escape '\\' = "\\\\"
84+ escape '\n' = "\\n"
85+ escape '\r' = "\\r"
86+ escape '\t' = "\\t"
24
87
25−encode :: A.ToJSON a => a -> ByteString
88+ escape c
26−encode = A.encode
89+ | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
27−{-# DEPRECATED encode "Use encode from Data.Aeson" #-}
90+ | otherwise = singleton c
91+ where h = showHex (fromEnum c) ""
28
92
29−encodeToTextBuilder :: A.Value -> Builder
93+fromScientific :: Scientific -> Builder
30−encodeToTextBuilder = A.encodeToTextBuilder
94+fromScientific s = formatScientificBuilder format prec s
31−{-# DEPRECATED encodeToTextBuilder "Use encodeTotextBuilder from Data.Aeson.Text" #-}
95+ where
96+ (format, prec)
97+ | base10Exponent s < 0 = (Generic, Nothing)
98+ | otherwise = (Fixed, Just 0)
Data/Aeson/Encode/ByteString.hsnew file+167
@@ -0,0 +1,167 @@
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2+
3+-- |
4+-- Module: Data.Aeson.EncodeUtf8
5+-- Copyright: (c) 2011 MailRank, Inc.
6+-- (c) 2013 Simon Meier <iridcode@gmail.com>
7+-- License: Apache
8+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
9+-- Stability: experimental
10+-- Portability: portable
11+--
12+-- Efficiently serialize a JSON value using the UTF-8 encoding.
13+
14+module Data.Aeson.Encode.ByteString
15+ ( encode
16+ , encodeToBuilder
17+ , encodeToByteStringBuilder
18+ , null_
19+ , bool
20+ , array
21+ , emptyArray_
22+ , emptyObject_
23+ , object
24+ , text
25+ , unquoted
26+ , number
27+ , foldable
28+ , series
29+ , ascii2
30+ , ascii4
31+ , ascii5
32+ , ascii6
33+ , ascii7
34+ ) where
35+
36+import Data.Aeson.Types.Class (ToJSON(..))
37+import Data.Aeson.Types.Internal (Value(..), Series(..))
38+import Data.ByteString.Builder as B
39+import Data.ByteString.Builder.Prim as BP
40+import Data.ByteString.Builder.Scientific (scientificBuilder)
41+import Data.Char (ord)
42+import Data.Foldable (Foldable, foldMap)
43+import Data.Monoid ((<>))
44+import Data.Scientific (Scientific, base10Exponent, coefficient)
45+import Data.Word (Word8)
46+import qualified Data.ByteString.Lazy as L
47+import qualified Data.HashMap.Strict as HMS
48+import qualified Data.Text as T
49+import qualified Data.Text.Encoding as TE
50+import qualified Data.Vector as V
51+
52+-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
53+encode :: ToJSON a => a -> L.ByteString
54+encode = B.toLazyByteString . encodeToBuilder . toJSON
55+
56+-- | Encode a JSON value to a ByteString 'B.Builder'. Use this function if you
57+-- must prepend or append further bytes to the encoded JSON value.
58+encodeToBuilder :: Value -> Builder
59+encodeToBuilder Null = null_
60+encodeToBuilder (Bool b) = bool b
61+encodeToBuilder (Number n) = number n
62+encodeToBuilder (String s) = text s
63+encodeToBuilder (Array v) = array v
64+encodeToBuilder (Object m) = object m
65+
66+-- | This function is an alias for 'encodeToBuilder'.
67+encodeToByteStringBuilder :: Value -> Builder
68+encodeToByteStringBuilder = encodeToBuilder
69+{-# DEPRECATED encodeToByteStringBuilder "Use encodeToBuilder instead." #-}
70+
71+-- | Encode a JSON null.
72+null_ :: Builder
73+null_ = BP.primBounded (ascii4 ('n',('u',('l','l')))) ()
74+
75+-- | Encode a JSON boolean.
76+bool :: Bool -> Builder
77+bool = BP.primBounded (BP.condB id (ascii4 ('t',('r',('u','e'))))
78+ (ascii5 ('f',('a',('l',('s','e'))))))
79+
80+-- | Encode a JSON array.
81+array :: V.Vector Value -> Builder
82+array v
83+ | V.null v = B.char8 '[' <> B.char8 ']'
84+ | otherwise = B.char8 '[' <>
85+ encodeToBuilder (V.unsafeHead v) <>
86+ V.foldr withComma (B.char8 ']') (V.unsafeTail v)
87+ where
88+ withComma a z = B.char8 ',' <> encodeToBuilder a <> z
89+
90+-- Encode a JSON object.
91+object :: HMS.HashMap T.Text Value -> Builder
92+object m = case HMS.toList m of
93+ (x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs
94+ _ -> B.char8 '{' <> B.char8 '}'
95+ where
96+ withComma a z = B.char8 ',' <> one a <> z
97+ one (k,v) = text k <> B.char8 ':' <> encodeToBuilder v
98+
99+-- | Encode a JSON string.
100+text :: T.Text -> Builder
101+text t = B.char8 '"' <> unquoted t <> B.char8 '"'
102+
103+-- | Encode a JSON string, without enclosing quotes.
104+unquoted :: T.Text -> Builder
105+unquoted t = TE.encodeUtf8BuilderEscaped escapeAscii t
106+ where
107+ escapeAscii :: BP.BoundedPrim Word8
108+ escapeAscii =
109+ BP.condB (== c2w '\\' ) (ascii2 ('\\','\\')) $
110+ BP.condB (== c2w '\"' ) (ascii2 ('\\','"' )) $
111+ BP.condB (>= c2w '\x20') (BP.liftFixedToBounded BP.word8) $
112+ BP.condB (== c2w '\n' ) (ascii2 ('\\','n' )) $
113+ BP.condB (== c2w '\r' ) (ascii2 ('\\','r' )) $
114+ BP.condB (== c2w '\t' ) (ascii2 ('\\','t' )) $
115+ (BP.liftFixedToBounded hexEscape) -- fallback for chars < 0x20
116+
117+ c2w = fromIntegral . ord
118+
119+ hexEscape :: BP.FixedPrim Word8
120+ hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<
121+ BP.char8 >*< BP.char8 >*< BP.word16HexFixed
122+
123+-- | Encode a JSON number.
124+number :: Scientific -> Builder
125+number s
126+ | e < 0 = scientificBuilder s
127+ | otherwise = B.integerDec (coefficient s * 10 ^ e)
128+ where
129+ e = base10Exponent s
130+
131+foldable :: (Foldable t, ToJSON a) => t a -> Builder
132+foldable = series '[' ']' . foldMap (Value . toEncoding)
133+
134+series :: Char -> Char -> Series -> Builder
135+series begin end (Value v) = B.char7 begin <> v <> B.char7 end
136+series begin end Empty = BP.primBounded (ascii2 (begin,end)) ()
137+
138+emptyArray_ :: Builder
139+emptyArray_ = BP.primBounded (ascii2 ('[',']')) ()
140+
141+emptyObject_ :: Builder
142+emptyObject_ = BP.primBounded (ascii2 ('{','}')) ()
143+
144+ascii2 :: (Char, Char) -> BP.BoundedPrim a
145+ascii2 cs = BP.liftFixedToBounded $ (const cs) BP.>$< BP.char7 >*< BP.char7
146+{-# INLINE ascii2 #-}
147+
148+ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a
149+ascii4 cs = BP.liftFixedToBounded $ (const cs) >$<
150+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
151+{-# INLINE ascii4 #-}
152+
153+ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a
154+ascii5 cs = BP.liftFixedToBounded $ (const cs) >$<
155+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
156+{-# INLINE ascii5 #-}
157+
158+ascii6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BP.BoundedPrim a
159+ascii6 cs = BP.liftFixedToBounded $ (const cs) >$<
160+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
161+{-# INLINE ascii6 #-}
162+
163+ascii7 :: (Char, (Char, (Char, (Char, (Char, (Char, Char)))))) -> BP.BoundedPrim a
164+ascii7 cs = BP.liftFixedToBounded $ (const cs) >$<
165+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*<
166+ BP.char7 >*< BP.char7
167+{-# INLINE ascii7 #-}
Data/Aeson/Encoding.hsdeleted−55
@@ -1,55 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−-- |
3−--
4−-- Functions in this module return well-formed 'Encoding''.
5−-- Polymorphic variants, which return @'Encoding' a@, return a textual JSON
6−-- value, so it can be used as both @'Encoding'' 'Text'@ and @'Encoding' = 'Encoding'' 'Value'@.
7−
8−module Data.Aeson.Encoding
9− (
10− -- * Encoding
11− Encoding
12− , Encoding'
13− , encodingToLazyByteString
14− , fromEncoding
15− , unsafeToEncoding
16− , Series
17− , pairs
18− , pair
19− , pairStr
20− , pair'
21− -- * Predicates
22− , nullEncoding
23− -- * Encoding constructors
24− , emptyArray_
25− , emptyObject_
26− , text
27− , lazyText
28− , string
29− , list
30− , dict
31− , null_
32− , bool
33− -- ** Decimal numbers
34− , int8, int16, int32, int64, int
35− , word8, word16, word32, word64, word
36− , integer, float, double, scientific
37−
38− -- ** Decimal numbers as Text
39− , int8Text, int16Text, int32Text, int64Text, intText
40− , word8Text, word16Text, word32Text, word64Text, wordText
41− , integerText, floatText, doubleText, scientificText
42−
43− -- ** Time
44− , day
45− , localTime
46− , utcTime
47− , timeOfDay
48− , zonedTime
49−
50− -- ** value
51− , value
52− ) where
53−
54−
55−import Data.Aeson.Encoding.Internal
Data/Aeson/Encoding/Builder.hsdeleted−256
@@ -1,256 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE TupleSections #-}
4−-- |
5−-- Module: Data.Aeson.Encoding.Builder
6−-- Copyright: (c) 2011 MailRank, Inc.
7−-- (c) 2013 Simon Meier <iridcode@gmail.com>
8−-- License: BSD3
9−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
10−-- Stability: experimental
11−-- Portability: portable
12−--
13−-- Efficiently serialize a JSON value using the UTF-8 encoding.
14−
15−module Data.Aeson.Encoding.Builder
16− (
17− encodeToBuilder
18− , null_
19− , bool
20− , array
21− , emptyArray_
22− , emptyObject_
23− , object
24− , text
25− , string
26− , unquoted
27− , quote
28− , scientific
29− , day
30− , localTime
31− , utcTime
32− , timeOfDay
33− , zonedTime
34− , ascii2
35− , ascii4
36− , ascii5
37− ) where
38−
39−import Prelude.Compat
40−
41−import Data.Aeson.Internal.Time
42−import Data.Aeson.Types.Internal (Value (..))
43−import Data.ByteString.Builder as B
44−import Data.ByteString.Builder.Prim as BP
45−import Data.ByteString.Builder.Scientific (scientificBuilder)
46−import Data.Char (chr, ord)
47−import Data.Semigroup ((<>))
48−import Data.Scientific (Scientific, base10Exponent, coefficient)
49−import Data.Text.Encoding (encodeUtf8BuilderEscaped)
50−import Data.Time (UTCTime(..))
51−import Data.Time.Calendar (Day(..), toGregorian)
52−import Data.Time.LocalTime
53−import Data.Word (Word8)
54−import qualified Data.HashMap.Strict as HMS
55−import qualified Data.Text as T
56−import qualified Data.Vector as V
57−
58−-- | Encode a JSON value to a "Data.ByteString" 'B.Builder'.
59−--
60−-- Use this function if you are encoding over the wire, or need to
61−-- prepend or append further bytes to the encoded JSON value.
62−encodeToBuilder :: Value -> Builder
63−encodeToBuilder Null = null_
64−encodeToBuilder (Bool b) = bool b
65−encodeToBuilder (Number n) = scientific n
66−encodeToBuilder (String s) = text s
67−encodeToBuilder (Array v) = array v
68−encodeToBuilder (Object m) = object m
69−
70−-- | Encode a JSON null.
71−null_ :: Builder
72−null_ = BP.primBounded (ascii4 ('n',('u',('l','l')))) ()
73−
74−-- | Encode a JSON boolean.
75−bool :: Bool -> Builder
76−bool = BP.primBounded (BP.condB id (ascii4 ('t',('r',('u','e'))))
77− (ascii5 ('f',('a',('l',('s','e'))))))
78−
79−-- | Encode a JSON array.
80−array :: V.Vector Value -> Builder
81−array v
82− | V.null v = emptyArray_
83− | otherwise = B.char8 '[' <>
84− encodeToBuilder (V.unsafeHead v) <>
85− V.foldr withComma (B.char8 ']') (V.unsafeTail v)
86− where
87− withComma a z = B.char8 ',' <> encodeToBuilder a <> z
88−
89−-- Encode a JSON object.
90−object :: HMS.HashMap T.Text Value -> Builder
91−object m = case HMS.toList m of
92− (x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs
93− _ -> emptyObject_
94− where
95− withComma a z = B.char8 ',' <> one a <> z
96− one (k,v) = text k <> B.char8 ':' <> encodeToBuilder v
97−
98−-- | Encode a JSON string.
99−text :: T.Text -> Builder
100−text t = B.char8 '"' <> unquoted t <> B.char8 '"'
101−
102−-- | Encode a JSON string, without enclosing quotes.
103−unquoted :: T.Text -> Builder
104−unquoted = encodeUtf8BuilderEscaped escapeAscii
105−
106−-- | Add quotes surrounding a builder
107−quote :: Builder -> Builder
108−quote b = B.char8 '"' <> b <> B.char8 '"'
109−
110−-- | Encode a JSON string.
111−string :: String -> Builder
112−string t = B.char8 '"' <> BP.primMapListBounded go t <> B.char8 '"'
113− where go = BP.condB (> '\x7f') BP.charUtf8 (c2w >$< escapeAscii)
114−
115−escapeAscii :: BP.BoundedPrim Word8
116−escapeAscii =
117− BP.condB (== c2w '\\' ) (ascii2 ('\\','\\')) $
118− BP.condB (== c2w '\"' ) (ascii2 ('\\','"' )) $
119− BP.condB (>= c2w '\x20') (BP.liftFixedToBounded BP.word8) $
120− BP.condB (== c2w '\n' ) (ascii2 ('\\','n' )) $
121− BP.condB (== c2w '\r' ) (ascii2 ('\\','r' )) $
122− BP.condB (== c2w '\t' ) (ascii2 ('\\','t' )) $
123− BP.liftFixedToBounded hexEscape -- fallback for chars < 0x20
124− where
125− hexEscape :: BP.FixedPrim Word8
126− hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<
127− BP.char8 >*< BP.char8 >*< BP.word16HexFixed
128−{-# INLINE escapeAscii #-}
129−
130−c2w :: Char -> Word8
131−c2w c = fromIntegral (ord c)
132−
133−-- | Encode a JSON number.
134−scientific :: Scientific -> Builder
135−scientific s
136− | e < 0 || e > 1024 = scientificBuilder s
137− | otherwise = B.integerDec (coefficient s * 10 ^ e)
138− where
139− e = base10Exponent s
140−
141−emptyArray_ :: Builder
142−emptyArray_ = BP.primBounded (ascii2 ('[',']')) ()
143−
144−emptyObject_ :: Builder
145−emptyObject_ = BP.primBounded (ascii2 ('{','}')) ()
146−
147−ascii2 :: (Char, Char) -> BP.BoundedPrim a
148−ascii2 cs = BP.liftFixedToBounded $ const cs BP.>$< BP.char7 >*< BP.char7
149−{-# INLINE ascii2 #-}
150−
151−ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a
152−ascii4 cs = BP.liftFixedToBounded $ const cs >$<
153− BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
154−{-# INLINE ascii4 #-}
155−
156−ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a
157−ascii5 cs = BP.liftFixedToBounded $ const cs >$<
158− BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
159−{-# INLINE ascii5 #-}
160−
161−ascii6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BP.BoundedPrim a
162−ascii6 cs = BP.liftFixedToBounded $ const cs >$<
163− BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
164−{-# INLINE ascii6 #-}
165−
166−ascii8 :: (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
167− -> BP.BoundedPrim a
168−ascii8 cs = BP.liftFixedToBounded $ const cs >$<
169− BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*<
170− BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
171−{-# INLINE ascii8 #-}
172−
173−day :: Day -> Builder
174−day dd = encodeYear yr <>
175− BP.primBounded (ascii6 ('-',(mh,(ml,('-',(dh,dl)))))) ()
176− where (yr,m,d) = toGregorian dd
177− !(T mh ml) = twoDigits m
178− !(T dh dl) = twoDigits d
179− encodeYear y
180− | y >= 1000 = B.integerDec y
181− | y >= 0 = BP.primBounded (ascii4 (padYear y)) ()
182− | y >= -999 = BP.primBounded (ascii5 ('-',padYear (- y))) ()
183− | otherwise = B.integerDec y
184− padYear y =
185− let (ab,c) = fromIntegral y `quotRem` 10
186− (a,b) = ab `quotRem` 10
187− in ('0',(digit a,(digit b,digit c)))
188−{-# INLINE day #-}
189−
190−timeOfDay :: TimeOfDay -> Builder
191−timeOfDay t = timeOfDay64 (toTimeOfDay64 t)
192−{-# INLINE timeOfDay #-}
193−
194−timeOfDay64 :: TimeOfDay64 -> Builder
195−timeOfDay64 (TOD h m s)
196− | frac == 0 = hhmmss -- omit subseconds if 0
197− | otherwise = hhmmss <> BP.primBounded showFrac frac
198− where
199− hhmmss = BP.primBounded (ascii8 (hh,(hl,(':',(mh,(ml,(':',(sh,sl)))))))) ()
200− !(T hh hl) = twoDigits h
201− !(T mh ml) = twoDigits m
202− !(T sh sl) = twoDigits (fromIntegral real)
203− (real,frac) = s `quotRem` pico
204− showFrac = ('.',) >$< (BP.liftFixedToBounded BP.char7 >*< trunc12)
205− trunc12 = (`quotRem` micro) >$<
206− BP.condB (\(_,y) -> y == 0) (fst >$< trunc6) (digits6 >*< trunc6)
207− digits6 = ((`quotRem` milli) . fromIntegral) >$< (digits3 >*< digits3)
208− trunc6 = ((`quotRem` milli) . fromIntegral) >$<
209− BP.condB (\(_,y) -> y == 0) (fst >$< trunc3) (digits3 >*< trunc3)
210− digits3 = (`quotRem` 10) >$< (digits2 >*< digits1)
211− digits2 = (`quotRem` 10) >$< (digits1 >*< digits1)
212− digits1 = BP.liftFixedToBounded (digit >$< BP.char7)
213− trunc3 = BP.condB (== 0) BP.emptyB $
214− (`quotRem` 100) >$< (digits1 >*< trunc2)
215− trunc2 = BP.condB (== 0) BP.emptyB $
216− (`quotRem` 10) >$< (digits1 >*< trunc1)
217− trunc1 = BP.condB (== 0) BP.emptyB digits1
218−
219− pico = 1000000000000 -- number of picoseconds in 1 second
220− micro = 1000000 -- number of microseconds in 1 second
221− milli = 1000 -- number of milliseconds in 1 second
222−
223−timeZone :: TimeZone -> Builder
224−timeZone (TimeZone off _ _)
225− | off == 0 = B.char7 'Z'
226− | otherwise = BP.primBounded (ascii6 (s,(hh,(hl,(':',(mh,ml)))))) ()
227− where !s = if off < 0 then '-' else '+'
228− !(T hh hl) = twoDigits h
229− !(T mh ml) = twoDigits m
230− (h,m) = abs off `quotRem` 60
231−{-# INLINE timeZone #-}
232−
233−dayTime :: Day -> TimeOfDay64 -> Builder
234−dayTime d t = day d <> B.char7 'T' <> timeOfDay64 t
235−{-# INLINE dayTime #-}
236−
237−utcTime :: UTCTime -> B.Builder
238−utcTime (UTCTime d s) = dayTime d (diffTimeOfDay64 s) <> B.char7 'Z'
239−{-# INLINE utcTime #-}
240−
241−localTime :: LocalTime -> Builder
242−localTime (LocalTime d t) = dayTime d (toTimeOfDay64 t)
243−{-# INLINE localTime #-}
244−
245−zonedTime :: ZonedTime -> Builder
246−zonedTime (ZonedTime t z) = localTime t <> timeZone z
247−{-# INLINE zonedTime #-}
248−
249−data T = T {-# UNPACK #-} !Char {-# UNPACK #-} !Char
250−
251−twoDigits :: Int -> T
252−twoDigits a = T (digit hi) (digit lo)
253− where (hi,lo) = a `quotRem` 10
254−
255−digit :: Int -> Char
256−digit x = chr (x + 48)
Data/Aeson/Encoding/Internal.hsdeleted−371
@@ -1,371 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE EmptyDataDecls #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE RankNTypes #-}
6−
7−module Data.Aeson.Encoding.Internal
8− (
9− -- * Encoding
10− Encoding' (..)
11− , Encoding
12− , encodingToLazyByteString
13− , unsafeToEncoding
14− , retagEncoding
15− , Series (..)
16− , pairs
17− , pair
18− , pairStr
19− , pair'
20− -- * Predicates
21− , nullEncoding
22− -- * Encoding constructors
23− , emptyArray_
24− , emptyObject_
25− , wrapObject
26− , wrapArray
27− , null_
28− , bool
29− , text
30− , lazyText
31− , string
32− , list
33− , dict
34− , tuple
35− , (>*<)
36− , InArray
37− , empty
38− , (><)
39− , econcat
40− -- ** Decimal numbers
41− , int8, int16, int32, int64, int
42− , word8, word16, word32, word64, word
43− , integer, float, double, scientific
44− -- ** Decimal numbers as Text
45− , int8Text, int16Text, int32Text, int64Text, intText
46− , word8Text, word16Text, word32Text, word64Text, wordText
47− , integerText, floatText, doubleText, scientificText
48− -- ** Time
49− , day
50− , localTime
51− , utcTime
52− , timeOfDay
53− , zonedTime
54− -- ** value
55− , value
56− -- ** JSON tokens
57− , comma, colon, openBracket, closeBracket, openCurly, closeCurly
58− ) where
59−
60−import Prelude.Compat
61−
62−import Data.Aeson.Types.Internal (Value)
63−import Data.ByteString.Builder (Builder, char7, toLazyByteString)
64−import Data.Int
65−import Data.Scientific (Scientific)
66−import Data.Semigroup (Semigroup ((<>)))
67−import Data.Text (Text)
68−import Data.Time (Day, LocalTime, TimeOfDay, UTCTime, ZonedTime)
69−import Data.Typeable (Typeable)
70−import Data.Word
71−import qualified Data.Aeson.Encoding.Builder as EB
72−import qualified Data.ByteString.Builder as B
73−import qualified Data.ByteString.Lazy as BSL
74−import qualified Data.Text.Lazy as LT
75−
76−-- | An encoding of a JSON value.
77−--
78−-- @tag@ represents which kind of JSON the Encoding is encoding to,
79−-- we reuse 'Text' and 'Value' as tags here.
80−newtype Encoding' tag = Encoding {
81− fromEncoding :: Builder
82− -- ^ Acquire the underlying bytestring builder.
83− } deriving (Typeable)
84−
85−-- | Often used synonym for 'Encoding''.
86−type Encoding = Encoding' Value
87−
88−-- | Make Encoding from Builder.
89−--
90−-- Use with care! You have to make sure that the passed Builder
91−-- is a valid JSON Encoding!
92−unsafeToEncoding :: Builder -> Encoding' a
93−unsafeToEncoding = Encoding
94−
95−encodingToLazyByteString :: Encoding' a -> BSL.ByteString
96−encodingToLazyByteString = toLazyByteString . fromEncoding
97−{-# INLINE encodingToLazyByteString #-}
98−
99−retagEncoding :: Encoding' a -> Encoding' b
100−retagEncoding = Encoding . fromEncoding
101−
102−-------------------------------------------------------------------------------
103−-- Encoding instances
104−-------------------------------------------------------------------------------
105−
106−instance Show (Encoding' a) where
107− show (Encoding e) = show (toLazyByteString e)
108−
109−instance Eq (Encoding' a) where
110− Encoding a == Encoding b = toLazyByteString a == toLazyByteString b
111−
112−instance Ord (Encoding' a) where
113− compare (Encoding a) (Encoding b) =
114− compare (toLazyByteString a) (toLazyByteString b)
115−
116−-- | A series of values that, when encoded, should be separated by
117−-- commas. Since 0.11.0.0, the '.=' operator is overloaded to create
118−-- either @(Text, Value)@ or 'Series'. You can use Series when
119−-- encoding directly to a bytestring builder as in the following
120−-- example:
121−--
122−-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
123−data Series = Empty
124− | Value (Encoding' Series)
125− deriving (Typeable)
126−
127−pair :: Text -> Encoding -> Series
128−pair name val = pair' (text name) val
129−{-# INLINE pair #-}
130−
131−pairStr :: String -> Encoding -> Series
132−pairStr name val = pair' (string name) val
133−{-# INLINE pairStr #-}
134−
135−pair' :: Encoding' Text -> Encoding -> Series
136−pair' name val = Value $ retagEncoding $ retagEncoding name >< colon >< val
137−
138−instance Semigroup Series where
139− Empty <> a = a
140− a <> Empty = a
141− Value a <> Value b = Value (a >< comma >< b)
142−
143−instance Monoid Series where
144− mempty = Empty
145− mappend = (<>)
146−
147−nullEncoding :: Encoding' a -> Bool
148−nullEncoding = BSL.null . toLazyByteString . fromEncoding
149−
150−emptyArray_ :: Encoding
151−emptyArray_ = Encoding EB.emptyArray_
152−
153−emptyObject_ :: Encoding
154−emptyObject_ = Encoding EB.emptyObject_
155−
156−wrapArray :: Encoding' a -> Encoding
157−wrapArray e = retagEncoding $ openBracket >< e >< closeBracket
158−
159−wrapObject :: Encoding' a -> Encoding
160−wrapObject e = retagEncoding $ openCurly >< e >< closeCurly
161−
162−null_ :: Encoding
163−null_ = Encoding EB.null_
164−
165−bool :: Bool -> Encoding
166−bool True = Encoding "true"
167−bool False = Encoding "false"
168−
169−-- | Encode a series of key/value pairs, separated by commas.
170−pairs :: Series -> Encoding
171−pairs (Value v) = openCurly >< retagEncoding v >< closeCurly
172−pairs Empty = emptyObject_
173−{-# INLINE pairs #-}
174−
175−list :: (a -> Encoding) -> [a] -> Encoding
176−list _ [] = emptyArray_
177−list to' (x:xs) = openBracket >< to' x >< commas xs >< closeBracket
178− where
179− commas = foldr (\v vs -> comma >< to' v >< vs) empty
180−{-# INLINE list #-}
181−
182−-- | Encode as JSON object
183−dict
184− :: (k -> Encoding' Text) -- ^ key encoding
185− -> (v -> Encoding) -- ^ value encoding
186− -> (forall a. (k -> v -> a -> a) -> a -> m -> a) -- ^ @foldrWithKey@ - indexed fold
187− -> m -- ^ container
188− -> Encoding
189−dict encodeKey encodeVal foldrWithKey = pairs . foldrWithKey go mempty
190− where
191− go k v c = Value (encodeKV k v) <> c
192− encodeKV k v = retagEncoding (encodeKey k) >< colon >< retagEncoding (encodeVal v)
193−{-# INLINE dict #-}
194−
195−-- | Type tag for tuples contents, see 'tuple'.
196−data InArray
197−
198−infixr 6 >*<
199−-- | See 'tuple'.
200−(>*<) :: Encoding' a -> Encoding' b -> Encoding' InArray
201−a >*< b = retagEncoding a >< comma >< retagEncoding b
202−{-# INLINE (>*<) #-}
203−
204−empty :: Encoding' a
205−empty = Encoding mempty
206−
207−econcat :: [Encoding' a] -> Encoding' a
208−econcat = foldr (><) empty
209−
210−infixr 6 ><
211−(><) :: Encoding' a -> Encoding' a -> Encoding' a
212−Encoding a >< Encoding b = Encoding (a <> b)
213−{-# INLINE (><) #-}
214−
215−-- | Encode as a tuple.
216−--
217−-- @
218−-- toEncoding (X a b c) = tuple $
219−-- toEncoding a >*<
220−-- toEncoding b >*<
221−-- toEncoding c
222−tuple :: Encoding' InArray -> Encoding
223−tuple b = retagEncoding $ openBracket >< b >< closeBracket
224−{-# INLINE tuple #-}
225−
226−text :: Text -> Encoding' a
227−text = Encoding . EB.text
228−
229−lazyText :: LT.Text -> Encoding' a
230−lazyText t = Encoding $
231− B.char7 '"' <>
232− LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t
233−
234−string :: String -> Encoding' a
235−string = Encoding . EB.string
236−
237−-------------------------------------------------------------------------------
238−-- chars
239−-------------------------------------------------------------------------------
240−
241−comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding' a
242−comma = Encoding $ char7 ','
243−colon = Encoding $ char7 ':'
244−openBracket = Encoding $ char7 '['
245−closeBracket = Encoding $ char7 ']'
246−openCurly = Encoding $ char7 '{'
247−closeCurly = Encoding $ char7 '}'
248−
249−-------------------------------------------------------------------------------
250−-- Decimal numbers
251−-------------------------------------------------------------------------------
252−
253−int8 :: Int8 -> Encoding
254−int8 = Encoding . B.int8Dec
255−
256−int16 :: Int16 -> Encoding
257−int16 = Encoding . B.int16Dec
258−
259−int32 :: Int32 -> Encoding
260−int32 = Encoding . B.int32Dec
261−
262−int64 :: Int64 -> Encoding
263−int64 = Encoding . B.int64Dec
264−
265−int :: Int -> Encoding
266−int = Encoding . B.intDec
267−
268−word8 :: Word8 -> Encoding
269−word8 = Encoding . B.word8Dec
270−
271−word16 :: Word16 -> Encoding
272−word16 = Encoding . B.word16Dec
273−
274−word32 :: Word32 -> Encoding
275−word32 = Encoding . B.word32Dec
276−
277−word64 :: Word64 -> Encoding
278−word64 = Encoding . B.word64Dec
279−
280−word :: Word -> Encoding
281−word = Encoding . B.wordDec
282−
283−integer :: Integer -> Encoding
284−integer = Encoding . B.integerDec
285−
286−float :: Float -> Encoding
287−float = realFloatToEncoding $ Encoding . B.floatDec
288−
289−double :: Double -> Encoding
290−double = realFloatToEncoding $ Encoding . B.doubleDec
291−
292−scientific :: Scientific -> Encoding
293−scientific = Encoding . EB.scientific
294−
295−realFloatToEncoding :: RealFloat a => (a -> Encoding) -> a -> Encoding
296−realFloatToEncoding e d
297− | isNaN d || isInfinite d = null_
298− | otherwise = e d
299−{-# INLINE realFloatToEncoding #-}
300−
301−-------------------------------------------------------------------------------
302−-- Decimal numbers as Text
303−-------------------------------------------------------------------------------
304−
305−int8Text :: Int8 -> Encoding' a
306−int8Text = Encoding . EB.quote . B.int8Dec
307−
308−int16Text :: Int16 -> Encoding' a
309−int16Text = Encoding . EB.quote . B.int16Dec
310−
311−int32Text :: Int32 -> Encoding' a
312−int32Text = Encoding . EB.quote . B.int32Dec
313−
314−int64Text :: Int64 -> Encoding' a
315−int64Text = Encoding . EB.quote . B.int64Dec
316−
317−intText :: Int -> Encoding' a
318−intText = Encoding . EB.quote . B.intDec
319−
320−word8Text :: Word8 -> Encoding' a
321−word8Text = Encoding . EB.quote . B.word8Dec
322−
323−word16Text :: Word16 -> Encoding' a
324−word16Text = Encoding . EB.quote . B.word16Dec
325−
326−word32Text :: Word32 -> Encoding' a
327−word32Text = Encoding . EB.quote . B.word32Dec
328−
329−word64Text :: Word64 -> Encoding' a
330−word64Text = Encoding . EB.quote . B.word64Dec
331−
332−wordText :: Word -> Encoding' a
333−wordText = Encoding . EB.quote . B.wordDec
334−
335−integerText :: Integer -> Encoding' a
336−integerText = Encoding . EB.quote . B.integerDec
337−
338−floatText :: Float -> Encoding' a
339−floatText = Encoding . EB.quote . B.floatDec
340−
341−doubleText :: Double -> Encoding' a
342−doubleText = Encoding . EB.quote . B.doubleDec
343−
344−scientificText :: Scientific -> Encoding' a
345−scientificText = Encoding . EB.quote . EB.scientific
346−
347−-------------------------------------------------------------------------------
348−-- time
349−-------------------------------------------------------------------------------
350−
351−day :: Day -> Encoding' a
352−day = Encoding . EB.quote . EB.day
353−
354−localTime :: LocalTime -> Encoding' a
355−localTime = Encoding . EB.quote . EB.localTime
356−
357−utcTime :: UTCTime -> Encoding' a
358−utcTime = Encoding . EB.quote . EB.utcTime
359−
360−timeOfDay :: TimeOfDay -> Encoding' a
361−timeOfDay = Encoding . EB.quote . EB.timeOfDay
362−
363−zonedTime :: ZonedTime -> Encoding' a
364−zonedTime = Encoding . EB.quote . EB.zonedTime
365−
366−-------------------------------------------------------------------------------
367−-- Value
368−-------------------------------------------------------------------------------
369−
370−value :: Value -> Encoding
371−value = Encoding . EB.encodeToBuilder
Data/Aeson/Internal/Functions.hs → Data/Aeson/Functions.hsrenamed+11−8
@@ -1,22 +1,19 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2-- |
1-- |
3-- Module: Data.Aeson.Functions
2-- Module: Data.Aeson.Functions
4−-- Copyright: (c) 2011-2016 Bryan O'Sullivan
3+-- Copyright: (c) 2011, 2012 Bryan O'Sullivan
5-- (c) 2011 MailRank, Inc.
4-- (c) 2011 MailRank, Inc.
6−-- License: BSD3
5+-- License: Apache
7-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Stability: experimental
7-- Stability: experimental
9-- Portability: portable
8-- Portability: portable
10
9
11−module Data.Aeson.Internal.Functions
10+module Data.Aeson.Functions
12− (
13− mapHashKeyVal
11+ ( mapHashKeyVal
12+ , hashMapKey
14 , mapKeyVal
13 , mapKeyVal
15 , mapKey
14 , mapKey
16 ) where
15 ) where
17
16
18−import Prelude.Compat
19−
20import Data.Hashable (Hashable)
17import Data.Hashable (Hashable)
21import qualified Data.HashMap.Strict as H
18import qualified Data.HashMap.Strict as H
22import qualified Data.Map as M
19import qualified Data.Map as M
@@ -27,6 +24,12 @@ mapHashKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
27mapHashKeyVal fk kv = M.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty
24mapHashKeyVal fk kv = M.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty
28{-# INLINE mapHashKeyVal #-}
25{-# INLINE mapHashKeyVal #-}
29
26
27+-- | Transform a 'M.Map' into a 'H.HashMap' while transforming the keys.
28+hashMapKey :: (Ord k2) => (k1 -> k2)
29+ -> H.HashMap k1 v -> M.Map k2 v
30+hashMapKey kv = H.foldrWithKey (M.insert . kv) M.empty
31+{-# INLINE hashMapKey #-}
32+
30-- | Transform the keys and values of a 'H.HashMap'.
33-- | Transform the keys and values of a 'H.HashMap'.
31mapKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
34mapKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
32 -> H.HashMap k1 v1 -> H.HashMap k2 v2
35 -> H.HashMap k1 v1 -> H.HashMap k2 v2
Data/Aeson/Internal.hsdeleted−28
@@ -1,28 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−-- |
3−-- Module: Data.Aeson.Internal
4−-- Copyright: (c) 2015-2016 Bryan O'Sullivan
5−-- License: BSD3
6−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
7−-- Stability: experimental
8−-- Portability: portable
9−--
10−-- Internal types and functions.
11−--
12−-- __Note__: all declarations in this module are unstable, and prone
13−-- to being changed at any time.
14−
15−module Data.Aeson.Internal
16− (
17− IResult(..)
18− , JSONPathElement(..)
19− , JSONPath
20− , (<?>)
21− , formatError
22− , ifromJSON
23− , iparse
24− ) where
25−
26−
27−import Data.Aeson.Types.Internal
28−import Data.Aeson.Types.FromJSON (ifromJSON)
Data/Aeson/Internal/Time.hsdeleted−20
@@ -1,20 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−-- |
4−-- Module: Data.Aeson.Internal.Time
5−-- Copyright: (c) 2015-2016 Bryan O'Sullivan
6−-- License: BSD3
7−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8−-- Stability: experimental
9−-- Portability: portable
10−
11−module Data.Aeson.Internal.Time
12− (
13− TimeOfDay64(..)
14− , fromPico
15− , toPico
16− , diffTimeOfDay64
17− , toTimeOfDay64
18− ) where
19−
20−import Data.Attoparsec.Time.Internal
Data/Aeson/Parser.hs+5−21
@@ -1,9 +1,10 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2+
2-- |
3-- |
3-- Module: Data.Aeson.Parser
4-- Module: Data.Aeson.Parser
4−-- Copyright: (c) 2012-2016 Bryan O'Sullivan
5+-- Copyright: (c) 2012 Bryan O'Sullivan
5-- (c) 2011 MailRank, Inc.
6-- (c) 2011 MailRank, Inc.
6−-- License: BSD3
7+-- License: Apache
7-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Stability: experimental
9-- Stability: experimental
9-- Portability: portable
10-- Portability: portable
@@ -34,30 +35,13 @@ module Data.Aeson.Parser
34 json
35 json
35 , value
36 , value
36 , jstring
37 , jstring
37− , scientific
38− -- ** Handling objects with duplicate keys
39− , jsonWith
40− , jsonLast
41− , jsonAccum
42− , jsonNoDup
43 -- * Strict parsers
38 -- * Strict parsers
44 -- $strict
39 -- $strict
45 , json'
40 , json'
46 , value'
41 , value'
47− -- ** Handling objects with duplicate keys
48− , jsonWith'
49− , jsonLast'
50− , jsonAccum'
51− , jsonNoDup'
52− -- * Decoding without FromJSON instances
53− , decodeWith
54− , decodeStrictWith
55− , eitherDecodeWith
56− , eitherDecodeStrictWith
57 ) where
42 ) where
58
43
59−
60−import Data.Aeson.Parser.Internal
44+import Data.Aeson.Parser.Internal (json, json', jstring, value, value')
61
45
62-- $lazy
46-- $lazy
63--
47--
Data/Aeson/Parser/Internal.hs+200−362
@@ -1,19 +1,10 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}
2−{-# LANGUAGE CPP #-}
2+
3−{-# LANGUAGE NoImplicitPrelude #-}
4−{-# LANGUAGE OverloadedStrings #-}
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
12-- |
3-- |
13-- Module: Data.Aeson.Parser.Internal
4-- Module: Data.Aeson.Parser.Internal
14−-- Copyright: (c) 2011-2016 Bryan O'Sullivan
5+-- Copyright: (c) 2011, 2012 Bryan O'Sullivan
15-- (c) 2011 MailRank, Inc.
6-- (c) 2011 MailRank, Inc.
16−-- License: BSD3
7+-- License: Apache
17-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
18-- Stability: experimental
9-- Stability: experimental
19-- Portability: portable
10-- Portability: portable
@@ -25,57 +16,45 @@ module Data.Aeson.Parser.Internal
25 (
16 (
26 -- * Lazy parsers
17 -- * Lazy parsers
27 json, jsonEOF
18 json, jsonEOF
28− , jsonWith
29− , jsonLast
30− , jsonAccum
31− , jsonNoDup
32 , value
19 , value
33 , jstring
20 , jstring
34− , jstring_
35− , scientific
36 -- * Strict parsers
21 -- * Strict parsers
37 , json', jsonEOF'
22 , json', jsonEOF'
38− , jsonWith'
39− , jsonLast'
40− , jsonAccum'
41− , jsonNoDup'
42 , value'
23 , value'
43 -- * Helpers
24 -- * Helpers
44 , decodeWith
25 , decodeWith
45 , decodeStrictWith
26 , decodeStrictWith
46 , eitherDecodeWith
27 , eitherDecodeWith
47 , eitherDecodeStrictWith
28 , eitherDecodeStrictWith
48− -- ** Handling objects with duplicate keys
49− , fromListAccum
50− , parseListNoDup
51 ) where
29 ) where
52
30
53−import Prelude.Compat
54−
55−import Control.Applicative ((<|>))
31+import Control.Applicative ((*>), (<$>), (<*), liftA2, pure)
56−import Control.Monad (void, when)
32+import Control.Monad.IO.Class (liftIO)
57−import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Value(..))
33+import Data.Aeson.Types (Result(..), Value(..))
58−import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
34+import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,
35+ skipSpace, string)
59−import Data.Function (fix)
36+import Data.Bits ((.|.), shiftL)
60−import Data.Functor.Compat (($>))
37+import Data.ByteString.Internal (ByteString(..))
61−import Data.Scientific (Scientific)
38+import Data.Char (chr)
62import Data.Text (Text)
39import Data.Text (Text)
63−import Data.Vector (Vector)
40+import Data.Text.Encoding (decodeUtf8')
41+import Data.Text.Internal.Encoding.Utf8 (ord2, ord3, ord4)
42+import Data.Text.Internal.Unsafe.Char (ord)
64−import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
43+import Data.Vector as Vector (Vector, fromList)
44+import Data.Word (Word8)
45+import Foreign.ForeignPtr (withForeignPtr)
46+import Foreign.Ptr (minusPtr)
47+import Foreign.Ptr (Ptr, plusPtr)
48+import Foreign.Storable (poke)
49+import System.IO.Unsafe (unsafePerformIO)
65import qualified Data.Attoparsec.ByteString as A
50import qualified Data.Attoparsec.ByteString as A
66import qualified Data.Attoparsec.Lazy as L
51import qualified Data.Attoparsec.Lazy as L
52+import qualified Data.Attoparsec.Zepto as Z
67import qualified Data.ByteString as B
53import qualified Data.ByteString as B
68−import qualified Data.ByteString.Unsafe as B
69import qualified Data.ByteString.Lazy as L
54import qualified Data.ByteString.Lazy as L
55+import qualified Data.ByteString.Internal as B
56+import qualified Data.ByteString.Unsafe as B
70import qualified Data.HashMap.Strict as H
57import qualified Data.HashMap.Strict as H
71−import qualified Data.Scientific as Sci
72−import Data.Aeson.Parser.Unescape (unescapeText)
73−
74−#if MIN_VERSION_ghc_prim(0,3,1)
75−import GHC.Base (Int#, (==#), isTrue#, word2Int#, orI#, andI#)
76−import GHC.Word (Word8(W8#))
77−import qualified Data.Text.Encoding as TE
78−#endif
79
58
80#define BACKSLASH 92
59#define BACKSLASH 92
81#define CLOSE_CURLY 125
60#define CLOSE_CURLY 125
@@ -93,7 +72,7 @@ import qualified Data.Text.Encoding as TE
93#define C_n 110
72#define C_n 110
94#define C_t 116
73#define C_t 116
95
74
96−-- | Parse any JSON value.
75+-- | Parse a top-level JSON value.
97--
76--
98-- The conversion of a parsed value to a Haskell value is deferred
77-- The conversion of a parsed value to a Haskell value is deferred
99-- until the Haskell value is needed. This may improve performance if
78-- until the Haskell value is needed. This may improve performance if
@@ -103,15 +82,10 @@ import qualified Data.Text.Encoding as TE
103-- This function is an alias for 'value'. In aeson 0.8 and earlier, it
82-- This function is an alias for 'value'. In aeson 0.8 and earlier, it
104-- parsed only object or array types, in conformance with the
83-- parsed only object or array types, in conformance with the
105-- now-obsolete RFC 4627.
84-- 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'.
111json :: Parser Value
85json :: Parser Value
112json = value
86json = value
113
87
114−-- | Parse any JSON value.
88+-- | Parse a top-level JSON value.
115--
89--
116-- This is a strict version of 'json' which avoids building up thunks
90-- This is a strict version of 'json' which avoids building up thunks
117-- during parsing; it performs all conversions immediately. Prefer
91-- during parsing; it performs all conversions immediately. Prefer
@@ -120,201 +94,101 @@ json = value
120-- This function is an alias for 'value''. In aeson 0.8 and earlier, it
94-- This function is an alias for 'value''. In aeson 0.8 and earlier, it
121-- parsed only object or array types, in conformance with the
95-- parsed only object or array types, in conformance with the
122-- now-obsolete RFC 4627.
96-- 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''.
128json' :: Parser Value
97json' :: Parser Value
129json' = value'
98json' = value'
130
99
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−
135−object_ :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value
100+object_ :: Parser Value
136−object_ mkObject val = {-# SCC "object_" #-} Object <$> objectValues mkObject jstring val
101+object_ = {-# SCC "object_" #-} Object <$> objectValues jstring value
137−{-# INLINE object_ #-}
138
102
139−object_' :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value
103+object_' :: Parser Value
140−object_' mkObject val' = {-# SCC "object_'" #-} do
104+object_' = {-# SCC "object_'" #-} do
141− !vals <- objectValues mkObject jstring' val'
105+ !vals <- objectValues jstring' value'
142 return (Object vals)
106 return (Object vals)
143 where
107 where
144 jstring' = do
108 jstring' = do
145 !s <- jstring
109 !s <- jstring
146 return s
110 return s
147−{-# INLINE object_' #-}
148
111
149−objectValues :: ([(Text, Value)] -> Either String Object)
150− -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)
112+objectValues :: Parser Text -> Parser Value -> Parser (H.HashMap Text Value)
151−objectValues mkObject str val = do
113+objectValues str val = do
152 skipSpace
114 skipSpace
153− w <- A.peekWord8'
154− if w == CLOSE_CURLY
155− then A.anyWord8 >> return H.empty
156− else loop []
157− where
158− -- Why use acc pattern here, you may ask? because 'H.fromList' use 'unsafeInsert'
159− -- and it's much faster because it's doing in place update to the 'HashMap'!
160− loop acc = do
161− k <- (str A.<?> "object key") <* skipSpace <* (char ':' A.<?> "':'")
115+ let pair = liftA2 (,) (str <* skipSpace) (char ':' *> val)
162− v <- (val A.<?> "object value") <* skipSpace
116+ H.fromList <$> commaSeparated pair CLOSE_CURLY
163− ch <- A.satisfy (\w -> w == COMMA || w == CLOSE_CURLY) A.<?> "',' or '}'"
164− let acc' = (k, v) : acc
165− if ch == COMMA
166− then skipSpace >> loop acc'
167− else case mkObject acc' of
168− Left err -> fail err
169− Right obj -> pure obj
170{-# INLINE objectValues #-}
117{-# INLINE objectValues #-}
171
118
172−array_ :: Parser Value -> Parser Value
119+array_ :: Parser Value
173−array_ val = {-# SCC "array_" #-} Array <$> arrayValues val
120+array_ = {-# SCC "array_" #-} Array <$> arrayValues value
174−{-# INLINE array_ #-}
175
121
176−array_' :: Parser Value -> Parser Value
122+array_' :: Parser Value
177−array_' val = {-# SCC "array_'" #-} do
123+array_' = {-# SCC "array_'" #-} do
178− !vals <- arrayValues val
124+ !vals <- arrayValues value'
179 return (Array vals)
125 return (Array vals)
180−{-# INLINE array_' #-}
181
126
182−arrayValues :: Parser Value -> Parser (Vector Value)
127+commaSeparated :: Parser a -> Word8 -> Parser [a]
183−arrayValues val = do
128+commaSeparated item endByte = do
184− skipSpace
185 w <- A.peekWord8'
129 w <- A.peekWord8'
186− if w == CLOSE_SQUARE
130+ if w == endByte
187− then A.anyWord8 >> return Vector.empty
131+ then A.anyWord8 >> return []
188− else loop [] 1
132+ else loop
189 where
133 where
190− loop acc !len = do
134+ loop = do
191− v <- (val A.<?> "json list value") <* skipSpace
135+ v <- item <* skipSpace
192− ch <- A.satisfy (\w -> w == COMMA || w == CLOSE_SQUARE) A.<?> "',' or ']'"
136+ ch <- A.satisfy $ \w -> w == COMMA || w == endByte
193 if ch == COMMA
137 if ch == COMMA
194− then skipSpace >> loop (v:acc) (len+1)
138+ then skipSpace >> (v:) <$> loop
195− else return (Vector.reverse (Vector.fromListN len (v:acc)))
139+ else return [v]
196−{-# INLINE arrayValues #-}
140+{-# INLINE commaSeparated #-}
197
141
198−-- | Parse any JSON value. Synonym of 'json'.
199−value :: Parser Value
142+arrayValues :: Parser Value -> Parser (Vector Value)
200−value = jsonWith (pure . H.fromList)
143+arrayValues val = do
144+ skipSpace
145+ Vector.fromList <$> commaSeparated val CLOSE_SQUARE
146+{-# INLINE arrayValues #-}
201
147
202−-- | Parse any JSON value.
148+-- | Parse any JSON value. You should usually 'json' in preference to
203−--
149+-- this function, as this function relaxes the object-or-array
204−-- This parser is parameterized by a function to construct an 'Object'
150+-- requirement of RFC 4627.
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--
151--
219−-- @
152+-- In particular, be careful in using this function if you think your
220−-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))
153+-- code might interoperate with Javascript. A na&#xef;ve Javascript
221−-- @
154+-- library that parses JSON data using @eval@ is vulnerable to attack
222−--
155+-- unless the encoded data represents an object or an array. JSON
223−-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using
156+-- implementations in other languages conform to that same restriction
224−-- 'fromListAccum'.
157+-- to preserve interoperability and security.
225−--
158+value :: Parser Value
226−-- @
159+value = do
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
237 skipSpace
160 skipSpace
238 w <- A.peekWord8'
161 w <- A.peekWord8'
239 case w of
162 case w of
240 DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_)
163 DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_)
241− OPEN_CURLY -> A.anyWord8 *> object_ mkObject value_
164+ OPEN_CURLY -> A.anyWord8 *> object_
242− OPEN_SQUARE -> A.anyWord8 *> array_ value_
165+ OPEN_SQUARE -> A.anyWord8 *> array_
243− C_f -> string "false" $> Bool False
166+ C_f -> string "false" *> pure (Bool False)
244− C_t -> string "true" $> Bool True
167+ C_t -> string "true" *> pure (Bool True)
245− C_n -> string "null" $> Null
168+ C_n -> string "null" *> pure Null
246 _ | w >= 48 && w <= 57 || w == 45
169 _ | w >= 48 && w <= 57 || w == 45
247 -> Number <$> scientific
170 -> Number <$> scientific
248 | otherwise -> fail "not a valid json value"
171 | 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
172
260−-- | Variant of 'json' which fails if any object contains duplicate keys.
261−jsonNoDup :: Parser Value
262−jsonNoDup = jsonWith parseListNoDup
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−
281−-- | Strict version of 'value'. Synonym of 'json''.
173+-- | Strict version of 'value'. See also 'json''.
282value' :: Parser Value
174value' :: Parser Value
283−value' = jsonWith' (pure . H.fromList)
175+value' = do
284−
285−-- | Strict version of 'jsonWith'.
286−jsonWith' :: ([(Text, Value)] -> Either String Object) -> Parser Value
287−jsonWith' mkObject = fix $ \value_ -> do
288 skipSpace
176 skipSpace
289 w <- A.peekWord8'
177 w <- A.peekWord8'
290 case w of
178 case w of
291 DOUBLE_QUOTE -> do
179 DOUBLE_QUOTE -> do
292 !s <- A.anyWord8 *> jstring_
180 !s <- A.anyWord8 *> jstring_
293 return (String s)
181 return (String s)
294− OPEN_CURLY -> A.anyWord8 *> object_' mkObject value_
182+ OPEN_CURLY -> A.anyWord8 *> object_'
295− OPEN_SQUARE -> A.anyWord8 *> array_' value_
183+ OPEN_SQUARE -> A.anyWord8 *> array_'
296− C_f -> string "false" $> Bool False
184+ C_f -> string "false" *> pure (Bool False)
297− C_t -> string "true" $> Bool True
185+ C_t -> string "true" *> pure (Bool True)
298− C_n -> string "null" $> Null
186+ C_n -> string "null" *> pure Null
299 _ | w >= 48 && w <= 57 || w == 45
187 _ | w >= 48 && w <= 57 || w == 45
300 -> do
188 -> do
301 !n <- scientific
189 !n <- scientific
302 return (Number n)
190 return (Number n)
303 | otherwise -> fail "not a valid json value"
191 | 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
318
192
319-- | Parse a quoted JSON string.
193-- | Parse a quoted JSON string.
320jstring :: Parser Text
194jstring :: Parser Text
@@ -322,49 +196,84 @@ jstring = A.word8 DOUBLE_QUOTE *> jstring_
322
196
323-- | Parse a string without a leading quote.
197-- | Parse a string without a leading quote.
324jstring_ :: Parser Text
198jstring_ :: Parser Text
325−{-# INLINE jstring_ #-}
326jstring_ = {-# SCC "jstring_" #-} do
199jstring_ = {-# SCC "jstring_" #-} do
327−#if MIN_VERSION_ghc_prim(0,3,1)
200+ s <- A.scan False $ \s c -> if s then Just False
328− (s, S _ escaped) <- A.runScanner startState go <* A.anyWord8
201+ else if c == DOUBLE_QUOTE
329− -- We escape only if there are
202+ then Nothing
330− -- non-ascii (over 7bit) characters or backslash present.
203+ else Just (c == BACKSLASH)
331− --
204+ _ <- A.word8 DOUBLE_QUOTE
332− -- Note: if/when text will have fast ascii -> text conversion
205+ s1 <- if BACKSLASH `B.elem` s
333− -- (e.g. uses utf8 encoding) we can have further speedup.
206+ then case unescape s of
334− if isTrue# escaped
207+ Right r -> return r
335− then case unescapeText s of
208+ Left err -> fail err
209+ else return s
210+
211+ case decodeUtf8' s1 of
336 Right r -> return r
212 Right r -> return r
337 Left err -> fail $ show err
213 Left err -> fail $ show err
338− else return (TE.decodeUtf8 s)
214+
339− where
215+{-# INLINE jstring_ #-}
340− startState = S 0# 0#
216+
341− go (S skip escaped) (W8# c)
217+unescape :: ByteString -> Either String ByteString
342− | isTrue# skip = Just (S 0# escaped')
218+unescape s = unsafePerformIO $ do
343− | isTrue# (w ==# 34#) = Nothing -- double quote
219+ let len = B.length s
344− | otherwise = Just (S skip' escaped')
220+ fp <- B.mallocByteString len
345− where
221+ -- We perform no bounds checking when writing to the destination
346− w = word2Int# c
222+ -- string, as unescaping always makes it shorter than the source.
347− skip' = w ==# 92# -- backslash
223+ withForeignPtr fp $ \ptr -> do
348− escaped' = escaped
224+ ret <- Z.parseT (go ptr) s
349− `orI#` (w `andI#` 0x80# ==# 0x80#) -- c >= 0x80
350− `orI#` skip'
351− `orI#` (w `andI#` 0x1f# ==# w) -- c < 0x20
352−
353−data S = S Int# Int#
354−#else
355− s <- A.scan startState go <* A.anyWord8
356− case unescapeText s of
225+ case ret of
357− Right r -> return r
226+ Left err -> return (Left err)
358− Left err -> fail $ show err
227+ Right p -> do
228+ let newlen = p `minusPtr` ptr
229+ slop = len - newlen
230+ Right <$> if slop >= 128 && slop >= len `quot` 4
231+ then B.create newlen $ \np -> B.memcpy np ptr newlen
232+ else return (PS fp 0 newlen)
359 where
233 where
360− startState = False
234+ go ptr = do
361− go a c
235+ h <- Z.takeWhile (/=BACKSLASH)
362− | a = Just False
236+ let rest = do
363− | c == DOUBLE_QUOTE = Nothing
237+ start <- Z.take 2
364− | otherwise = let a' = c == backslash
238+ let !slash = B.unsafeHead start
365− in Just a'
239+ !t = B.unsafeIndex start 1
366− where backslash = BACKSLASH
240+ escape = case B.elemIndex t "\"\\/ntbrfu" of
367−#endif
241+ Just i -> i
242+ _ -> 255
243+ if slash /= BACKSLASH || escape == 255
244+ then fail "invalid JSON escape sequence"
245+ else
246+ if t /= 117 -- 'u'
247+ then copy h ptr >>= word8 (B.unsafeIndex mapping escape) >>= go
248+ else do
249+ a <- hexQuad
250+ if a < 0xd800 || a > 0xdfff
251+ then copy h ptr >>= charUtf8 (chr a) >>= go
252+ else do
253+ b <- Z.string "\\u" *> hexQuad
254+ if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
255+ then let !c = ((a - 0xd800) `shiftL` 10) +
256+ (b - 0xdc00) + 0x10000
257+ in copy h ptr >>= charUtf8 (chr c) >>= go
258+ else fail "invalid UTF-16 surrogates"
259+ done <- Z.atEnd
260+ if done
261+ then copy h ptr
262+ else rest
263+ mapping = "\"\\/\n\t\b\r\f"
264+
265+hexQuad :: Z.ZeptoT IO Int
266+hexQuad = do
267+ s <- Z.take 4
268+ let hex n | w >= C_0 && w <= C_9 = w - C_0
269+ | w >= C_a && w <= C_f = w - 87
270+ | w >= C_A && w <= C_F = w - 55
271+ | otherwise = 255
272+ where w = fromIntegral $ B.unsafeIndex s n
273+ a = hex 0; b = hex 1; c = hex 2; d = hex 3
274+ if (a .|. b .|. c .|. d) /= 255
275+ then return $! d .|. (c `shiftL` 4) .|. (b `shiftL` 8) .|. (a `shiftL` 12)
276+ else fail "invalid hex escape"
368
277
369decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
278decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
370decodeWith p to s =
279decodeWith p to s =
@@ -380,30 +289,25 @@ decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
380decodeStrictWith p to s =
289decodeStrictWith p to s =
381 case either Error to (A.parseOnly p s) of
290 case either Error to (A.parseOnly p s) of
382 Success a -> Just a
291 Success a -> Just a
383− _ -> Nothing
292+ Error _ -> Nothing
384{-# INLINE decodeStrictWith #-}
293{-# INLINE decodeStrictWith #-}
385
294
386−eitherDecodeWith :: Parser Value -> (Value -> IResult a) -> L.ByteString
295+eitherDecodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString
387− -> Either (JSONPath, String) a
296+ -> Either String a
388eitherDecodeWith p to s =
297eitherDecodeWith p to s =
389 case L.parse p s of
298 case L.parse p s of
390− L.Done _ v -> case to v of
299+ L.Done _ v -> case to v of
391− ISuccess a -> Right a
300+ Success a -> Right a
392− IError path msg -> Left (path, msg)
301+ Error msg -> Left msg
393− L.Fail _ ctx msg -> Left ([], buildMsg ctx msg)
302+ L.Fail _ _ msg -> Left msg
394− where
395− buildMsg :: [String] -> String -> String
396− buildMsg [] msg = msg
397− buildMsg (expectation:_) msg =
398− msg ++ ". Expecting " ++ expectation
399{-# INLINE eitherDecodeWith #-}
303{-# INLINE eitherDecodeWith #-}
400
304
401−eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
305+eitherDecodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
402− -> Either (JSONPath, String) a
306+ -> Either String a
403eitherDecodeStrictWith p to s =
307eitherDecodeStrictWith p to s =
404− case either (IError []) to (A.parseOnly p s) of
308+ case either Error to (A.parseOnly p s) of
405− ISuccess a -> Right a
309+ Success a -> Right a
406− IError path msg -> Left (path, msg)
310+ Error msg -> Left msg
407{-# INLINE eitherDecodeStrictWith #-}
311{-# INLINE eitherDecodeStrictWith #-}
408
312
409-- $lazy
313-- $lazy
@@ -435,103 +339,37 @@ jsonEOF = json <* skipSpace <* endOfInput
435jsonEOF' :: Parser Value
339jsonEOF' :: Parser Value
436jsonEOF' = json' <* skipSpace <* endOfInput
340jsonEOF' = json' <* skipSpace <* endOfInput
437
341
438−-- | The only valid whitespace in a JSON document is space, newline,
342+word8 :: Word8 -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)
439−-- carriage return, and tab.
343+word8 w ptr = do
440−skipSpace :: Parser ()
344+ liftIO $ poke ptr w
441−skipSpace = A.skipWhile $ \w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09
345+ return $! ptr `plusPtr` 1
442−{-# INLINE skipSpace #-}
346+
443−
347+copy :: ByteString -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)
444−------------------ Copy-pasted and adapted from attoparsec ------------------
348+copy (PS fp off len) ptr =
445−
349+ liftIO . withForeignPtr fp $ \src -> do
446−-- A strict pair
350+ B.memcpy ptr (src `plusPtr` off) len
447−data SP = SP !Integer {-# UNPACK #-}!Int
351+ return $! ptr `plusPtr` len
448−
352+
449−decimal0 :: Parser Integer
353+charUtf8 :: Char -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)
450−decimal0 = do
354+charUtf8 ch ptr
451− let zero = 48
355+ | ch < '\x80' = liftIO $ do
452− digits <- A.takeWhile1 isDigit_w8
356+ poke ptr (fromIntegral (ord ch))
453− if B.length digits > 1 && B.unsafeHead digits == zero
357+ return $! ptr `plusPtr` 1
454− then fail "leading zero"
358+ | ch < '\x800' = liftIO $ do
455− else return (bsToInteger digits)
359+ let (a,b) = ord2 ch
456−
360+ poke ptr a
457−-- | Parse a JSON number.
361+ poke (ptr `plusPtr` 1) b
458−scientific :: Parser Scientific
362+ return $! ptr `plusPtr` 2
459−scientific = do
363+ | ch < '\xffff' = liftIO $ do
460− let minus = 45
364+ let (a,b,c) = ord3 ch
461− plus = 43
365+ poke ptr a
462− sign <- A.peekWord8'
366+ poke (ptr `plusPtr` 1) b
463− let !positive = sign == plus || sign /= minus
367+ poke (ptr `plusPtr` 2) c
464− when (sign == plus || sign == minus) $
368+ return $! ptr `plusPtr` 3
465− void A.anyWord8
369+ | otherwise = liftIO $ do
466−
370+ let (a,b,c,d) = ord4 ch
467− n <- decimal0
371+ poke ptr a
468−
372+ poke (ptr `plusPtr` 1) b
469− let f fracDigits = SP (B.foldl' step n fracDigits)
373+ poke (ptr `plusPtr` 2) c
470− (negate $ B.length fracDigits)
374+ poke (ptr `plusPtr` 3) d
471− step a w = a * 10 + fromIntegral (w - 48)
375+ return $! ptr `plusPtr` 4
472−
473− dotty <- A.peekWord8
474− -- '.' -> ascii 46
475− SP c e <- case dotty of
476− Just 46 -> A.anyWord8 *> (f <$> A.takeWhile1 isDigit_w8)
477− _ -> pure (SP n 0)
478−
479− let !signedCoeff | positive = c
480− | otherwise = -c
481−
482− let littleE = 101
483− bigE = 69
484− (A.satisfy (\ex -> ex == littleE || ex == bigE) *>
485− fmap (Sci.scientific signedCoeff . (e +)) (signed decimal)) <|>
486− return (Sci.scientific signedCoeff e)
487−{-# INLINE scientific #-}
488−
489−------------------ Copy-pasted and adapted from base ------------------------
490−
491−bsToInteger :: B.ByteString -> Integer
492−bsToInteger bs
493− | l > 40 = valInteger 10 l [ fromIntegral (w - 48) | w <- B.unpack bs ]
494− | otherwise = bsToIntegerSimple bs
495− where
496− l = B.length bs
497−
498−bsToIntegerSimple :: B.ByteString -> Integer
499−bsToIntegerSimple = B.foldl' step 0 where
500− step a b = a * 10 + fromIntegral (b - 48) -- 48 = '0'
501−
502−-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
503−-- digits are combined into a single radix b^2 digit. This process is
504−-- repeated until we are left with a single digit. This algorithm
505−-- performs well only on large inputs, so we use the simple algorithm
506−-- for smaller inputs.
507−valInteger :: Integer -> Int -> [Integer] -> Integer
508−valInteger = go
509− where
510− go :: Integer -> Int -> [Integer] -> Integer
511− go _ _ [] = 0
512− go _ _ [d] = d
513− go b l ds
514− | l > 40 = b' `seq` go b' l' (combine b ds')
515− | otherwise = valSimple b ds
516− where
517− -- ensure that we have an even number of digits
518− -- before we call combine:
519− ds' = if even l then ds else 0 : ds
520− b' = b * b
521− l' = (l + 1) `quot` 2
522−
523− combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)
524− where
525− d = d1 * b + d2
526− combine _ [] = []
527− combine _ [_] = errorWithoutStackTrace "this should not happen"
528−
529−-- The following algorithm is only linear for types whose Num operations
530−-- are in constant time.
531−valSimple :: Integer -> [Integer] -> Integer
532−valSimple base = go 0
533− where
534− go r [] = r
535− go r (d : ds) = r' `seq` go r' ds
536− where
537− r' = r * base + fromIntegral d
Data/Aeson/Parser/Time.hsdeleted−73
@@ -1,73 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−module Data.Aeson.Parser.Time
4− (
5− run
6− , day
7− , localTime
8− , timeOfDay
9− , timeZone
10− , utcTime
11− , zonedTime
12− ) where
13−
14−import Prelude.Compat
15−
16−import Data.Attoparsec.Text (Parser)
17−import Data.Text (Text)
18−import Data.Time.Calendar (Day)
19−import Data.Time.Clock (UTCTime(..))
20−import qualified Data.Aeson.Types.Internal as Aeson
21−import qualified Data.Attoparsec.Text as A
22−import qualified Data.Attoparsec.Time as T
23−import qualified Data.Time.LocalTime as Local
24−
25−-- | Run an attoparsec parser as an aeson parser.
26−run :: Parser a -> Text -> Aeson.Parser a
27−run p t = case A.parseOnly (p <* A.endOfInput) t of
28− Left err -> fail $ "could not parse date: " ++ err
29− Right r -> return r
30−
31−-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
32−day :: Parser Day
33−day = T.day
34−{-# INLINE day #-}
35−
36−-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
37−timeOfDay :: Parser Local.TimeOfDay
38−timeOfDay = T.timeOfDay
39−{-# INLINE timeOfDay #-}
40−
41−-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
42−-- zero. (This makes some speedups possible.)
43−timeZone :: Parser (Maybe Local.TimeZone)
44−timeZone = T.timeZone
45−{-# INLINE timeZone #-}
46−
47−-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
48−-- The space may be replaced with a @T@. The number of seconds is optional
49−-- and may be followed by a fractional component.
50−localTime :: Parser Local.LocalTime
51−localTime = T.localTime
52−{-# INLINE localTime #-}
53−
54−-- | Behaves as 'zonedTime', but converts any time zone offset into a
55−-- UTC time.
56−utcTime :: Parser UTCTime
57−utcTime = T.utcTime
58−{-# INLINE utcTime #-}
59−
60−-- | Parse a date with time zone info. Acceptable formats:
61−--
62−-- @YYYY-MM-DD HH:MM Z@
63−-- @YYYY-MM-DD HH:MM:SS Z@
64−-- @YYYY-MM-DD HH:MM:SS.SSS Z@
65−--
66−-- The first space may instead be a @T@, and the second space is
67−-- optional. The @Z@ represents UTC. The @Z@ may be replaced with a
68−-- time zone offset of the form @+0000@ or @-08:00@, where the first
69−-- two digits are hours, the @:@ is optional and the second two digits
70−-- (also optional) are minutes.
71−zonedTime :: Parser Local.ZonedTime
72−zonedTime = T.zonedTime
73−{-# INLINE zonedTime #-}
Data/Aeson/Parser/Unescape.hsdeleted−11
@@ -1,11 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−module Data.Aeson.Parser.Unescape
3− (
4− unescapeText
5− ) where
6−
7−#ifdef CFFI
8−import Data.Aeson.Parser.UnescapeFFI (unescapeText)
9−#else
10−import Data.Aeson.Parser.UnescapePure (unescapeText)
11−#endif
Data/Aeson/QQ/Simple.hsdeleted−25
@@ -1,25 +0,0 @@
1−-- | Like "Data.Aeson.QQ" but without interpolation.
2−module Data.Aeson.QQ.Simple (aesonQQ) where
3−
4−import Data.Aeson
5−import qualified Data.Text as T
6−import qualified Data.Text.Encoding as TE
7−import Language.Haskell.TH
8−import Language.Haskell.TH.Quote
9−import Language.Haskell.TH.Syntax (Lift (..))
10−import Prelude ()
11−import Prelude.Compat
12−
13−aesonQQ :: QuasiQuoter
14−aesonQQ = QuasiQuoter
15− { quoteExp = aesonExp
16− , quotePat = const $ error "No quotePat defined for jsonQQ"
17− , quoteType = const $ error "No quoteType defined for jsonQQ"
18− , quoteDec = const $ error "No quoteDec defined for jsonQQ"
19− }
20−
21−aesonExp :: String -> ExpQ
22−aesonExp txt =
23− case eitherDecodeStrict $ TE.encodeUtf8 $ T.pack txt of
24− Left err -> error $ "Error in aesonExp: " ++ show err
25− Right val -> lift (val :: Value)
Data/Aeson/TH.hs+373−1485
@@ -1,26 +1,12 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE CPP, FlexibleInstances, IncoherentInstances, NamedFieldPuns,
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE NamedFieldPuns #-}
5−{-# LANGUAGE NoImplicitPrelude #-}
2+ NoImplicitPrelude, OverlappingInstances, TemplateHaskell,
6−{-# LANGUAGE UndecidableInstances #-}
3+ UndecidableInstances #-}
7−#if __GLASGOW_HASKELL__ >= 800
8−-- a) THQ works on cross-compilers and unregisterised GHCs
9−-- b) may make compilation faster as no dynamic loading is ever needed (not sure about this)
10−-- c) removes one hindrance to have code inferred as SafeHaskell safe
11−{-# LANGUAGE TemplateHaskellQuotes #-}
12−#else
13−{-# LANGUAGE TemplateHaskell #-}
14−#endif
15−
16−#include "incoherent-compat.h"
17−#include "overlapping-compat.h"
18
4
19{-|
5{-|
20Module: Data.Aeson.TH
6Module: Data.Aeson.TH
21−Copyright: (c) 2011-2016 Bryan O'Sullivan
7+Copyright: (c) 2011, 2012 Bryan O'Sullivan
22 (c) 2011 MailRank, Inc.
8 (c) 2011 MailRank, Inc.
23−License: BSD3
9+License: Apache
24Stability: experimental
10Stability: experimental
25Portability: portable
11Portability: portable
26
12
@@ -63,20 +49,6 @@ d = Record { testOne = 3.14159
63>>> fromJSON (toJSON d) == Success d
49>>> fromJSON (toJSON d) == Success d
64> True
50> True
65
51
66−This also works for data family instances, but instead of passing in the data
67−family name (with double quotes), we pass in a data family instance
68−constructor (with a single quote):
69−
70−@
71−data family DF a
72−data instance DF Int = DF1 Int
73− | DF2 Int Int
74− deriving Eq
75−
76−$('deriveJSON' 'defaultOptions' 'DF1)
77−-- Alternatively, one could pass 'DF2 instead
78−@
79−
80Please note that you can derive instances for tuples using the following syntax:
52Please note that you can derive instances for tuples using the following syntax:
81
53
82@
54@
@@ -85,79 +57,70 @@ $('deriveJSON' 'defaultOptions' ''(,,,))
85@
57@
86
58
87-}
59-}
60+
88module Data.Aeson.TH
61module Data.Aeson.TH
89− (
90− -- * Encoding configuration
62+ ( -- * Encoding configuration
91− Options(..)
92− , SumEncoding(..)
93− , defaultOptions
94− , defaultTaggedObject
63+ Options(..), SumEncoding(..), defaultOptions, defaultTaggedObject
95
64
96 -- * FromJSON and ToJSON derivation
65 -- * FromJSON and ToJSON derivation
97 , deriveJSON
66 , deriveJSON
98− , deriveJSON1
99− , deriveJSON2
100
67
101 , deriveToJSON
68 , deriveToJSON
102− , deriveToJSON1
103− , deriveToJSON2
104 , deriveFromJSON
69 , deriveFromJSON
105− , deriveFromJSON1
106− , deriveFromJSON2
107
70
108 , mkToJSON
71 , mkToJSON
109− , mkLiftToJSON
110− , mkLiftToJSON2
111− , mkToEncoding
112− , mkLiftToEncoding
113− , mkLiftToEncoding2
114 , mkParseJSON
72 , mkParseJSON
115− , mkLiftParseJSON
116− , mkLiftParseJSON2
117 ) where
73 ) where
118
74
119−import Prelude.Compat
75+--------------------------------------------------------------------------------
120−
76+-- Imports
121−import Control.Applicative ((<|>))
77+--------------------------------------------------------------------------------
78+
79+-- from aeson:
122−import Data.Aeson (Object, (.:), FromJSON(..), FromJSON1(..), FromJSON2(..), ToJSON(..), ToJSON1(..), ToJSON2(..))
80+import Data.Aeson ( toJSON, Object, object, (.=), (.:), (.:?)
81+ , ToJSON, toJSON
82+ , FromJSON, parseJSON
83+ )
123−import Data.Aeson.Types (Options(..), Parser, SumEncoding(..), Value(..), defaultOptions, defaultTaggedObject)
84+import Data.Aeson.Types ( Value(..), Parser
124−import Data.Aeson.Types.Internal ((<?>), JSONPathElement(Key))
85+ , Options(..)
125−import Data.Aeson.Types.FromJSON (parseOptionalFieldWith)
86+ , SumEncoding(..)
126−import Data.Aeson.Types.ToJSON (fromPairs, pair)
87+ , defaultOptions
88+ , defaultTaggedObject
89+ )
90+-- from base:
91+import Control.Applicative ( pure, (<$>), (<*>) )
127−import Control.Monad (liftM2, unless, when)
92+import Control.Monad ( return, mapM, liftM2, fail )
128−import Data.Foldable (foldr')
93+import Data.Bool ( Bool(False, True), otherwise, (&&) )
129−#if MIN_VERSION_template_haskell(2,8,0) && !MIN_VERSION_template_haskell(2,10,0)
94+import Data.Eq ( (==) )
95+import Data.Function ( ($), (.) )
130−import Data.List (nub)
96+import Data.Functor ( fmap )
131−#endif
97+import Data.Int ( Int )
98+import Data.Either ( Either(Left, Right) )
132−import Data.List (foldl', genericLength, intercalate, partition, union)
99+import Data.List ( (++), foldl, foldl', intercalate
133−import Data.List.NonEmpty ((<|), NonEmpty((:|)))
100+ , length, map, zip, genericLength, all, partition
134−import Data.Map (Map)
101+ )
135−import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
102+import Data.Maybe ( Maybe(Nothing, Just), catMaybes )
136−import qualified Data.Monoid as Monoid
103+import Prelude ( String, (-), Integer, fromIntegral, error )
137−import Data.Set (Set)
138−import Language.Haskell.TH hiding (Arity)
139−import Language.Haskell.TH.Datatype
140−#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))
141−import Language.Haskell.TH.Syntax (mkNameG_tc)
142−#endif
143−import Text.Printf (printf)
104+import Text.Printf ( printf )
144−import qualified Data.Aeson.Encoding.Internal as E
105+import Text.Show ( show )
145−import qualified Data.Foldable as F (all)
106+-- from unordered-containers:
146−import qualified Data.HashMap.Strict as H (difference, fromList, keys, lookup, toList)
107+import qualified Data.HashMap.Strict as H ( lookup, toList )
147−import qualified Data.List.NonEmpty as NE (length, reverse)
108+-- from template-haskell:
148−import qualified Data.Map as M (fromList, keys, lookup , singleton, size)
109+import Language.Haskell.TH
149−import qualified Data.Semigroup as Semigroup (Option(..))
110+import Language.Haskell.TH.Syntax ( VarStrictType )
150−import qualified Data.Set as Set (empty, insert, member)
111+-- from text:
151−import qualified Data.Text as T (Text, pack, unpack)
112+import qualified Data.Text as T ( Text, pack, unpack )
113+-- from vector:
152−import qualified Data.Vector as V (unsafeIndex, null, length, create, empty)
114+import qualified Data.Vector as V ( unsafeIndex, null, length, create, fromList )
153−import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)
115+import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )
116+
154
117
155--------------------------------------------------------------------------------
118--------------------------------------------------------------------------------
156-- Convenience
119-- Convenience
157--------------------------------------------------------------------------------
120--------------------------------------------------------------------------------
158
121
159-- | Generates both 'ToJSON' and 'FromJSON' instance declarations for the given
122-- | Generates both 'ToJSON' and 'FromJSON' instance declarations for the given
160−-- data type or data family instance constructor.
123+-- data type.
161--
124--
162-- This is a convienience function which is equivalent to calling both
125-- This is a convienience function which is equivalent to calling both
163-- 'deriveToJSON' and 'deriveFromJSON'.
126-- 'deriveToJSON' and 'deriveFromJSON'.
@@ -167,33 +130,11 @@ deriveJSON :: Options
167 -- ^ Name of the type for which to generate 'ToJSON' and 'FromJSON'
130 -- ^ Name of the type for which to generate 'ToJSON' and 'FromJSON'
168 -- instances.
131 -- instances.
169 -> Q [Dec]
132 -> Q [Dec]
170−deriveJSON = deriveJSONBoth deriveToJSON deriveFromJSON
133+deriveJSON opts name =
134+ liftM2 (++)
135+ (deriveToJSON opts name)
136+ (deriveFromJSON opts name)
171
137
172−-- | Generates both 'ToJSON1' and 'FromJSON1' instance declarations for the given
173−-- data type or data family instance constructor.
174−--
175−-- This is a convienience function which is equivalent to calling both
176−-- 'deriveToJSON1' and 'deriveFromJSON1'.
177−deriveJSON1 :: Options
178− -- ^ Encoding options.
179− -> Name
180− -- ^ Name of the type for which to generate 'ToJSON1' and 'FromJSON1'
181− -- instances.
182− -> Q [Dec]
183−deriveJSON1 = deriveJSONBoth deriveToJSON1 deriveFromJSON1
184−
185−-- | Generates both 'ToJSON2' and 'FromJSON2' instance declarations for the given
186−-- data type or data family instance constructor.
187−--
188−-- This is a convienience function which is equivalent to calling both
189−-- 'deriveToJSON2' and 'deriveFromJSON2'.
190−deriveJSON2 :: Options
191− -- ^ Encoding options.
192− -> Name
193− -- ^ Name of the type for which to generate 'ToJSON2' and 'FromJSON2'
194− -- instances.
195− -> Q [Dec]
196−deriveJSON2 = deriveJSONBoth deriveToJSON2 deriveFromJSON2
197
138
198--------------------------------------------------------------------------------
139--------------------------------------------------------------------------------
199-- ToJSON
140-- ToJSON
@@ -208,488 +149,272 @@ instance (ToJSON a) ⇒ ToJSON Foo where ...
208The above (ToJSON a) constraint is not necessary and perhaps undesirable.
149The above (ToJSON a) constraint is not necessary and perhaps undesirable.
209-}
150-}
210
151
211−-- | Generates a 'ToJSON' instance declaration for the given data type or
152+-- | Generates a 'ToJSON' instance declaration for the given data type.
212−-- data family instance constructor.
213deriveToJSON :: Options
153deriveToJSON :: Options
214 -- ^ Encoding options.
154 -- ^ Encoding options.
215 -> Name
155 -> Name
216 -- ^ Name of the type for which to generate a 'ToJSON' instance
156 -- ^ Name of the type for which to generate a 'ToJSON' instance
217 -- declaration.
157 -- declaration.
218 -> Q [Dec]
158 -> Q [Dec]
219−deriveToJSON = deriveToJSONCommon toJSONClass
159+deriveToJSON opts name =
160+ withType name $ \tvbs cons -> fmap (:[]) $ fromCons tvbs cons
161+ where
162+ fromCons :: [TyVarBndr] -> [Con] -> Q Dec
163+ fromCons tvbs cons =
164+ instanceD (applyCon ''ToJSON typeNames)
165+ (classType `appT` instanceType)
166+ [ funD 'toJSON
167+ [ clause []
168+ (normalB $ consToJSON opts cons)
169+ []
170+ ]
171+ ]
172+ where
173+ classType = conT ''ToJSON
174+ typeNames = map tvbName tvbs
175+ instanceType = foldl' appT (conT name) $ map varT typeNames
220
176
221−-- | Generates a 'ToJSON1' instance declaration for the given data type or
222−-- data family instance constructor.
223−deriveToJSON1 :: Options
224− -- ^ Encoding options.
225− -> Name
226− -- ^ Name of the type for which to generate a 'ToJSON1' instance
227− -- declaration.
228− -> Q [Dec]
229−deriveToJSON1 = deriveToJSONCommon toJSON1Class
230−
231−-- | Generates a 'ToJSON2' instance declaration for the given data type or
232−-- data family instance constructor.
233−deriveToJSON2 :: Options
234− -- ^ Encoding options.
235− -> Name
236− -- ^ Name of the type for which to generate a 'ToJSON2' instance
237− -- declaration.
238− -> Q [Dec]
239−deriveToJSON2 = deriveToJSONCommon toJSON2Class
240−
241−deriveToJSONCommon :: JSONClass
242− -- ^ The ToJSON variant being derived.
243− -> Options
244− -- ^ Encoding options.
245− -> Name
246− -- ^ Name of the type for which to generate an instance.
247− -> Q [Dec]
248−deriveToJSONCommon = deriveJSONClass [ (ToJSON, \jc _ -> consToValue Value jc)
249− , (ToEncoding, \jc _ -> consToValue Encoding jc)
250− ]
251−
252−-- | Generates a lambda expression which encodes the given data type or
177+-- | Generates a lambda expression which encodes the given data type as JSON.
253−-- data family instance constructor as a 'Value'.
254mkToJSON :: Options -- ^ Encoding options.
178mkToJSON :: Options -- ^ Encoding options.
255 -> Name -- ^ Name of the type to encode.
179 -> Name -- ^ Name of the type to encode.
256 -> Q Exp
180 -> Q Exp
257−mkToJSON = mkToJSONCommon toJSONClass
181+mkToJSON opts name = withType name (\_ cons -> consToJSON opts cons)
258
182
259−-- | Generates a lambda expression which encodes the given data type or
183+-- | Helper function used by both 'deriveToJSON' and 'mkToJSON'. Generates code
260−-- data family instance constructor as a 'Value' by using the given encoding
184+-- to generate the JSON encoding of a number of constructors. All constructors
261−-- function on occurrences of the last type parameter.
185+-- must be from the same type.
186+consToJSON :: Options
262−mkLiftToJSON :: Options -- ^ Encoding options.
187+ -- ^ Encoding options.
263− -> Name -- ^ Name of the type to encode.
188+ -> [Con]
189+ -- ^ Constructors for which to generate JSON generating code.
264− -> Q Exp
190+ -> Q Exp
265−mkLiftToJSON = mkToJSONCommon toJSON1Class
266
191
267−-- | Generates a lambda expression which encodes the given data type or
192+consToJSON _ [] = error $ "Data.Aeson.TH.consToJSON: "
268−-- data family instance constructor as a 'Value' by using the given encoding
193+ ++ "Not a single constructor given!"
269−-- functions on occurrences of the last two type parameters.
270−mkLiftToJSON2 :: Options -- ^ Encoding options.
271− -> Name -- ^ Name of the type to encode.
272− -> Q Exp
273−mkLiftToJSON2 = mkToJSONCommon toJSON2Class
274−
275−mkToJSONCommon :: JSONClass -- ^ Which class's method is being derived.
276− -> Options -- ^ Encoding options.
277− -> Name -- ^ Name of the encoded type.
278− -> Q Exp
279−mkToJSONCommon = mkFunCommon (\jc _ -> consToValue Value jc)
280−
281−-- | Generates a lambda expression which encodes the given data type or
282−-- data family instance constructor as a JSON string.
283−mkToEncoding :: Options -- ^ Encoding options.
284− -> Name -- ^ Name of the type to encode.
285− -> Q Exp
286−mkToEncoding = mkToEncodingCommon toJSONClass
287−
288−-- | Generates a lambda expression which encodes the given data type or
289−-- data family instance constructor as a JSON string by using the given encoding
290−-- function on occurrences of the last type parameter.
291−mkLiftToEncoding :: Options -- ^ Encoding options.
292− -> Name -- ^ Name of the type to encode.
293− -> Q Exp
294−mkLiftToEncoding = mkToEncodingCommon toJSON1Class
295−
296−-- | Generates a lambda expression which encodes the given data type or
297−-- data family instance constructor as a JSON string by using the given encoding
298−-- functions on occurrences of the last two type parameters.
299−mkLiftToEncoding2 :: Options -- ^ Encoding options.
300− -> Name -- ^ Name of the type to encode.
301− -> Q Exp
302−mkLiftToEncoding2 = mkToEncodingCommon toJSON2Class
303−
304−mkToEncodingCommon :: JSONClass -- ^ Which class's method is being derived.
305− -> Options -- ^ Encoding options.
306− -> Name -- ^ Name of the encoded type.
307− -> Q Exp
308−mkToEncodingCommon = mkFunCommon (\jc _ -> consToValue Encoding jc)
309−
310−-- | Helper function used by both 'deriveToJSON' and 'mkToJSON'. Generates
311−-- code to generate a 'Value' or 'Encoding' of a number of constructors. All
312−-- constructors must be from the same type.
313−consToValue :: ToJSONFun
314− -- ^ The method ('toJSON' or 'toEncoding') being derived.
315− -> JSONClass
316− -- ^ The ToJSON variant being derived.
317− -> Options
318− -- ^ Encoding options.
319− -> [Type]
320− -- ^ The types from the data type/data family instance declaration
321− -> [ConstructorInfo]
322− -- ^ Constructors for which to generate JSON generating code.
323− -> Q Exp
324
194
325−consToValue _ _ _ _ [] = error $ "Data.Aeson.TH.consToValue: "
195+-- A single constructor is directly encoded. The constructor itself may be
326− ++ "Not a single constructor given!"
196+-- forgotten.
197+consToJSON opts [con] = do
198+ value <- newName "value"
199+ lam1E (varP value) $ caseE (varE value) [encodeArgs opts False con]
327
200
328−consToValue target jc opts instTys cons = do
201+consToJSON opts cons = do
329 value <- newName "value"
202 value <- newName "value"
330− tjs <- newNameList "_tj" $ arityInt jc
331− tjls <- newNameList "_tjl" $ arityInt jc
332− let zippedTJs = zip tjs tjls
333− interleavedTJs = interleave tjs tjls
334− lastTyVars = map varTToName $ drop (length instTys - arityInt jc) instTys
335− tvMap = M.fromList $ zip lastTyVars zippedTJs
336− lamE (map varP $ interleavedTJs ++ [value]) $
337− caseE (varE value) (matches tvMap)
203+ lam1E (varP value) $ caseE (varE value) matches
338 where
204 where
339− matches tvMap = case cons of
205+ matches
340− -- A single constructor is directly encoded. The constructor itself may be
341− -- forgotten.
342− [con] | not (tagSingleConstructors opts) -> [argsToValue target jc tvMap opts False con]
343− _ | allNullaryToStringTag opts && all isNullary cons ->
206+ | allNullaryToStringTag opts && all isNullary cons =
344− [ match (conP conName []) (normalB $ conStr target opts conName) []
207+ [ match (conP conName []) (normalB $ conStr opts conName) []
345 | con <- cons
208 | con <- cons
346− , let conName = constructorName con
209+ , let conName = getConName con
347 ]
210 ]
348− | otherwise -> [argsToValue target jc tvMap opts True con | con <- cons]
211+ | otherwise = [encodeArgs opts True con | con <- cons]
349
212
350−-- | Name of the constructor as a quoted 'Value' or 'Encoding'.
351−conStr :: ToJSONFun -> Options -> Name -> Q Exp
213+conStr :: Options -> Name -> Q Exp
352−conStr Value opts = appE [|String|] . conTxt opts
214+conStr opts = appE [|String|] . conTxt opts
353−conStr Encoding opts = appE [|E.text|] . conTxt opts
354
215
355−-- | Name of the constructor as a quoted 'Text'.
356conTxt :: Options -> Name -> Q Exp
216conTxt :: Options -> Name -> Q Exp
357−conTxt opts = appE [|T.pack|] . stringE . conString opts
217+conTxt opts = appE [|T.pack|] . conStringE opts
358
218
359−-- | Name of the constructor.
360−conString :: Options -> Name -> String
219+conStringE :: Options -> Name -> Q Exp
361−conString opts = constructorTagModifier opts . nameBase
220+conStringE opts = stringE . constructorTagModifier opts . nameBase
362
221
363-- | If constructor is nullary.
222-- | If constructor is nullary.
364−isNullary :: ConstructorInfo -> Bool
223+isNullary :: Con -> Bool
365−isNullary ConstructorInfo { constructorVariant = NormalConstructor
224+isNullary (NormalC _ []) = True
366− , constructorFields = tys } = null tys
367isNullary _ = False
225isNullary _ = False
368
226
369−-- | Wrap fields of a non-record constructor. See 'sumToValue'.
227+encodeSum :: Options -> Bool -> Name -> Q Exp -> Q Exp
370−opaqueSumToValue :: ToJSONFun -> Options -> Bool -> Bool -> Name -> ExpQ -> ExpQ
371−opaqueSumToValue target opts multiCons nullary conName value =
372− sumToValue target opts multiCons nullary conName
373− value
374− pairs
375− where
376− pairs contentsFieldName = pairE contentsFieldName value
377−
378−-- | Wrap fields of a record constructor. See 'sumToValue'.
379−recordSumToValue :: ToJSONFun -> Options -> Bool -> Bool -> Name -> ExpQ -> ExpQ
380−recordSumToValue target opts multiCons nullary conName pairs =
228+encodeSum opts multiCons conName exp
381− sumToValue target opts multiCons nullary conName
382− (fromPairsE pairs)
383− (const pairs)
384−
385−-- | Wrap fields of a constructor.
386−sumToValue
387− :: ToJSONFun
388− -- ^ The method being derived.
389− -> Options
390− -- ^ Deriving options.
391− -> Bool
392− -- ^ Does this type have multiple constructors.
393− -> Bool
394− -- ^ Is this constructor nullary.
395− -> Name
396− -- ^ Constructor name.
397− -> ExpQ
398− -- ^ Fields of the constructor as a 'Value' or 'Encoding'.
399− -> (String -> ExpQ)
400− -- ^ Representation of an 'Object' fragment used for the 'TaggedObject'
401− -- variant; of type @[(Text,Value)]@ or @[Encoding]@, depending on the method
402− -- being derived.
403− --
404− -- - For non-records, produces a pair @"contentsFieldName":value@,
405− -- given a @contentsFieldName@ as an argument. See 'opaqueSumToValue'.
406− -- - For records, produces the list of pairs corresponding to fields of the
407− -- encoded value (ignores the argument). See 'recordSumToValue'.
408− -> ExpQ
409−sumToValue target opts multiCons nullary conName value pairs
410 | multiCons =
229 | multiCons =
411 case sumEncoding opts of
230 case sumEncoding opts of
412 TwoElemArray ->
231 TwoElemArray ->
413− array target [conStr target opts conName, value]
232+ [|Array|] `appE` ([|V.fromList|] `appE` listE [conStr opts conName, exp])
414 TaggedObject{tagFieldName, contentsFieldName} ->
233 TaggedObject{tagFieldName, contentsFieldName} ->
415− -- TODO: Maybe throw an error in case
234+ [|object|] `appE` listE
416− -- tagFieldName overwrites a field in pairs.
235+ [ infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)
417− let tag = pairE tagFieldName (conStr target opts conName)
418− content = pairs contentsFieldName
236+ , infixApp [|T.pack contentsFieldName|] [|(.=)|] exp
419− in fromPairsE $
237+ ]
420− if nullary then tag else infixApp tag [|(Monoid.<>)|] content
421 ObjectWithSingleField ->
238 ObjectWithSingleField ->
422− objectE [(conString opts conName, value)]
239+ [|object|] `appE` listE
423− UntaggedValue | nullary -> conStr target opts conName
240+ [ infixApp (conTxt opts conName) [|(.=)|] exp
424− UntaggedValue -> value
241+ ]
242+
425− | otherwise = value
243+ | otherwise = exp
426
244
427-- | Generates code to generate the JSON encoding of a single constructor.
245-- | Generates code to generate the JSON encoding of a single constructor.
428−argsToValue :: ToJSONFun -> JSONClass -> TyVarMap -> Options -> Bool -> ConstructorInfo -> Q Match
246+encodeArgs :: Options -> Bool -> Con -> Q Match
247+-- Nullary constructors. Generates code that explicitly matches against the
248+-- constructor even though it doesn't contain data. This is useful to prevent
249+-- type errors.
250+encodeArgs opts multiCons (NormalC conName []) =
251+ match (conP conName [])
252+ (normalB (encodeSum opts multiCons conName [e|toJSON ([] :: [()])|]))
253+ []
429
254
430-- Polyadic constructors with special case for unary constructors.
255-- Polyadic constructors with special case for unary constructors.
431−argsToValue target jc tvMap opts multiCons
256+encodeArgs opts multiCons (NormalC conName ts) = do
432− ConstructorInfo { constructorName = conName
433− , constructorVariant = NormalConstructor
434− , constructorFields = argTys } = do
435− argTys' <- mapM resolveTypeSynonyms argTys
436− let len = length argTys'
257+ let len = length ts
437− args <- newNameList "arg" len
258+ args <- mapM newName ["arg" ++ show n | n <- [1..len]]
438− let js = case [ dispatchToJSON target jc conName tvMap argTy
439− `appE` varE arg
259+ js <- case [[|toJSON|] `appE` varE arg | arg <- args] of
440− | (arg, argTy) <- zip args argTys'
441− ] of
442− -- Single argument is directly converted.
260+ -- Single argument is directly converted.
443− [e] -> e
261+ [e] -> return e
444− -- Zero and multiple arguments are converted to a JSON array.
262+ -- Multiple arguments are converted to a JSON array.
445− es -> array target es
263+ es -> do
446−
264+ mv <- newName "mv"
265+ let newMV = bindS (varP mv)
266+ ([|VM.unsafeNew|] `appE`
267+ litE (integerL $ fromIntegral len))
268+ stmts = [ noBindS $
269+ [|VM.unsafeWrite|] `appE`
270+ (varE mv) `appE`
271+ litE (integerL ix) `appE`
272+ e
273+ | (ix, e) <- zip [(0::Integer)..] es
274+ ]
275+ ret = noBindS $ [|return|] `appE` varE mv
276+ return $ [|Array|] `appE`
277+ (varE 'V.create `appE`
278+ doE (newMV:stmts++[ret]))
447 match (conP conName $ map varP args)
279 match (conP conName $ map varP args)
448− (normalB $ opaqueSumToValue target opts multiCons (null argTys') conName js)
280+ (normalB $ encodeSum opts multiCons conName js)
449 []
281 []
450
282
451-- Records.
283-- Records.
452−argsToValue target jc tvMap opts multiCons
284+encodeArgs opts multiCons (RecC conName ts) = do
453− info@ConstructorInfo { constructorName = conName
285+ args <- mapM newName ["arg" ++ show n | (_, n) <- zip ts [1 :: Integer ..]]
454− , constructorVariant = RecordConstructor fields
286+ let exp = [|object|] `appE` pairs
455− , constructorFields = argTys } =
287+
456− case (unwrapUnaryRecords opts, not multiCons, argTys) of
457− (True,True,[_]) -> argsToValue target jc tvMap opts multiCons
458− (info{constructorVariant = NormalConstructor})
459− _ -> do
460− argTys' <- mapM resolveTypeSynonyms argTys
461− args <- newNameList "arg" $ length argTys'
462− let pairs | omitNothingFields opts = infixApp maybeFields
288+ pairs | omitNothingFields opts = infixApp maybeFields
463− [|(Monoid.<>)|]
289+ [|(++)|]
464− restFields
290+ restFields
465− | otherwise = mconcatE (map pureToPair argCons)
291+ | otherwise = listE $ map toPair argCons
466−
292+
467− argCons = zip3 (map varE args) argTys' fields
293+ argCons = zip args ts
468−
294+
469− maybeFields = mconcatE (map maybeToPair maybes)
295+ maybeFields = [|catMaybes|] `appE` listE (map maybeToPair maybes)
470−
296+
471− restFields = mconcatE (map pureToPair rest)
297+ restFields = listE $ map toPair rest
472−
298+
473− (maybes0, rest0) = partition isMaybe argCons
299+ (maybes, rest) = partition isMaybe argCons
474− (options, rest) = partition isOption rest0
300+
475− maybes = maybes0 ++ map optionToMaybe options
301+ isMaybe (_, (_, _, AppT (ConT t) _)) = t == ''Maybe
476−
302+ isMaybe _ = False
477− maybeToPair = toPairLifted True
303+
478− pureToPair = toPairLifted False
304+ maybeToPair (arg, (field, _, _)) =
479−
305+ infixApp (infixE (Just $ toFieldName field)
480− toPairLifted lifted (arg, argTy, field) =
306+ [|(.=)|]
481− let toValue = dispatchToJSON target jc conName tvMap argTy
307+ Nothing)
482− fieldName = fieldLabel opts field
308+ [|(<$>)|]
483− e arg' = pairE fieldName (toValue `appE` arg')
309+ (varE arg)
484− in if lifted
310+
485− then do
311+ toPair (arg, (field, _, _)) =
486− x <- newName "x"
312+ infixApp (toFieldName field)
487− [|maybe mempty|] `appE` lam1E (varP x) (e (varE x)) `appE` arg
313+ [|(.=)|]
314+ (varE arg)
315+
316+ toFieldName field = [|T.pack|] `appE` fieldLabelExp opts field
317+
318+ match (conP conName $ map varP args)
319+ ( normalB
320+ $ if multiCons
321+ then case sumEncoding opts of
322+ TwoElemArray -> [|toJSON|] `appE` tupE [conStr opts conName, exp]
323+ TaggedObject{tagFieldName} ->
324+ [|object|] `appE`
325+ -- TODO: Maybe throw an error in case
326+ -- tagFieldName overwrites a field in pairs.
327+ infixApp (infixApp [|T.pack tagFieldName|]
328+ [|(.=)|]
329+ (conStr opts conName))
330+ [|(:)|]
331+ pairs
332+ ObjectWithSingleField ->
333+ [|object|] `appE` listE
334+ [ infixApp (conTxt opts conName) [|(.=)|] exp ]
488− else e arg
335+ else exp
489−
490− match (conP conName $ map varP args)
491− (normalB $ recordSumToValue target opts multiCons (null argTys) conName pairs)
492− []
336+ ) []
493
337
494-- Infix constructors.
338-- Infix constructors.
495−argsToValue target jc tvMap opts multiCons
339+encodeArgs opts multiCons (InfixC _ conName _) = do
496− ConstructorInfo { constructorName = conName
497− , constructorVariant = InfixConstructor
498− , constructorFields = argTys } = do
499− [alTy, arTy] <- mapM resolveTypeSynonyms argTys
500 al <- newName "argL"
340 al <- newName "argL"
501 ar <- newName "argR"
341 ar <- newName "argR"
502 match (infixP (varP al) conName (varP ar))
342 match (infixP (varP al) conName (varP ar))
503 ( normalB
343 ( normalB
504− $ opaqueSumToValue target opts multiCons False conName
344+ $ encodeSum opts multiCons conName
505− $ array target
506− [ dispatchToJSON target jc conName tvMap aTy
507− `appE` varE a
345+ $ [|toJSON|] `appE` listE [ [|toJSON|] `appE` varE a
508− | (a, aTy) <- [(al,alTy), (ar,arTy)]
346+ | a <- [al,ar]
509− ]
347+ ]
510 )
348 )
511 []
349 []
350+-- Existentially quantified constructors.
351+encodeArgs opts multiCons (ForallC _ _ con) =
352+ encodeArgs opts multiCons con
512
353
513−isMaybe :: (a, Type, b) -> Bool
514−isMaybe (_, AppT (ConT t) _, _) = t == ''Maybe
515−isMaybe _ = False
516−
517−isOption :: (a, Type, b) -> Bool
518−isOption (_, AppT (ConT t) _, _) = t == ''Semigroup.Option
519−isOption _ = False
520−
521−optionToMaybe :: (ExpQ, b, c) -> (ExpQ, b, c)
522−optionToMaybe (a, b, c) = ([|Semigroup.getOption|] `appE` a, b, c)
523−
524−(<^>) :: ExpQ -> ExpQ -> ExpQ
525−(<^>) a b = infixApp a [|(E.><)|] b
526−infixr 6 <^>
527−
528−(<%>) :: ExpQ -> ExpQ -> ExpQ
529−(<%>) a b = a <^> [|E.comma|] <^> b
530−infixr 4 <%>
531−
532−-- | Wrap a list of quoted 'Value's in a quoted 'Array' (of type 'Value').
533−array :: ToJSONFun -> [ExpQ] -> ExpQ
534−array Encoding [] = [|E.emptyArray_|]
535−array Value [] = [|Array V.empty|]
536−array Encoding es = [|E.wrapArray|] `appE` foldr1 (<%>) es
537−array Value es = do
538− mv <- newName "mv"
539− let newMV = bindS (varP mv)
540− ([|VM.unsafeNew|] `appE`
541− litE (integerL $ fromIntegral (length es)))
542− stmts = [ noBindS $
543− [|VM.unsafeWrite|] `appE`
544− varE mv `appE`
545− litE (integerL ix) `appE`
546− e
547− | (ix, e) <- zip [(0::Integer)..] es
548− ]
549− ret = noBindS $ [|return|] `appE` varE mv
550− [|Array|] `appE`
551− (varE 'V.create `appE`
552− doE (newMV:stmts++[ret]))
553−
554−-- | Wrap an associative list of keys and quoted values in a quoted 'Object'.
555−objectE :: [(String, ExpQ)] -> ExpQ
556−objectE = fromPairsE . mconcatE . fmap (uncurry pairE)
557−
558−-- | 'mconcat' a list of fixed length.
559−--
560−-- > mconcatE [ [|x|], [|y|], [|z|] ] = [| x <> (y <> z) |]
561−mconcatE :: [ExpQ] -> ExpQ
562−mconcatE [] = [|Monoid.mempty|]
563−mconcatE [x] = x
564−mconcatE (x : xs) = infixApp x [|(Monoid.<>)|] (mconcatE xs)
565−
566−fromPairsE :: ExpQ -> ExpQ
567−fromPairsE = ([|fromPairs|] `appE`)
568−
569−-- | Create (an encoding of) a key-value pair.
570−--
571−-- > pairE "k" [|v|] = [|pair "k" v|]
572−pairE :: String -> ExpQ -> ExpQ
573−pairE k v = [|pair k|] `appE` v
574
354
575--------------------------------------------------------------------------------
355--------------------------------------------------------------------------------
576-- FromJSON
356-- FromJSON
577--------------------------------------------------------------------------------
357--------------------------------------------------------------------------------
578
358
579−-- | Generates a 'FromJSON' instance declaration for the given data type or
359+-- | Generates a 'FromJSON' instance declaration for the given data type.
580−-- data family instance constructor.
581deriveFromJSON :: Options
360deriveFromJSON :: Options
582 -- ^ Encoding options.
361 -- ^ Encoding options.
583 -> Name
362 -> Name
584 -- ^ Name of the type for which to generate a 'FromJSON' instance
363 -- ^ Name of the type for which to generate a 'FromJSON' instance
585 -- declaration.
364 -- declaration.
586 -> Q [Dec]
365 -> Q [Dec]
587−deriveFromJSON = deriveFromJSONCommon fromJSONClass
366+deriveFromJSON opts name =
588−
367+ withType name $ \tvbs cons -> fmap (:[]) $ fromCons tvbs cons
589−-- | Generates a 'FromJSON1' instance declaration for the given data type or
368+ where
590−-- data family instance constructor.
369+ fromCons :: [TyVarBndr] -> [Con] -> Q Dec
591−deriveFromJSON1 :: Options
370+ fromCons tvbs cons =
592− -- ^ Encoding options.
371+ instanceD (applyCon ''FromJSON typeNames)
593− -> Name
372+ (classType `appT` instanceType)
594− -- ^ Name of the type for which to generate a 'FromJSON1' instance
373+ [ funD 'parseJSON
595− -- declaration.
374+ [ clause []
596− -> Q [Dec]
375+ (normalB $ consFromJSON name opts cons)
597−deriveFromJSON1 = deriveFromJSONCommon fromJSON1Class
376+ []
598−
377+ ]
599−-- | Generates a 'FromJSON2' instance declaration for the given data type or
378+ ]
600−-- data family instance constructor.
379+ where
601−deriveFromJSON2 :: Options
380+ classType = conT ''FromJSON
602− -- ^ Encoding options.
381+ typeNames = map tvbName tvbs
603− -> Name
382+ instanceType = foldl' appT (conT name) $ map varT typeNames
604− -- ^ Name of the type for which to generate a 'FromJSON3' instance
605− -- declaration.
606− -> Q [Dec]
607−deriveFromJSON2 = deriveFromJSONCommon fromJSON2Class
608−
609−deriveFromJSONCommon :: JSONClass
610− -- ^ The FromJSON variant being derived.
611− -> Options
612− -- ^ Encoding options.
613− -> Name
614− -- ^ Name of the type for which to generate an instance.
615− -- declaration.
616− -> Q [Dec]
617−deriveFromJSONCommon = deriveJSONClass [(ParseJSON, consFromJSON)]
618
383
619-- | Generates a lambda expression which parses the JSON encoding of the given
384-- | Generates a lambda expression which parses the JSON encoding of the given
620−-- data type or data family instance constructor.
385+-- data type.
621mkParseJSON :: Options -- ^ Encoding options.
386mkParseJSON :: Options -- ^ Encoding options.
622 -> Name -- ^ Name of the encoded type.
387 -> Name -- ^ Name of the encoded type.
623 -> Q Exp
388 -> Q Exp
624−mkParseJSON = mkParseJSONCommon fromJSONClass
389+mkParseJSON opts name =
625−
390+ withType name (\_ cons -> consFromJSON name opts cons)
626−-- | Generates a lambda expression which parses the JSON encoding of the given
627−-- data type or data family instance constructor by using the given parsing
628−-- function on occurrences of the last type parameter.
629−mkLiftParseJSON :: Options -- ^ Encoding options.
630− -> Name -- ^ Name of the encoded type.
631− -> Q Exp
632−mkLiftParseJSON = mkParseJSONCommon fromJSON1Class
633−
634−-- | Generates a lambda expression which parses the JSON encoding of the given
635−-- data type or data family instance constructor by using the given parsing
636−-- functions on occurrences of the last two type parameters.
637−mkLiftParseJSON2 :: Options -- ^ Encoding options.
638− -> Name -- ^ Name of the encoded type.
639− -> Q Exp
640−mkLiftParseJSON2 = mkParseJSONCommon fromJSON2Class
641−
642−mkParseJSONCommon :: JSONClass -- ^ Which class's method is being derived.
643− -> Options -- ^ Encoding options.
644− -> Name -- ^ Name of the encoded type.
645− -> Q Exp
646−mkParseJSONCommon = mkFunCommon consFromJSON
647
391
648-- | Helper function used by both 'deriveFromJSON' and 'mkParseJSON'. Generates
392-- | Helper function used by both 'deriveFromJSON' and 'mkParseJSON'. Generates
649-- code to parse the JSON encoding of a number of constructors. All constructors
393-- code to parse the JSON encoding of a number of constructors. All constructors
650-- must be from the same type.
394-- must be from the same type.
651−consFromJSON :: JSONClass
395+consFromJSON :: Name
652− -- ^ The FromJSON variant being derived.
653− -> Name
654 -- ^ Name of the type to which the constructors belong.
396 -- ^ Name of the type to which the constructors belong.
655 -> Options
397 -> Options
656 -- ^ Encoding options
398 -- ^ Encoding options
657− -> [Type]
399+ -> [Con]
658− -- ^ The types from the data type/data family instance declaration
659− -> [ConstructorInfo]
660 -- ^ Constructors for which to generate JSON parsing code.
400 -- ^ Constructors for which to generate JSON parsing code.
661 -> Q Exp
401 -> Q Exp
662
402
663−consFromJSON _ _ _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
403+consFromJSON _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
664− ++ "Not a single constructor given!"
404+ ++ "Not a single constructor given!"
665
405
666−consFromJSON jc tName opts instTys cons = do
406+consFromJSON tName opts [con] = do
667 value <- newName "value"
407 value <- newName "value"
668− pjs <- newNameList "_pj" $ arityInt jc
408+ lam1E (varP value) (parseArgs tName opts con (Right value))
669− pjls <- newNameList "_pjl" $ arityInt jc
670− let zippedPJs = zip pjs pjls
671− interleavedPJs = interleave pjs pjls
672− lastTyVars = map varTToName $ drop (length instTys - arityInt jc) instTys
673− tvMap = M.fromList $ zip lastTyVars zippedPJs
674− lamE (map varP $ interleavedPJs ++ [value]) $ lamExpr value tvMap
675
409
676− where
410+consFromJSON tName opts cons = do
677− checkExi tvMap con = checkExistentialContext jc tvMap
411+ value <- newName "value"
678− (constructorContext con)
679− (constructorName con)
680−
681− lamExpr value tvMap = case cons of
682− [con]
683− | not (tagSingleConstructors opts)
684− -> checkExi tvMap con $ parseArgs jc tvMap tName opts con (Right value)
685− _ | sumEncoding opts == UntaggedValue
686− -> parseUntaggedValue tvMap cons value
687− | otherwise
688− -> caseE (varE value) $
412+ lam1E (varP value) $ caseE (varE value) $
689− if allNullaryToStringTag opts && all isNullary cons
413+ if allNullaryToStringTag opts && all isNullary cons
690− then allNullaryMatches
414+ then allNullaryMatches
691− else mixedMatches tvMap
415+ else mixedMatches
692
416
417+ where
693 allNullaryMatches =
418 allNullaryMatches =
694 [ do txt <- newName "txt"
419 [ do txt <- newName "txt"
695 match (conP 'String [varP txt])
420 match (conP 'String [varP txt])
@@ -697,17 +422,18 @@ consFromJSON jc tName opts instTys cons = do
697 [ liftM2 (,) (normalG $
422 [ liftM2 (,) (normalG $
698 infixApp (varE txt)
423 infixApp (varE txt)
699 [|(==)|]
424 [|(==)|]
425+ ([|T.pack|] `appE`
700− (conTxt opts conName)
426+ conStringE opts conName)
701 )
427 )
702 ([|pure|] `appE` conE conName)
428 ([|pure|] `appE` conE conName)
703 | con <- cons
429 | con <- cons
704− , let conName = constructorName con
430+ , let conName = getConName con
705 ]
431 ]
706 ++
432 ++
707 [ liftM2 (,)
433 [ liftM2 (,)
708 (normalG [|otherwise|])
434 (normalG [|otherwise|])
709 ( [|noMatchFail|]
435 ( [|noMatchFail|]
710− `appE` litE (stringL $ show tName)
436+ `appE` (litE $ stringL $ show tName)
711 `appE` ([|T.unpack|] `appE` varE txt)
437 `appE` ([|T.unpack|] `appE` varE txt)
712 )
438 )
713 ]
439 ]
@@ -716,31 +442,30 @@ consFromJSON jc tName opts instTys cons = do
716 , do other <- newName "other"
442 , do other <- newName "other"
717 match (varP other)
443 match (varP other)
718 (normalB $ [|noStringFail|]
444 (normalB $ [|noStringFail|]
719− `appE` litE (stringL $ show tName)
445+ `appE` (litE $ stringL $ show tName)
720 `appE` ([|valueConName|] `appE` varE other)
446 `appE` ([|valueConName|] `appE` varE other)
721 )
447 )
722 []
448 []
723 ]
449 ]
724
450
725− mixedMatches tvMap =
451+ mixedMatches =
726 case sumEncoding opts of
452 case sumEncoding opts of
727 TaggedObject {tagFieldName, contentsFieldName} ->
453 TaggedObject {tagFieldName, contentsFieldName} ->
728− parseObject $ parseTaggedObject tvMap tagFieldName contentsFieldName
454+ parseObject $ parseTaggedObject tagFieldName contentsFieldName
729− UntaggedValue -> error "UntaggedValue: Should be handled already"
730 ObjectWithSingleField ->
455 ObjectWithSingleField ->
731− parseObject $ parseObjectWithSingleField tvMap
456+ parseObject $ parseObjectWithSingleField
732 TwoElemArray ->
457 TwoElemArray ->
733 [ do arr <- newName "array"
458 [ do arr <- newName "array"
734 match (conP 'Array [varP arr])
459 match (conP 'Array [varP arr])
735− (guardedB
460+ (guardedB $
736 [ liftM2 (,) (normalG $ infixApp ([|V.length|] `appE` varE arr)
461 [ liftM2 (,) (normalG $ infixApp ([|V.length|] `appE` varE arr)
737 [|(==)|]
462 [|(==)|]
738 (litE $ integerL 2))
463 (litE $ integerL 2))
739− (parse2ElemArray tvMap arr)
464+ (parse2ElemArray arr)
740 , liftM2 (,) (normalG [|otherwise|])
465 , liftM2 (,) (normalG [|otherwise|])
741− ([|not2ElemArray|]
466+ (([|not2ElemArray|]
742− `appE` litE (stringL $ show tName)
467+ `appE` (litE $ stringL $ show tName)
743− `appE` ([|V.length|] `appE` varE arr))
468+ `appE` ([|V.length|] `appE` varE arr)))
744 ]
469 ]
745 )
470 )
746 []
471 []
@@ -748,7 +473,7 @@ consFromJSON jc tName opts instTys cons = do
748 match (varP other)
473 match (varP other)
749 ( normalB
474 ( normalB
750 $ [|noArrayFail|]
475 $ [|noArrayFail|]
751− `appE` litE (stringL $ show tName)
476+ `appE` (litE $ stringL $ show tName)
752 `appE` ([|valueConName|] `appE` varE other)
477 `appE` ([|valueConName|] `appE` varE other)
753 )
478 )
754 []
479 []
@@ -761,47 +486,22 @@ consFromJSON jc tName opts instTys cons = do
761 match (varP other)
486 match (varP other)
762 ( normalB
487 ( normalB
763 $ [|noObjectFail|]
488 $ [|noObjectFail|]
764− `appE` litE (stringL $ show tName)
489+ `appE` (litE $ stringL $ show tName)
765 `appE` ([|valueConName|] `appE` varE other)
490 `appE` ([|valueConName|] `appE` varE other)
766 )
491 )
767 []
492 []
768 ]
493 ]
769
494
770− parseTaggedObject tvMap typFieldName valFieldName obj = do
495+ parseTaggedObject typFieldName valFieldName obj = do
771 conKey <- newName "conKey"
496 conKey <- newName "conKey"
772 doE [ bindS (varP conKey)
497 doE [ bindS (varP conKey)
773 (infixApp (varE obj)
498 (infixApp (varE obj)
774 [|(.:)|]
499 [|(.:)|]
775 ([|T.pack|] `appE` stringE typFieldName))
500 ([|T.pack|] `appE` stringE typFieldName))
776− , noBindS $ parseContents tvMap conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject
501+ , noBindS $ parseContents conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject
777 ]
502 ]
778
503
779− parseUntaggedValue tvMap cons' conVal =
780− foldr1 (\e e' -> infixApp e [|(<|>)|] e')
781− (map (\x -> parseValue tvMap x conVal) cons')
782−
783− parseValue _tvMap
784− ConstructorInfo { constructorName = conName
785− , constructorVariant = NormalConstructor
786− , constructorFields = [] }
787− conVal = do
788− str <- newName "str"
789− caseE (varE conVal)
790− [ match (conP 'String [varP str])
791− (guardedB
792− [ liftM2 (,) (normalG $ infixApp (varE str) [|(==)|] (conTxt opts conName)
793− )
794− ([|pure|] `appE` conE conName)
795− ]
796− )
797− []
798− , matchFailed tName conName "String"
799− ]
800− parseValue tvMap con conVal =
801− checkExi tvMap con $ parseArgs jc tvMap tName opts con (Right conVal)
802−
803−
804− parse2ElemArray tvMap arr = do
504+ parse2ElemArray arr = do
805 conKey <- newName "conKey"
505 conKey <- newName "conKey"
806 conVal <- newName "conVal"
506 conVal <- newName "conVal"
807 let letIx n ix =
507 let letIx n ix =
@@ -816,8 +516,7 @@ consFromJSON jc tName opts instTys cons = do
816 (caseE (varE conKey)
516 (caseE (varE conKey)
817 [ do txt <- newName "txt"
517 [ do txt <- newName "txt"
818 match (conP 'String [varP txt])
518 match (conP 'String [varP txt])
819− (normalB $ parseContents tvMap
519+ (normalB $ parseContents txt
820− txt
821 (Right conVal)
520 (Right conVal)
822 'conNotFoundFail2ElemArray
521 'conNotFoundFail2ElemArray
823 )
522 )
@@ -826,30 +525,30 @@ consFromJSON jc tName opts instTys cons = do
826 match (varP other)
525 match (varP other)
827 ( normalB
526 ( normalB
828 $ [|firstElemNoStringFail|]
527 $ [|firstElemNoStringFail|]
829− `appE` litE (stringL $ show tName)
528+ `appE` (litE $ stringL $ show tName)
830 `appE` ([|valueConName|] `appE` varE other)
529 `appE` ([|valueConName|] `appE` varE other)
831 )
530 )
832 []
531 []
833 ]
532 ]
834 )
533 )
835
534
836− parseObjectWithSingleField tvMap obj = do
535+ parseObjectWithSingleField obj = do
837 conKey <- newName "conKey"
536 conKey <- newName "conKey"
838 conVal <- newName "conVal"
537 conVal <- newName "conVal"
839 caseE ([e|H.toList|] `appE` varE obj)
538 caseE ([e|H.toList|] `appE` varE obj)
840 [ match (listP [tupP [varP conKey, varP conVal]])
539 [ match (listP [tupP [varP conKey, varP conVal]])
841− (normalB $ parseContents tvMap conKey (Right conVal) 'conNotFoundFailObjectSingleField)
540+ (normalB $ parseContents conKey (Right conVal) 'conNotFoundFailObjectSingleField)
842 []
541 []
843 , do other <- newName "other"
542 , do other <- newName "other"
844 match (varP other)
543 match (varP other)
845 (normalB $ [|wrongPairCountFail|]
544 (normalB $ [|wrongPairCountFail|]
846− `appE` litE (stringL $ show tName)
545+ `appE` (litE $ stringL $ show tName)
847 `appE` ([|show . length|] `appE` varE other)
546 `appE` ([|show . length|] `appE` varE other)
848 )
547 )
849 []
548 []
850 ]
549 ]
851
550
852− parseContents tvMap conKey contents errorFun =
551+ parseContents conKey contents errorFun =
853 caseE (varE conKey)
552 caseE (varE conKey)
854 [ match wildP
553 [ match wildP
855 ( guardedB $
554 ( guardedB $
@@ -857,8 +556,7 @@ consFromJSON jc tName opts instTys cons = do
857 [|(==)|]
556 [|(==)|]
858 ([|T.pack|] `appE`
557 ([|T.pack|] `appE`
859 conNameExp opts con)
558 conNameExp opts con)
860− e <- checkExi tvMap con $
861− parseArgs jc tvMap tName opts con contents
559+ e <- parseArgs tName opts con contents
862 return (g, e)
560 return (g, e)
863 | con <- cons
561 | con <- cons
864 ]
562 ]
@@ -866,12 +564,12 @@ consFromJSON jc tName opts instTys cons = do
866 [ liftM2 (,)
564 [ liftM2 (,)
867 (normalG [e|otherwise|])
565 (normalG [e|otherwise|])
868 ( varE errorFun
566 ( varE errorFun
869− `appE` litE (stringL $ show tName)
567+ `appE` (litE $ stringL $ show tName)
870 `appE` listE (map ( litE
568 `appE` listE (map ( litE
871 . stringL
569 . stringL
872 . constructorTagModifier opts
570 . constructorTagModifier opts
873 . nameBase
571 . nameBase
874− . constructorName
572+ . getConName
875 ) cons
573 ) cons
876 )
574 )
877 `appE` ([|T.unpack|] `appE` varE conKey)
575 `appE` ([|T.unpack|] `appE` varE conKey)
@@ -885,13 +583,13 @@ parseNullaryMatches :: Name -> Name -> [Q Match]
885parseNullaryMatches tName conName =
583parseNullaryMatches tName conName =
886 [ do arr <- newName "arr"
584 [ do arr <- newName "arr"
887 match (conP 'Array [varP arr])
585 match (conP 'Array [varP arr])
888− (guardedB
586+ (guardedB $
889 [ liftM2 (,) (normalG $ [|V.null|] `appE` varE arr)
587 [ liftM2 (,) (normalG $ [|V.null|] `appE` varE arr)
890 ([|pure|] `appE` conE conName)
588 ([|pure|] `appE` conE conName)
891 , liftM2 (,) (normalG [|otherwise|])
589 , liftM2 (,) (normalG [|otherwise|])
892 (parseTypeMismatch tName conName
590 (parseTypeMismatch tName conName
893 (litE $ stringL "an empty Array")
591 (litE $ stringL "an empty Array")
894− (infixApp (litE $ stringL "Array of length ")
592+ (infixApp (litE $ stringL $ "Array of length ")
895 [|(++)|]
593 [|(++)|]
896 ([|show . V.length|] `appE` varE arr)
594 ([|show . V.length|] `appE` varE arr)
897 )
595 )
@@ -902,60 +600,30 @@ parseNullaryMatches tName conName =
902 , matchFailed tName conName "Array"
600 , matchFailed tName conName "Array"
903 ]
601 ]
904
602
905−parseUnaryMatches :: JSONClass -> TyVarMap -> Type -> Name -> [Q Match]
603+parseUnaryMatches :: Name -> [Q Match]
906−parseUnaryMatches jc tvMap argTy conName =
604+parseUnaryMatches conName =
907 [ do arg <- newName "arg"
605 [ do arg <- newName "arg"
908 match (varP arg)
606 match (varP arg)
909 ( normalB $ infixApp (conE conName)
607 ( normalB $ infixApp (conE conName)
910 [|(<$>)|]
608 [|(<$>)|]
911− (dispatchParseJSON jc conName tvMap argTy
912− `appE` varE arg)
609+ ([|parseJSON|] `appE` varE arg)
913 )
610 )
914 []
611 []
915 ]
612 ]
916
613
917−parseRecord :: JSONClass
614+parseRecord :: Options -> Name -> Name -> [VarStrictType] -> Name -> ExpQ
918− -> TyVarMap
919− -> [Type]
920− -> Options
921− -> Name
922− -> Name
923− -> [Name]
924− -> Name
925− -> Bool
926− -> ExpQ
927−parseRecord jc tvMap argTys opts tName conName fields obj inTaggedObject =
615+parseRecord opts tName conName ts obj =
928− (if rejectUnknownFields opts
929− then infixApp checkUnknownRecords [|(>>)|]
930− else id) $
931 foldl' (\a b -> infixApp a [|(<*>)|] b)
616 foldl' (\a b -> infixApp a [|(<*>)|] b)
932 (infixApp (conE conName) [|(<$>)|] x)
617 (infixApp (conE conName) [|(<$>)|] x)
933 xs
618 xs
934 where
619 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− ]
951 x:xs = [ [|lookupField|]
620 x:xs = [ [|lookupField|]
952− `appE` dispatchParseJSON jc conName tvMap argTy
953− `appE` litE (stringL $ show tName)
621+ `appE` (litE $ stringL $ show tName)
954− `appE` litE (stringL $ constructorTagModifier opts $ nameBase conName)
622+ `appE` (litE $ stringL $ constructorTagModifier opts $ nameBase conName)
955− `appE` varE obj
623+ `appE` (varE obj)
956− `appE` ( [|T.pack|] `appE` stringE (fieldLabel opts field)
624+ `appE` ( [|T.pack|] `appE` fieldLabelExp opts field
957 )
625 )
958− | (field, argTy) <- zip fields argTys
626+ | (field, _, _) <- ts
959 ]
627 ]
960
628
961getValField :: Name -> String -> [MatchQ] -> Q Exp
629getValField :: Name -> String -> [MatchQ] -> Q Exp
@@ -964,112 +632,72 @@ getValField obj valFieldName matches = do
964 doE [ bindS (varP val) $ infixApp (varE obj)
632 doE [ bindS (varP val) $ infixApp (varE obj)
965 [|(.:)|]
633 [|(.:)|]
966 ([|T.pack|] `appE`
634 ([|T.pack|] `appE`
967− litE (stringL valFieldName))
635+ (litE $ stringL valFieldName))
968 , noBindS $ caseE (varE val) matches
636 , noBindS $ caseE (varE val) matches
969 ]
637 ]
970
638
971−matchCases :: Either (String, Name) Name -> [MatchQ] -> Q Exp
972−matchCases (Left (valFieldName, obj)) = getValField obj valFieldName
973−matchCases (Right valName) = caseE (varE valName)
974−
975-- | Generates code to parse the JSON encoding of a single constructor.
639-- | Generates code to parse the JSON encoding of a single constructor.
976−parseArgs :: JSONClass -- ^ The FromJSON variant being derived.
977− -> TyVarMap -- ^ Maps the last type variables to their decoding
978− -- function arguments.
979− -> Name -- ^ Name of the type to which the constructor belongs.
640+parseArgs :: Name -- ^ Name of the type to which the constructor belongs.
980 -> Options -- ^ Encoding options.
641 -> Options -- ^ Encoding options.
981− -> ConstructorInfo -- ^ Constructor for which to generate JSON parsing code.
642+ -> Con -- ^ Constructor for which to generate JSON parsing code.
982 -> Either (String, Name) Name -- ^ Left (valFieldName, objName) or
643 -> Either (String, Name) Name -- ^ Left (valFieldName, objName) or
983 -- Right valName
644 -- Right valName
984 -> Q Exp
645 -> Q Exp
985-- Nullary constructors.
646-- Nullary constructors.
986−parseArgs _ _ _ _
647+parseArgs tName _ (NormalC conName []) (Left (valFieldName, obj)) =
987− ConstructorInfo { constructorName = conName
648+ getValField obj valFieldName $ parseNullaryMatches tName conName
988− , constructorVariant = NormalConstructor
989− , constructorFields = [] }
990− (Left _) =
991− [|pure|] `appE` conE conName
992−parseArgs _ _ tName _
993− ConstructorInfo { constructorName = conName
994− , constructorVariant = NormalConstructor
995− , constructorFields = [] }
996− (Right valName) =
649+parseArgs tName _ (NormalC conName []) (Right valName) =
997− caseE (varE valName) $ parseNullaryMatches tName conName
650+ caseE (varE valName) $ parseNullaryMatches tName conName
998
651
999-- Unary constructors.
652-- Unary constructors.
1000−parseArgs jc tvMap _ _
653+parseArgs _ _ (NormalC conName [_]) (Left (valFieldName, obj)) =
1001− ConstructorInfo { constructorName = conName
654+ getValField obj valFieldName $ parseUnaryMatches conName
1002− , constructorVariant = NormalConstructor
655+parseArgs _ _ (NormalC conName [_]) (Right valName) =
1003− , constructorFields = [argTy] }
1004− contents = do
1005− argTy' <- resolveTypeSynonyms argTy
1006− matchCases contents $ parseUnaryMatches jc tvMap argTy' conName
656+ caseE (varE valName) $ parseUnaryMatches conName
1007
657
1008-- Polyadic constructors.
658-- Polyadic constructors.
1009−parseArgs jc tvMap tName _
659+parseArgs tName _ (NormalC conName ts) (Left (valFieldName, obj)) =
1010− ConstructorInfo { constructorName = conName
660+ getValField obj valFieldName $ parseProduct tName conName $ genericLength ts
1011− , constructorVariant = NormalConstructor
661+parseArgs tName _ (NormalC conName ts) (Right valName) =
1012− , constructorFields = argTys }
1013− contents = do
1014− argTys' <- mapM resolveTypeSynonyms argTys
1015− let len = genericLength argTys'
1016− matchCases contents $ parseProduct jc tvMap argTys' tName conName len
662+ caseE (varE valName) $ parseProduct tName conName $ genericLength ts
1017
663
1018-- Records.
664-- Records.
1019−parseArgs jc tvMap tName opts
665+parseArgs tName opts (RecC conName ts) (Left (_, obj)) =
1020− ConstructorInfo { constructorName = conName
1021− , constructorVariant = RecordConstructor fields
1022− , constructorFields = argTys }
1023− (Left (_, obj)) = do
1024− argTys' <- mapM resolveTypeSynonyms argTys
1025− parseRecord jc tvMap argTys' opts tName conName fields obj True
666+ parseRecord opts tName conName ts obj
1026−parseArgs jc tvMap tName opts
667+parseArgs tName opts (RecC conName ts) (Right valName) = do
1027− info@ConstructorInfo { constructorName = conName
1028− , constructorVariant = RecordConstructor fields
1029− , constructorFields = argTys }
1030− (Right valName) =
1031− case (unwrapUnaryRecords opts,argTys) of
1032− (True,[_])-> parseArgs jc tvMap tName opts
1033− (info{constructorVariant = NormalConstructor})
1034− (Right valName)
1035− _ -> do
1036− obj <- newName "recObj"
668+ obj <- newName "recObj"
1037− argTys' <- mapM resolveTypeSynonyms argTys
1038− caseE (varE valName)
669+ caseE (varE valName)
1039− [ match (conP 'Object [varP obj]) (normalB $
670+ [ match (conP 'Object [varP obj]) (normalB $ parseRecord opts tName conName ts obj) []
1040− parseRecord jc tvMap argTys' opts tName conName fields obj False) []
1041− , matchFailed tName conName "Object"
671+ , matchFailed tName conName "Object"
1042− ]
672+ ]
1043
673
1044-- Infix constructors. Apart from syntax these are the same as
674-- Infix constructors. Apart from syntax these are the same as
1045-- polyadic constructors.
675-- polyadic constructors.
1046−parseArgs jc tvMap tName _
676+parseArgs tName _ (InfixC _ conName _) (Left (valFieldName, obj)) =
1047− ConstructorInfo { constructorName = conName
677+ getValField obj valFieldName $ parseProduct tName conName 2
1048− , constructorVariant = InfixConstructor
678+parseArgs tName _ (InfixC _ conName _) (Right valName) =
1049− , constructorFields = argTys }
679+ caseE (varE valName) $ parseProduct tName conName 2
1050− contents = do
680+
1051− argTys' <- mapM resolveTypeSynonyms argTys
681+-- Existentially quantified constructors. We ignore the quantifiers
1052− matchCases contents $ parseProduct jc tvMap argTys' tName conName 2
682+-- and proceed with the contained constructor.
683+parseArgs tName opts (ForallC _ _ con) contents =
684+ parseArgs tName opts con contents
1053
685
1054-- | Generates code to parse the JSON encoding of an n-ary
686-- | Generates code to parse the JSON encoding of an n-ary
1055-- constructor.
687-- constructor.
1056−parseProduct :: JSONClass -- ^ The FromJSON variant being derived.
1057− -> TyVarMap -- ^ Maps the last type variables to their decoding
1058− -- function arguments.
1059− -> [Type] -- ^ The argument types of the constructor.
1060− -> Name -- ^ Name of the type to which the constructor belongs.
688+parseProduct :: Name -- ^ Name of the type to which the constructor belongs.
1061 -> Name -- ^ 'Con'structor name.
689 -> Name -- ^ 'Con'structor name.
1062 -> Integer -- ^ 'Con'structor arity.
690 -> Integer -- ^ 'Con'structor arity.
1063 -> [Q Match]
691 -> [Q Match]
1064−parseProduct jc tvMap argTys tName conName numArgs =
692+parseProduct tName conName numArgs =
1065 [ do arr <- newName "arr"
693 [ do arr <- newName "arr"
1066 -- List of: "parseJSON (arr `V.unsafeIndex` <IX>)"
694 -- List of: "parseJSON (arr `V.unsafeIndex` <IX>)"
1067− let x:xs = [ dispatchParseJSON jc conName tvMap argTy
695+ let x:xs = [ [|parseJSON|]
1068 `appE`
696 `appE`
1069 infixApp (varE arr)
697 infixApp (varE arr)
1070 [|V.unsafeIndex|]
698 [|V.unsafeIndex|]
1071 (litE $ integerL ix)
699 (litE $ integerL ix)
1072− | (argTy, ix) <- zip argTys [0 .. numArgs - 1]
700+ | ix <- [0 .. numArgs - 1]
1073 ]
701 ]
1074 match (conP 'Array [varP arr])
702 match (conP 'Array [varP arr])
1075 (normalB $ condE ( infixApp ([|V.length|] `appE` varE arr)
703 (normalB $ condE ( infixApp ([|V.length|] `appE` varE arr)
@@ -1082,7 +710,7 @@ parseProduct jc tvMap argTys tName conName numArgs =
1082 )
710 )
1083 ( parseTypeMismatch tName conName
711 ( parseTypeMismatch tName conName
1084 (litE $ stringL $ "Array of length " ++ show numArgs)
712 (litE $ stringL $ "Array of length " ++ show numArgs)
1085− ( infixApp (litE $ stringL "Array of length ")
713+ ( infixApp (litE $ stringL $ "Array of length ")
1086 [|(++)|]
714 [|(++)|]
1087 ([|show . V.length|] `appE` varE arr)
715 ([|show . V.length|] `appE` varE arr)
1088 )
716 )
@@ -1092,6 +720,7 @@ parseProduct jc tvMap argTys tName conName numArgs =
1092 , matchFailed tName conName "Array"
720 , matchFailed tName conName "Array"
1093 ]
721 ]
1094
722
723+
1095--------------------------------------------------------------------------------
724--------------------------------------------------------------------------------
1096-- Parsing errors
725-- Parsing errors
1097--------------------------------------------------------------------------------
726--------------------------------------------------------------------------------
@@ -1116,27 +745,17 @@ parseTypeMismatch tName conName expected actual =
1116 , actual
745 , actual
1117 ]
746 ]
1118
747
1119−class LookupField a where
748+class (FromJSON a) => LookupField a where
1120− lookupField :: (Value -> Parser a) -> String -> String
1121− -> Object -> T.Text -> Parser a
749+ lookupField :: String -> String -> Object -> T.Text -> Parser a
1122
750
1123−instance OVERLAPPABLE_ LookupField a where
751+instance (FromJSON a) => LookupField a where
1124− lookupField = lookupFieldWith
752+ lookupField tName rec obj key =
753+ case H.lookup key obj of
754+ Nothing -> unknownFieldFail tName rec (T.unpack key)
755+ Just v -> parseJSON v
1125
756
1126−instance INCOHERENT_ LookupField (Maybe a) where
757+instance (FromJSON a) => LookupField (Maybe a) where
1127− lookupField pj _ _ = parseOptionalFieldWith pj
758+ lookupField _ _ = (.:?)
1128−
1129−instance INCOHERENT_ LookupField (Semigroup.Option a) where
1130− lookupField pj tName rec obj key =
1131− fmap Semigroup.Option
1132− (lookupField (fmap Semigroup.getOption . pj) tName rec obj key)
1133−
1134−lookupFieldWith :: (Value -> Parser a) -> String -> String
1135− -> Object -> T.Text -> Parser a
1136−lookupFieldWith pj tName rec obj key =
1137− case H.lookup key obj of
1138− Nothing -> unknownFieldFail tName rec (T.unpack key)
1139− Just v -> pj v <?> Key key
1140
759
1141unknownFieldFail :: String -> String -> String -> Parser fail
760unknownFieldFail :: String -> String -> String -> Parser fail
1142unknownFieldFail tName rec key =
761unknownFieldFail tName rec key =
@@ -1183,596 +802,63 @@ conNotFoundFailTaggedObject t cs o =
1183 t (intercalate ", " cs) o
802 t (intercalate ", " cs) o
1184
803
1185parseTypeMismatch' :: String -> String -> String -> String -> Parser fail
804parseTypeMismatch' :: String -> String -> String -> String -> Parser fail
1186−parseTypeMismatch' conName tName expected actual =
805+parseTypeMismatch' tName conName expected actual =
1187 fail $ printf "When parsing the constructor %s of type %s expected %s but got %s."
806 fail $ printf "When parsing the constructor %s of type %s expected %s but got %s."
1188 conName tName expected actual
807 conName tName expected actual
1189
808
1190−--------------------------------------------------------------------------------
1191−-- Shared ToJSON and FromJSON code
1192−--------------------------------------------------------------------------------
1193−
1194−-- | Functionality common to 'deriveJSON', 'deriveJSON1', and 'deriveJSON2'.
1195−deriveJSONBoth :: (Options -> Name -> Q [Dec])
1196− -- ^ Function which derives a flavor of 'ToJSON'.
1197− -> (Options -> Name -> Q [Dec])
1198− -- ^ Function which derives a flavor of 'FromJSON'.
1199− -> Options
1200− -- ^ Encoding options.
1201− -> Name
1202− -- ^ Name of the type for which to generate 'ToJSON' and 'FromJSON'
1203− -- instances.
1204− -> Q [Dec]
1205−deriveJSONBoth dtj dfj opts name =
1206− liftM2 (++) (dtj opts name) (dfj opts name)
1207−
1208−-- | Functionality common to @deriveToJSON(1)(2)@ and @deriveFromJSON(1)(2)@.
1209−deriveJSONClass :: [(JSONFun, JSONClass -> Name -> Options -> [Type]
1210− -> [ConstructorInfo] -> Q Exp)]
1211− -- ^ The class methods and the functions which derive them.
1212− -> JSONClass
1213− -- ^ The class for which to generate an instance.
1214− -> Options
1215− -- ^ Encoding options.
1216− -> Name
1217− -- ^ Name of the type for which to generate a class instance
1218− -- declaration.
1219− -> Q [Dec]
1220−deriveJSONClass consFuns jc opts name = do
1221− info <- reifyDatatype name
1222− case info of
1223− DatatypeInfo { datatypeContext = ctxt
1224− , datatypeName = parentName
1225−#if MIN_VERSION_th_abstraction(0,3,0)
1226− , datatypeInstTypes = instTys
1227−#else
1228− , datatypeVars = instTys
1229−#endif
1230− , datatypeVariant = variant
1231− , datatypeCons = cons
1232− } -> do
1233− (instanceCxt, instanceType)
1234− <- buildTypeInstance parentName jc ctxt instTys variant
1235− (:[]) <$> instanceD (return instanceCxt)
1236− (return instanceType)
1237− (methodDecs parentName instTys cons)
1238− where
1239− methodDecs :: Name -> [Type] -> [ConstructorInfo] -> [Q Dec]
1240− methodDecs parentName instTys cons = flip map consFuns $ \(jf, jfMaker) ->
1241− funD (jsonFunValName jf (arity jc))
1242− [ clause []
1243− (normalB $ jfMaker jc parentName opts instTys cons)
1244− []
1245− ]
1246−
1247−mkFunCommon :: (JSONClass -> Name -> Options -> [Type] -> [ConstructorInfo] -> Q Exp)
1248− -- ^ The function which derives the expression.
1249− -> JSONClass
1250− -- ^ Which class's method is being derived.
1251− -> Options
1252− -- ^ Encoding options.
1253− -> Name
1254− -- ^ Name of the encoded type.
1255− -> Q Exp
1256−mkFunCommon consFun jc opts name = do
1257− info <- reifyDatatype name
1258− case info of
1259− DatatypeInfo { datatypeContext = ctxt
1260− , datatypeName = parentName
1261−#if MIN_VERSION_th_abstraction(0,3,0)
1262− , datatypeInstTypes = instTys
1263−#else
1264− , datatypeVars = instTys
1265−#endif
1266− , datatypeVariant = variant
1267− , datatypeCons = cons
1268− } -> do
1269− -- We force buildTypeInstance here since it performs some checks for whether
1270− -- or not the provided datatype's kind matches the derived method's
1271− -- typeclass, and produces errors if it can't.
1272− !_ <- buildTypeInstance parentName jc ctxt instTys variant
1273− consFun jc parentName opts instTys cons
1274−
1275−dispatchFunByType :: JSONClass
1276− -> JSONFun
1277− -> Name
1278− -> TyVarMap
1279− -> Bool -- True if we are using the function argument that works
1280− -- on lists (e.g., [a] -> Value). False is we are using
1281− -- the function argument that works on single values
1282− -- (e.g., a -> Value).
1283− -> Type
1284− -> Q Exp
1285−dispatchFunByType _ jf _ tvMap list (VarT tyName) =
1286− varE $ case M.lookup tyName tvMap of
1287− Just (tfjExp, tfjlExp) -> if list then tfjlExp else tfjExp
1288− Nothing -> jsonFunValOrListName list jf Arity0
1289−dispatchFunByType jc jf conName tvMap list (SigT ty _) =
1290− dispatchFunByType jc jf conName tvMap list ty
1291−dispatchFunByType jc jf conName tvMap list (ForallT _ _ ty) =
1292− dispatchFunByType jc jf conName tvMap list ty
1293−dispatchFunByType jc jf conName tvMap list ty = do
1294− let tyCon :: Type
1295− tyArgs :: [Type]
1296− tyCon :| tyArgs = unapplyTy ty
1297−
1298− numLastArgs :: Int
1299− numLastArgs = min (arityInt jc) (length tyArgs)
1300−
1301− lhsArgs, rhsArgs :: [Type]
1302− (lhsArgs, rhsArgs) = splitAt (length tyArgs - numLastArgs) tyArgs
1303−
1304− tyVarNames :: [Name]
1305− tyVarNames = M.keys tvMap
1306−
1307− itf <- isTyFamily tyCon
1308− if any (`mentionsName` tyVarNames) lhsArgs
1309− || itf && any (`mentionsName` tyVarNames) tyArgs
1310− then outOfPlaceTyVarError jc conName
1311− else if any (`mentionsName` tyVarNames) rhsArgs
1312− then appsE $ varE (jsonFunValOrListName list jf $ toEnum numLastArgs)
1313− : zipWith (dispatchFunByType jc jf conName tvMap)
1314− (cycle [False,True])
1315− (interleave rhsArgs rhsArgs)
1316− else varE $ jsonFunValOrListName list jf Arity0
1317−
1318−dispatchToJSON
1319− :: ToJSONFun -> JSONClass -> Name -> TyVarMap -> Type -> Q Exp
1320−dispatchToJSON target jc n tvMap =
1321− dispatchFunByType jc (targetToJSONFun target) n tvMap False
1322−
1323−dispatchParseJSON
1324− :: JSONClass -> Name -> TyVarMap -> Type -> Q Exp
1325−dispatchParseJSON jc n tvMap = dispatchFunByType jc ParseJSON n tvMap False
1326
809
1327--------------------------------------------------------------------------------
810--------------------------------------------------------------------------------
1328-- Utility functions
811-- Utility functions
1329--------------------------------------------------------------------------------
812--------------------------------------------------------------------------------
1330
813
1331−-- For the given Types, generate an instance context and head.
814+-- | Boilerplate for top level splices.
1332−buildTypeInstance :: Name
1333− -- ^ The type constructor or data family name
1334− -> JSONClass
1335− -- ^ The typeclass to derive
1336− -> Cxt
1337− -- ^ The datatype context
1338− -> [Type]
1339− -- ^ The types to instantiate the instance with
1340− -> DatatypeVariant
1341− -- ^ Are we dealing with a data family instance or not
1342− -> Q (Cxt, Type)
1343−buildTypeInstance tyConName jc dataCxt varTysOrig variant = do
1344− -- Make sure to expand through type/kind synonyms! Otherwise, the
1345− -- eta-reduction check might get tripped up over type variables in a
1346− -- synonym that are actually dropped.
1347− -- (See GHC Trac #11416 for a scenario where this actually happened.)
1348− varTysExp <- mapM resolveTypeSynonyms varTysOrig
1349−
1350− let remainingLength :: Int
1351− remainingLength = length varTysOrig - arityInt jc
1352−
1353− droppedTysExp :: [Type]
1354− droppedTysExp = drop remainingLength varTysExp
1355−
1356− droppedStarKindStati :: [StarKindStatus]
1357− droppedStarKindStati = map canRealizeKindStar droppedTysExp
1358−
1359− -- Check there are enough types to drop and that all of them are either of
1360− -- kind * or kind k (for some kind variable k). If not, throw an error.
1361− when (remainingLength < 0 || elem NotKindStar droppedStarKindStati) $
1362− derivingKindError jc tyConName
1363−
1364− let droppedKindVarNames :: [Name]
1365− droppedKindVarNames = catKindVarNames droppedStarKindStati
1366−
1367− -- Substitute kind * for any dropped kind variables
1368− varTysExpSubst :: [Type]
1369− varTysExpSubst = map (substNamesWithKindStar droppedKindVarNames) varTysExp
1370−
1371− remainingTysExpSubst, droppedTysExpSubst :: [Type]
1372− (remainingTysExpSubst, droppedTysExpSubst) =
1373− splitAt remainingLength varTysExpSubst
1374−
1375− -- All of the type variables mentioned in the dropped types
1376− -- (post-synonym expansion)
1377− droppedTyVarNames :: [Name]
1378− droppedTyVarNames = freeVariables droppedTysExpSubst
1379−
1380− -- If any of the dropped types were polykinded, ensure that they are of kind *
1381− -- after substituting * for the dropped kind variables. If not, throw an error.
1382− unless (all hasKindStar droppedTysExpSubst) $
1383− derivingKindError jc tyConName
1384−
1385− let preds :: [Maybe Pred]
1386− kvNames :: [[Name]]
1387− kvNames' :: [Name]
1388− -- Derive instance constraints (and any kind variables which are specialized
1389− -- to * in those constraints)
1390− (preds, kvNames) = unzip $ map (deriveConstraint jc) remainingTysExpSubst
1391− kvNames' = concat kvNames
1392−
1393− -- Substitute the kind variables specialized in the constraints with *
1394− remainingTysExpSubst' :: [Type]
1395− remainingTysExpSubst' =
1396− map (substNamesWithKindStar kvNames') remainingTysExpSubst
1397−
1398− -- We now substitute all of the specialized-to-* kind variable names with
1399− -- *, but in the original types, not the synonym-expanded types. The reason
1400− -- we do this is a superficial one: we want the derived instance to resemble
1401− -- the datatype written in source code as closely as possible. For example,
1402− -- for the following data family instance:
1403− --
1404− -- data family Fam a
1405− -- newtype instance Fam String = Fam String
1406− --
1407− -- We'd want to generate the instance:
1408− --
1409− -- instance C (Fam String)
1410− --
1411− -- Not:
1412− --
1413− -- instance C (Fam [Char])
1414− remainingTysOrigSubst :: [Type]
1415− remainingTysOrigSubst =
1416− map (substNamesWithKindStar (droppedKindVarNames `union` kvNames'))
1417− $ take remainingLength varTysOrig
1418−
1419− isDataFamily :: Bool
1420− isDataFamily = case variant of
1421− Datatype -> False
1422− Newtype -> False
1423− DataInstance -> True
1424− NewtypeInstance -> True
1425−
1426− remainingTysOrigSubst' :: [Type]
1427− -- See Note [Kind signatures in derived instances] for an explanation
1428− -- of the isDataFamily check.
1429− remainingTysOrigSubst' =
1430− if isDataFamily
1431− then remainingTysOrigSubst
1432− else map unSigT remainingTysOrigSubst
1433−
1434− instanceCxt :: Cxt
1435− instanceCxt = catMaybes preds
1436−
1437− instanceType :: Type
1438− instanceType = AppT (ConT $ jsonClassName jc)
1439− $ applyTyCon tyConName remainingTysOrigSubst'
1440−
1441− -- If the datatype context mentions any of the dropped type variables,
1442− -- we can't derive an instance, so throw an error.
1443− when (any (`predMentionsName` droppedTyVarNames) dataCxt) $
1444− datatypeContextError tyConName instanceType
1445− -- Also ensure the dropped types can be safely eta-reduced. Otherwise,
1446− -- throw an error.
1447− unless (canEtaReduce remainingTysExpSubst' droppedTysExpSubst) $
1448− etaReductionError instanceType
1449− return (instanceCxt, instanceType)
1450−
1451−-- | Attempt to derive a constraint on a Type. If successful, return
1452−-- Just the constraint and any kind variable names constrained to *.
1453−-- Otherwise, return Nothing and the empty list.
1454−--
1455−-- See Note [Type inference in derived instances] for the heuristics used to
1456−-- come up with constraints.
1457−deriveConstraint :: JSONClass -> Type -> (Maybe Pred, [Name])
1458−deriveConstraint jc t
1459− | not (isTyVar t) = (Nothing, [])
1460− | hasKindStar t = (Just (applyCon (jcConstraint Arity0) tName), [])
1461− | otherwise = case hasKindVarChain 1 t of
1462− Just ns | jcArity >= Arity1
1463− -> (Just (applyCon (jcConstraint Arity1) tName), ns)
1464− _ -> case hasKindVarChain 2 t of
1465− Just ns | jcArity == Arity2
1466− -> (Just (applyCon (jcConstraint Arity2) tName), ns)
1467− _ -> (Nothing, [])
1468− where
1469− tName :: Name
1470− tName = varTToName t
1471−
1472− jcArity :: Arity
1473− jcArity = arity jc
1474−
1475− jcConstraint :: Arity -> Name
1476− jcConstraint = jsonClassName . JSONClass (direction jc)
1477−
1478−{-
1479−Note [Kind signatures in derived instances]
1480−~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1481−
1482−It is possible to put explicit kind signatures into the derived instances, e.g.,
1483−
1484− instance C a => C (Data (f :: * -> *)) where ...
1485−
1486−But it is preferable to avoid this if possible. If we come up with an incorrect
1487−kind signature (which is entirely possible, since Template Haskell doesn't always
1488−have the best track record with reifying kind signatures), then GHC will flat-out
1489−reject the instance, which is quite unfortunate.
1490−
1491−Plain old datatypes have the advantage that you can avoid using any kind signatures
1492−at all in their instances. This is because a datatype declaration uses all type
1493−variables, so the types that we use in a derived instance uniquely determine their
1494−kinds. As long as we plug in the right types, the kind inferencer can do the rest
1495−of the work. For this reason, we use unSigT to remove all kind signatures before
1496−splicing in the instance context and head.
1497−
1498−Data family instances are trickier, since a data family can have two instances that
1499−are distinguished by kind alone, e.g.,
1500−
1501− data family Fam (a :: k)
1502− data instance Fam (a :: * -> *)
1503− data instance Fam (a :: *)
1504−
1505−If we dropped the kind signatures for C (Fam a), then GHC will have no way of
1506−knowing which instance we are talking about. To avoid this scenario, we always
1507−include explicit kind signatures in data family instances. There is a chance that
1508−the inferred kind signatures will be incorrect, but if so, we can always fall back
1509−on the mk- functions.
1510−
1511−Note [Type inference in derived instances]
1512−~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1513−
1514−Type inference is can be tricky to get right, and we want to avoid recreating the
1515−entirety of GHC's type inferencer in Template Haskell. For this reason, we will
1516−probably never come up with derived instance contexts that are as accurate as
1517−GHC's. But that doesn't mean we can't do anything! There are a couple of simple
1518−things we can do to make instance contexts that work for 80% of use cases:
1519−
1520−1. If one of the last type parameters is polykinded, then its kind will be
1521− specialized to * in the derived instance. We note what kind variable the type
1522− parameter had and substitute it with * in the other types as well. For example,
1523− imagine you had
1524−
1525− data Data (a :: k) (b :: k)
1526−
1527− Then you'd want to derived instance to be:
1528−
1529− instance C (Data (a :: *))
1530−
1531− Not:
1532−
1533− instance C (Data (a :: k))
1534−
1535−2. We naïvely come up with instance constraints using the following criteria:
1536−
1537− (i) If there's a type parameter n of kind *, generate a ToJSON n/FromJSON n
1538− constraint.
1539− (ii) If there's a type parameter n of kind k1 -> k2 (where k1/k2 are * or kind
1540− variables), then generate a ToJSON1 n/FromJSON1 n constraint, and if
1541− k1/k2 are kind variables, then substitute k1/k2 with * elsewhere in the
1542− types. We must consider the case where they are kind variables because
1543− you might have a scenario like this:
1544−
1545− newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1)
1546− = Compose (f (g a))
1547−
1548− Which would have a derived ToJSON1 instance of:
1549−
1550− instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where ...
1551− (iii) If there's a type parameter n of kind k1 -> k2 -> k3 (where k1/k2/k3 are
1552− * or kind variables), then generate a ToJSON2 n/FromJSON2 n constraint
1553− and perform kind substitution as in the other cases.
1554−-}
1555−
1556−checkExistentialContext :: JSONClass -> TyVarMap -> Cxt -> Name
1557− -> Q a -> Q a
1558−checkExistentialContext jc tvMap ctxt conName q =
1559− if (any (`predMentionsName` M.keys tvMap) ctxt
1560− || M.size tvMap < arityInt jc)
1561− && not (allowExQuant jc)
1562− then existentialContextError conName
1563− else q
1564−
1565−{-
1566−Note [Matching functions with GADT type variables]
1567−~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1568−
1569−When deriving ToJSON2, there is a tricky corner case to consider:
1570−
1571− data Both a b where
1572− BothCon :: x -> x -> Both x x
1573−
1574−Which encoding functions should be applied to which arguments of BothCon?
1575−We have a choice, since both the function of type (a -> Value) and of type
1576−(b -> Value) can be applied to either argument. In such a scenario, the
1577−second encoding function takes precedence over the first encoding function, so the
1578−derived ToJSON2 instance would be something like:
1579−
1580− instance ToJSON2 Both where
1581− liftToJSON2 tj1 tj2 p (BothCon x1 x2) = Array $ create $ do
1582− mv <- unsafeNew 2
1583− unsafeWrite mv 0 (tj1 x1)
1584− unsafeWrite mv 1 (tj2 x2)
1585− return mv
1586−
1587−This is not an arbitrary choice, as this definition ensures that
1588−liftToJSON2 toJSON = liftToJSON for a derived ToJSON1 instance for
1589−Both.
1590−-}
1591−
1592−-- A mapping of type variable Names to their encoding/decoding function Names.
1593−-- For example, in a ToJSON2 declaration, a TyVarMap might look like
1594--
815--
1595−-- { a ~> (tj1, tjl1)
816+-- The given 'Name' must be from a type constructor. Furthermore, the
1596−-- , b ~> (tj2, tjl2) }
817+-- type constructor must be either a data type or a newtype. Any other
1597−--
818+-- value will result in an exception.
1598−-- where a and b are the last two type variables of the datatype, tj1 and tjl1 are
819+withType :: Name
1599−-- the function arguments of types (a -> Value) and ([a] -> Value), and tj2 and tjl2
820+ -> ([TyVarBndr] -> [Con] -> Q a)
1600−-- are the function arguments of types (b -> Value) and ([b] -> Value).
821+ -- ^ Function that generates the actual code. Will be applied
1601−type TyVarMap = Map Name (Name, Name)
822+ -- to the type variable binders and constructors extracted
1602−
823+ -- from the given 'Name'.
1603−-- | Returns True if a Type has kind *.
824+ -> Q a
1604−hasKindStar :: Type -> Bool
825+ -- ^ Resulting value in the 'Q'uasi monad.
1605−hasKindStar VarT{} = True
826+withType name f = do
1606−hasKindStar (SigT _ StarT) = True
1607−hasKindStar _ = False
1608−
1609−-- Returns True is a kind is equal to *, or if it is a kind variable.
1610−isStarOrVar :: Kind -> Bool
1611−isStarOrVar StarT = True
1612−isStarOrVar VarT{} = True
1613−isStarOrVar _ = False
1614−
1615−-- Generate a list of fresh names with a common prefix, and numbered suffixes.
1616−newNameList :: String -> Int -> Q [Name]
1617−newNameList prefix len = mapM newName [prefix ++ show n | n <- [1..len]]
1618−
1619−-- | @hasKindVarChain n kind@ Checks if @kind@ is of the form
1620−-- k_0 -> k_1 -> ... -> k_(n-1), where k0, k1, ..., and k_(n-1) can be * or
1621−-- kind variables.
1622−hasKindVarChain :: Int -> Type -> Maybe [Name]
1623−hasKindVarChain kindArrows t =
1624− let uk = uncurryKind (tyKind t)
1625− in if (NE.length uk - 1 == kindArrows) && F.all isStarOrVar uk
1626− then Just (concatMap freeVariables uk)
1627− else Nothing
1628−
1629−-- | If a Type is a SigT, returns its kind signature. Otherwise, return *.
1630−tyKind :: Type -> Kind
1631−tyKind (SigT _ k) = k
1632−tyKind _ = starK
1633−
1634−-- | Extract Just the Name from a type variable. If the argument Type is not a
1635−-- type variable, return Nothing.
1636−varTToNameMaybe :: Type -> Maybe Name
1637−varTToNameMaybe (VarT n) = Just n
1638−varTToNameMaybe (SigT t _) = varTToNameMaybe t
1639−varTToNameMaybe _ = Nothing
1640−
1641−-- | Extract the Name from a type variable. If the argument Type is not a
1642−-- type variable, throw an error.
1643−varTToName :: Type -> Name
1644−varTToName = fromMaybe (error "Not a type variable!") . varTToNameMaybe
1645−
1646−interleave :: [a] -> [a] -> [a]
1647−interleave (a1:a1s) (a2:a2s) = a1:a2:interleave a1s a2s
1648−interleave _ _ = []
1649−
1650−-- | Fully applies a type constructor to its type variables.
1651−applyTyCon :: Name -> [Type] -> Type
1652−applyTyCon = foldl' AppT . ConT
1653−
1654−-- | Is the given type a variable?
1655−isTyVar :: Type -> Bool
1656−isTyVar (VarT _) = True
1657−isTyVar (SigT t _) = isTyVar t
1658−isTyVar _ = False
1659−
1660−-- | Is the given type a type family constructor (and not a data family constructor)?
1661−isTyFamily :: Type -> Q Bool
1662−isTyFamily (ConT n) = do
1663− info <- reify n
827+ info <- reify name
1664− return $ case info of
828+ case info of
1665−#if MIN_VERSION_template_haskell(2,11,0)
829+ TyConI dec ->
1666− FamilyI OpenTypeFamilyD{} _ -> True
830+ case dec of
1667−#else
831+ DataD _ _ tvbs cons _ -> f tvbs cons
1668− FamilyI (FamilyD TypeFam _ _ _) _ -> True
832+ NewtypeD _ _ tvbs con _ -> f tvbs [con]
1669−#endif
833+ other -> error $ "Data.Aeson.TH.withType: Unsupported type: "
1670− FamilyI ClosedTypeFamilyD{} _ -> True
834+ ++ show other
1671− _ -> False
835+ _ -> error "Data.Aeson.TH.withType: I need the name of a type."
1672−isTyFamily _ = return False
836+
1673−
837+-- | Extracts the name from a constructor.
1674−-- | Peel off a kind signature from a Type (if it has one).
838+getConName :: Con -> Name
1675−unSigT :: Type -> Type
839+getConName (NormalC name _) = name
1676−unSigT (SigT t _) = t
840+getConName (RecC name _) = name
1677−unSigT t = t
841+getConName (InfixC _ name _) = name
1678−
842+getConName (ForallC _ _ con) = getConName con
1679−-- | Are all of the items in a list (which have an ordering) distinct?
843+
1680−--
844+-- | Extracts the name from a type variable binder.
1681−-- This uses Set (as opposed to nub) for better asymptotic time complexity.
845+tvbName :: TyVarBndr -> Name
1682−allDistinct :: Ord a => [a] -> Bool
846+tvbName (PlainTV name ) = name
1683−allDistinct = allDistinct' Set.empty
847+tvbName (KindedTV name _) = name
1684− where
1685− allDistinct' :: Ord a => Set a -> [a] -> Bool
1686− allDistinct' uniqs (x:xs)
1687− | x `Set.member` uniqs = False
1688− | otherwise = allDistinct' (Set.insert x uniqs) xs
1689− allDistinct' _ _ = True
1690−
1691−-- | Does the given type mention any of the Names in the list?
1692−mentionsName :: Type -> [Name] -> Bool
1693−mentionsName = go
1694− where
1695− go :: Type -> [Name] -> Bool
1696− go (AppT t1 t2) names = go t1 names || go t2 names
1697− go (SigT t _k) names = go t names
1698− || go _k names
1699− go (VarT n) names = n `elem` names
1700− go _ _ = False
1701−
1702−-- | Does an instance predicate mention any of the Names in the list?
1703−predMentionsName :: Pred -> [Name] -> Bool
1704−#if MIN_VERSION_template_haskell(2,10,0)
1705−predMentionsName = mentionsName
1706−#else
1707−predMentionsName (ClassP n tys) names = n `elem` names || any (`mentionsName` names) tys
1708−predMentionsName (EqualP t1 t2) names = mentionsName t1 names || mentionsName t2 names
1709−#endif
1710−
1711−-- | Split an applied type into its individual components. For example, this:
1712−--
1713−-- @
1714−-- Either Int Char
1715−-- @
1716−--
1717−-- would split to this:
1718−--
1719−-- @
1720−-- [Either, Int, Char]
1721−-- @
1722−unapplyTy :: Type -> NonEmpty Type
1723−unapplyTy = NE.reverse . go
1724− where
1725− go :: Type -> NonEmpty Type
1726− go (AppT t1 t2) = t2 <| go t1
1727− go (SigT t _) = go t
1728− go (ForallT _ _ t) = go t
1729− go t = t :| []
1730−
1731−-- | Split a type signature by the arrows on its spine. For example, this:
1732−--
1733−-- @
1734−-- forall a b. (a ~ b) => (a -> b) -> Char -> ()
1735−-- @
1736−--
1737−-- would split to this:
1738−--
1739−-- @
1740−-- (a ~ b, [a -> b, Char, ()])
1741−-- @
1742−uncurryTy :: Type -> (Cxt, NonEmpty Type)
1743−uncurryTy (AppT (AppT ArrowT t1) t2) =
1744− let (ctxt, tys) = uncurryTy t2
1745− in (ctxt, t1 <| tys)
1746−uncurryTy (SigT t _) = uncurryTy t
1747−uncurryTy (ForallT _ ctxt t) =
1748− let (ctxt', tys) = uncurryTy t
1749− in (ctxt ++ ctxt', tys)
1750−uncurryTy t = ([], t :| [])
1751−
1752−-- | Like uncurryType, except on a kind level.
1753−uncurryKind :: Kind -> NonEmpty Kind
1754−uncurryKind = snd . uncurryTy
1755−
1756−createKindChain :: Int -> Kind
1757−createKindChain = go starK
1758− where
1759− go :: Kind -> Int -> Kind
1760− go k 0 = k
1761− go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)
1762
848
1763-- | Makes a string literal expression from a constructor's name.
849-- | Makes a string literal expression from a constructor's name.
1764−conNameExp :: Options -> ConstructorInfo -> Q Exp
850+conNameExp :: Options -> Con -> Q Exp
1765conNameExp opts = litE
851conNameExp opts = litE
1766 . stringL
852 . stringL
1767 . constructorTagModifier opts
853 . constructorTagModifier opts
1768 . nameBase
854 . nameBase
1769− . constructorName
855+ . getConName
1770
856
1771−-- | Extracts a record field label.
857+-- | Creates a string literal expression from a record field label.
1772−fieldLabel :: Options -- ^ Encoding options
858+fieldLabelExp :: Options -- ^ Encoding options
1773− -> Name
859+ -> Name
1774− -> String
860+ -> Q Exp
1775−fieldLabel opts = fieldLabelModifier opts . nameBase
861+fieldLabelExp opts = litE . stringL . fieldLabelModifier opts . nameBase
1776
862
1777-- | The name of the outermost 'Value' constructor.
863-- | The name of the outermost 'Value' constructor.
1778valueConName :: Value -> String
864valueConName :: Value -> String
@@ -1783,209 +869,11 @@ valueConName (Number _) = "Number"
1783valueConName (Bool _) = "Boolean"
869valueConName (Bool _) = "Boolean"
1784valueConName Null = "Null"
870valueConName Null = "Null"
1785
871
1786−applyCon :: Name -> Name -> Pred
872+applyCon :: Name -> [Name] -> Q [Pred]
1787−applyCon con t =
873+applyCon con typeNames = return (map apply typeNames)
874+ where apply t =
1788#if MIN_VERSION_template_haskell(2,10,0)
875#if MIN_VERSION_template_haskell(2,10,0)
1789 AppT (ConT con) (VarT t)
876 AppT (ConT con) (VarT t)
1790#else
877#else
1791 ClassP con [VarT t]
878 ClassP con [VarT t]
1792#endif
879#endif
1793−
1794−-- | Checks to see if the last types in a data family instance can be safely eta-
1795−-- reduced (i.e., dropped), given the other types. This checks for three conditions:
1796−--
1797−-- (1) All of the dropped types are type variables
1798−-- (2) All of the dropped types are distinct
1799−-- (3) None of the remaining types mention any of the dropped types
1800−canEtaReduce :: [Type] -> [Type] -> Bool
1801−canEtaReduce remaining dropped =
1802− all isTyVar dropped
1803− && allDistinct droppedNames -- Make sure not to pass something of type [Type], since Type
1804− -- didn't have an Ord instance until template-haskell-2.10.0.0
1805− && not (any (`mentionsName` droppedNames) remaining)
1806− where
1807− droppedNames :: [Name]
1808− droppedNames = map varTToName dropped
1809−
1810−-------------------------------------------------------------------------------
1811−-- Expanding type synonyms
1812−-------------------------------------------------------------------------------
1813−
1814−applySubstitutionKind :: Map Name Kind -> Type -> Type
1815−applySubstitutionKind = applySubstitution
1816−
1817−substNameWithKind :: Name -> Kind -> Type -> Type
1818−substNameWithKind n k = applySubstitutionKind (M.singleton n k)
1819−
1820−substNamesWithKindStar :: [Name] -> Type -> Type
1821−substNamesWithKindStar ns t = foldr' (`substNameWithKind` starK) t ns
1822−
1823−-------------------------------------------------------------------------------
1824−-- Error messages
1825−-------------------------------------------------------------------------------
1826−
1827−-- | Either the given data type doesn't have enough type variables, or one of
1828−-- the type variables to be eta-reduced cannot realize kind *.
1829−derivingKindError :: JSONClass -> Name -> Q a
1830−derivingKindError jc tyConName = fail
1831− . showString "Cannot derive well-kinded instance of form ‘"
1832− . showString className
1833− . showChar ' '
1834− . showParen True
1835− ( showString (nameBase tyConName)
1836− . showString " ..."
1837− )
1838− . showString "‘\n\tClass "
1839− . showString className
1840− . showString " expects an argument of kind "
1841− . showString (pprint . createKindChain $ arityInt jc)
1842− $ ""
1843− where
1844− className :: String
1845− className = nameBase $ jsonClassName jc
1846−
1847−-- | One of the last type variables cannot be eta-reduced (see the canEtaReduce
1848−-- function for the criteria it would have to meet).
1849−etaReductionError :: Type -> Q a
1850−etaReductionError instanceType = fail $
1851− "Cannot eta-reduce to an instance of form \n\tinstance (...) => "
1852− ++ pprint instanceType
1853−
1854−-- | The data type has a DatatypeContext which mentions one of the eta-reduced
1855−-- type variables.
1856−datatypeContextError :: Name -> Type -> Q a
1857−datatypeContextError dataName instanceType = fail
1858− . showString "Can't make a derived instance of ‘"
1859− . showString (pprint instanceType)
1860− . showString "‘:\n\tData type ‘"
1861− . showString (nameBase dataName)
1862− . showString "‘ must not have a class context involving the last type argument(s)"
1863− $ ""
1864−
1865−-- | The data type mentions one of the n eta-reduced type variables in a place other
1866−-- than the last nth positions of a data type in a constructor's field.
1867−outOfPlaceTyVarError :: JSONClass -> Name -> a
1868−outOfPlaceTyVarError jc conName = error
1869− . showString "Constructor ‘"
1870− . showString (nameBase conName)
1871− . showString "‘ must only use its last "
1872− . shows n
1873− . showString " type variable(s) within the last "
1874− . shows n
1875− . showString " argument(s) of a data type"
1876− $ ""
1877− where
1878− n :: Int
1879− n = arityInt jc
1880−
1881−-- | The data type has an existential constraint which mentions one of the
1882−-- eta-reduced type variables.
1883−existentialContextError :: Name -> a
1884−existentialContextError conName = error
1885− . showString "Constructor ‘"
1886− . showString (nameBase conName)
1887− . showString "‘ must be truly polymorphic in the last argument(s) of the data type"
1888− $ ""
1889−
1890−-------------------------------------------------------------------------------
1891−-- Class-specific constants
1892−-------------------------------------------------------------------------------
1893−
1894−-- | A representation of the arity of the ToJSON/FromJSON typeclass being derived.
1895−data Arity = Arity0 | Arity1 | Arity2
1896− deriving (Enum, Eq, Ord)
1897−
1898−-- | Whether ToJSON(1)(2) or FromJSON(1)(2) is being derived.
1899−data Direction = To | From
1900−
1901−-- | A representation of which typeclass method is being spliced in.
1902−data JSONFun = ToJSON | ToEncoding | ParseJSON
1903−
1904−-- | A refinement of JSONFun to [ToJSON, ToEncoding].
1905−data ToJSONFun = Value | Encoding
1906−
1907−targetToJSONFun :: ToJSONFun -> JSONFun
1908−targetToJSONFun Value = ToJSON
1909−targetToJSONFun Encoding = ToEncoding
1910−
1911−-- | A representation of which typeclass is being derived.
1912−data JSONClass = JSONClass { direction :: Direction, arity :: Arity }
1913−
1914−toJSONClass, toJSON1Class, toJSON2Class,
1915− fromJSONClass, fromJSON1Class, fromJSON2Class :: JSONClass
1916−toJSONClass = JSONClass To Arity0
1917−toJSON1Class = JSONClass To Arity1
1918−toJSON2Class = JSONClass To Arity2
1919−fromJSONClass = JSONClass From Arity0
1920−fromJSON1Class = JSONClass From Arity1
1921−fromJSON2Class = JSONClass From Arity2
1922−
1923−jsonClassName :: JSONClass -> Name
1924−jsonClassName (JSONClass To Arity0) = ''ToJSON
1925−jsonClassName (JSONClass To Arity1) = ''ToJSON1
1926−jsonClassName (JSONClass To Arity2) = ''ToJSON2
1927−jsonClassName (JSONClass From Arity0) = ''FromJSON
1928−jsonClassName (JSONClass From Arity1) = ''FromJSON1
1929−jsonClassName (JSONClass From Arity2) = ''FromJSON2
1930−
1931−jsonFunValName :: JSONFun -> Arity -> Name
1932−jsonFunValName ToJSON Arity0 = 'toJSON
1933−jsonFunValName ToJSON Arity1 = 'liftToJSON
1934−jsonFunValName ToJSON Arity2 = 'liftToJSON2
1935−jsonFunValName ToEncoding Arity0 = 'toEncoding
1936−jsonFunValName ToEncoding Arity1 = 'liftToEncoding
1937−jsonFunValName ToEncoding Arity2 = 'liftToEncoding2
1938−jsonFunValName ParseJSON Arity0 = 'parseJSON
1939−jsonFunValName ParseJSON Arity1 = 'liftParseJSON
1940−jsonFunValName ParseJSON Arity2 = 'liftParseJSON2
1941−
1942−jsonFunListName :: JSONFun -> Arity -> Name
1943−jsonFunListName ToJSON Arity0 = 'toJSONList
1944−jsonFunListName ToJSON Arity1 = 'liftToJSONList
1945−jsonFunListName ToJSON Arity2 = 'liftToJSONList2
1946−jsonFunListName ToEncoding Arity0 = 'toEncodingList
1947−jsonFunListName ToEncoding Arity1 = 'liftToEncodingList
1948−jsonFunListName ToEncoding Arity2 = 'liftToEncodingList2
1949−jsonFunListName ParseJSON Arity0 = 'parseJSONList
1950−jsonFunListName ParseJSON Arity1 = 'liftParseJSONList
1951−jsonFunListName ParseJSON Arity2 = 'liftParseJSONList2
1952−
1953−jsonFunValOrListName :: Bool -- e.g., toJSONList if True, toJSON if False
1954− -> JSONFun -> Arity -> Name
1955−jsonFunValOrListName False = jsonFunValName
1956−jsonFunValOrListName True = jsonFunListName
1957−
1958−arityInt :: JSONClass -> Int
1959−arityInt = fromEnum . arity
1960−
1961−allowExQuant :: JSONClass -> Bool
1962−allowExQuant (JSONClass To _) = True
1963−allowExQuant _ = False
1964−
1965−-------------------------------------------------------------------------------
1966−-- StarKindStatus
1967−-------------------------------------------------------------------------------
1968−
1969−-- | Whether a type is not of kind *, is of kind *, or is a kind variable.
1970−data StarKindStatus = NotKindStar
1971− | KindStar
1972− | IsKindVar Name
1973− deriving Eq
1974−
1975−-- | Does a Type have kind * or k (for some kind variable k)?
1976−canRealizeKindStar :: Type -> StarKindStatus
1977−canRealizeKindStar t = case t of
1978− _ | hasKindStar t -> KindStar
1979− SigT _ (VarT k) -> IsKindVar k
1980− _ -> NotKindStar
1981−
1982−-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
1983−-- Otherwise, returns 'Nothing'.
1984−starKindStatusToName :: StarKindStatus -> Maybe Name
1985−starKindStatusToName (IsKindVar n) = Just n
1986−starKindStatusToName _ = Nothing
1987−
1988−-- | Concat together all of the StarKindStatuses that are IsKindVar and extract
1989−-- the kind variables' Names out.
1990−catKindVarNames :: [StarKindStatus] -> [Name]
1991−catKindVarNames = mapMaybe starKindStatusToName
Data/Aeson/Text.hsdeleted−102
@@ -1,102 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−-- |
5−-- Module: Data.Aeson.Text
6−-- Copyright: (c) 2012-2016 Bryan O'Sullivan
7−-- (c) 2011 MailRank, Inc.
8−-- License: BSD3
9−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
10−-- Stability: experimental
11−-- Portability: portable
12−--
13−-- Most frequently, you'll probably want to encode straight to UTF-8
14−-- (the standard JSON encoding) using 'encode'.
15−--
16−-- You can use the conversions to 'Builder's when embedding JSON messages as
17−-- parts of a protocol.
18−
19−module Data.Aeson.Text
20− (
21− encodeToLazyText
22− , encodeToTextBuilder
23− ) where
24−
25−import Prelude.Compat
26−
27−import Data.Aeson.Types (Value(..), ToJSON(..))
28−import Data.Aeson.Encoding (encodingToLazyByteString)
29−import Data.Semigroup ((<>))
30−import Data.Scientific (FPFormat(..), Scientific, base10Exponent)
31−import Data.Text.Lazy.Builder
32−import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
33−import Numeric (showHex)
34−import qualified Data.HashMap.Strict as H
35−import qualified Data.Text as T
36−import qualified Data.Text.Lazy as LT
37−import qualified Data.Text.Lazy.Encoding as LT
38−import qualified Data.Vector as V
39−
40−-- | Encode a JSON 'Value' to a "Data.Text.Lazy"
41−--
42−-- /Note:/ uses 'toEncoding'
43−encodeToLazyText :: ToJSON a => a -> LT.Text
44−encodeToLazyText = LT.decodeUtf8 . encodingToLazyByteString . toEncoding
45−
46−-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
47−-- embedded efficiently in a text-based protocol.
48−--
49−-- If you are going to immediately encode straight to a
50−-- 'L.ByteString', it is more efficient to use 'encode' (lazy ByteString)
51−-- or @'fromEncoding' . 'toEncoding'@ (ByteString.Builder) instead.
52−--
53−-- /Note:/ Uses 'toJSON'
54−encodeToTextBuilder :: ToJSON a => a -> Builder
55−encodeToTextBuilder =
56− go . toJSON
57− where
58− go Null = {-# SCC "go/Null" #-} "null"
59− go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"
60− go (Number s) = {-# SCC "go/Number" #-} fromScientific s
61− go (String s) = {-# SCC "go/String" #-} string s
62− go (Array v)
63− | V.null v = {-# SCC "go/Array" #-} "[]"
64− | otherwise = {-# SCC "go/Array" #-}
65− singleton '[' <>
66− go (V.unsafeHead v) <>
67− V.foldr f (singleton ']') (V.unsafeTail v)
68− where f a z = singleton ',' <> go a <> z
69− go (Object m) = {-# SCC "go/Object" #-}
70− case H.toList m of
71− (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs
72− _ -> "{}"
73− where f a z = singleton ',' <> one a <> z
74− one (k,v) = string k <> singleton ':' <> go v
75−
76−string :: T.Text -> Builder
77−string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'
78− where
79− quote q = case T.uncons t of
80− Nothing -> fromText h
81− Just (!c,t') -> fromText h <> escape c <> quote t'
82− where (h,t) = {-# SCC "break" #-} T.break isEscape q
83− isEscape c = c == '\"' ||
84− c == '\\' ||
85− c < '\x20'
86− escape '\"' = "\\\""
87− escape '\\' = "\\\\"
88− escape '\n' = "\\n"
89− escape '\r' = "\\r"
90− escape '\t' = "\\t"
91−
92− escape c
93− | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
94− | otherwise = singleton c
95− where h = showHex (fromEnum c) ""
96−
97−fromScientific :: Scientific -> Builder
98−fromScientific s = formatScientificBuilder format prec s
99− where
100− (format, prec)
101− | base10Exponent s < 0 = (Generic, Nothing)
102− | otherwise = (Fixed, Just 0)
Data/Aeson/Types.hs+9−104
@@ -1,9 +1,8 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2-- |
1-- |
3-- Module: Data.Aeson.Types
2-- Module: Data.Aeson.Types
4−-- Copyright: (c) 2011-2016 Bryan O'Sullivan
3+-- Copyright: (c) 2011, 2012 Bryan O'Sullivan
5-- (c) 2011 MailRank, Inc.
4-- (c) 2011 MailRank, Inc.
6−-- License: BSD3
5+-- License: Apache
7-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Stability: experimental
7-- Stability: experimental
9-- Portability: portable
8-- Portability: portable
@@ -15,9 +14,6 @@ module Data.Aeson.Types
15 -- * Core JSON types
14 -- * Core JSON types
16 Value(..)
15 Value(..)
17 , Encoding
16 , Encoding
18− , unsafeToEncoding
19− , fromEncoding
20− , Series
21 , Array
17 , Array
22 , emptyArray
18 , emptyArray
23 , Pair
19 , Pair
@@ -26,7 +22,6 @@ module Data.Aeson.Types
26 -- * Convenience types and functions
22 -- * Convenience types and functions
27 , DotNetTime(..)
23 , DotNetTime(..)
28 , typeMismatch
24 , typeMismatch
29− , unexpected
30 -- * Type conversion
25 -- * Type conversion
31 , Parser
26 , Parser
32 , Result(..)
27 , Result(..)
@@ -36,127 +31,37 @@ module Data.Aeson.Types
36 , parseEither
31 , parseEither
37 , parseMaybe
32 , parseMaybe
38 , ToJSON(..)
33 , ToJSON(..)
39− , KeyValue(..)
40 , modifyFailure
34 , modifyFailure
41− , prependFailure
42− , parserThrowError
43− , parserCatchError
44−
45− -- ** Keys for maps
46− , ToJSONKey(..)
47− , ToJSONKeyFunction(..)
48− , toJSONKeyText
49− , contramapToJSONKeyFunction
50− , FromJSONKey(..)
51− , FromJSONKeyFunction(..)
52− , fromJSONKeyCoerce
53− , coerceFromJSONKeyFunction
54− , mapFromJSONKeyFunction
55−
56− -- *** Generic keys
57− , GToJSONKey()
58− , genericToJSONKey
59− , GFromJSONKey()
60− , genericFromJSONKey
61−
62− -- ** Liftings to unary and binary type constructors
63− , FromJSON1(..)
64− , parseJSON1
65− , FromJSON2(..)
66− , parseJSON2
67− , ToJSON1(..)
68− , toJSON1
69− , toEncoding1
70− , ToJSON2(..)
71− , toJSON2
72− , toEncoding2
73
35
74 -- ** Generic JSON classes
36 -- ** Generic JSON classes
75 , GFromJSON(..)
37 , GFromJSON(..)
76− , FromArgs(..)
77− , GToJSON
38+ , GToJSON(..)
78− , GToEncoding
79− , ToArgs(..)
80− , Zero
81− , One
82 , genericToJSON
39 , genericToJSON
83− , genericLiftToJSON
84− , genericToEncoding
85− , genericLiftToEncoding
86 , genericParseJSON
40 , genericParseJSON
87− , genericLiftParseJSON
88
41
89 -- * Inspecting @'Value's@
42 -- * Inspecting @'Value's@
90 , withObject
43 , withObject
91 , withText
44 , withText
92 , withArray
45 , withArray
46+ , withNumber
93 , withScientific
47 , withScientific
94 , withBool
48 , withBool
95− , withEmbeddedJSON
96
49
97− , pairs
50+ -- * Constructors and accessors
98− , foldable
51+ , (.=)
99 , (.:)
52 , (.:)
100 , (.:?)
53 , (.:?)
101− , (.:!)
102 , (.!=)
54 , (.!=)
103 , object
55 , object
104− , parseField
105− , parseFieldMaybe
106− , parseFieldMaybe'
107− , explicitParseField
108− , explicitParseFieldMaybe
109− , explicitParseFieldMaybe'
110−
111− , listEncoding
112− , listValue
113− , listParser
114
56
115 -- * Generic and TH encoding configuration
57 -- * Generic and TH encoding configuration
116− , Options
58+ , Options(..)
117−
118− -- ** Options fields
119− -- $optionsFields
120− , fieldLabelModifier
121− , constructorTagModifier
122− , allNullaryToStringTag
123− , omitNothingFields
124− , sumEncoding
125− , unwrapUnaryRecords
126− , tagSingleConstructors
127− , rejectUnknownFields
128−
129− -- ** Options utilities
130 , SumEncoding(..)
59 , SumEncoding(..)
131 , camelTo
60 , camelTo
132− , camelTo2
133 , defaultOptions
61 , defaultOptions
134 , defaultTaggedObject
62 , 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
147 ) where
63 ) where
148
64
149−import Prelude.Compat
65+import Data.Aeson.Types.Generic ()
150−
151−import Data.Aeson.Encoding (Encoding, unsafeToEncoding, fromEncoding, Series, pairs)
152−import Data.Aeson.Types.Class
66+import Data.Aeson.Types.Instances
153import Data.Aeson.Types.Internal
67import Data.Aeson.Types.Internal
154−import Data.Foldable (toList)
155−
156−-- | Encode a 'Foldable' as a JSON array.
157−foldable :: (Foldable t, ToJSON a) => t a -> Encoding
158−foldable = toEncoding . toList
159−{-# INLINE foldable #-}
160−
161−-- $optionsFields
162−-- The functions here are in fact record fields of the 'Options' type.
Data/Aeson/Types/Class.hs+176−87
@@ -1,17 +1,10 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE FlexibleContexts #-}
1+{-# LANGUAGE DefaultSignatures, FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE GADTs #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−{-# LANGUAGE NoImplicitPrelude #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
9
2
10-- |
3-- |
11-- Module: Data.Aeson.Types.Class
4-- Module: Data.Aeson.Types.Class
12−-- Copyright: (c) 2011-2016 Bryan O'Sullivan
5+-- Copyright: (c) 2011-2015 Bryan O'Sullivan
13-- (c) 2011 MailRank, Inc.
6-- (c) 2011 MailRank, Inc.
14−-- License: BSD3
7+-- License: Apache
15-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
16-- Stability: experimental
9-- Stability: experimental
17-- Portability: portable
10-- Portability: portable
@@ -20,90 +13,186 @@
20
13
21module Data.Aeson.Types.Class
14module Data.Aeson.Types.Class
22 (
15 (
16+ -- * Type classes
23− -- * Core JSON classes
17+ -- ** Core JSON classes
24 FromJSON(..)
18 FromJSON(..)
25 , ToJSON(..)
19 , ToJSON(..)
26− -- * Liftings to unary and binary type constructors
27− , FromJSON1(..)
28− , parseJSON1
29− , FromJSON2(..)
30− , parseJSON2
31− , ToJSON1(..)
32− , toJSON1
33− , toEncoding1
34− , ToJSON2(..)
35− , toJSON2
36− , toEncoding2
37− -- * Generic JSON classes
20+ -- ** Generic JSON classes
38 , GFromJSON(..)
21 , GFromJSON(..)
39− , FromArgs(..)
40− , GToJSON
22+ , GToJSON(..)
41− , GToEncoding
42− , ToArgs(..)
43− , Zero
44− , One
45 , genericToJSON
23 , genericToJSON
46− , genericLiftToJSON
47 , genericToEncoding
24 , genericToEncoding
48− , genericLiftToEncoding
49 , genericParseJSON
25 , genericParseJSON
50− , genericLiftParseJSON
51− -- * Classes and types for map keys
52− , ToJSONKey(..)
53− , ToJSONKeyFunction(..)
54− , toJSONKeyText
55− , contramapToJSONKeyFunction
56− , FromJSONKey(..)
57− , FromJSONKeyFunction(..)
58− , fromJSONKeyCoerce
59− , coerceFromJSONKeyFunction
60− , mapFromJSONKeyFunction
61− -- ** Generic keys
62− , GToJSONKey()
63− , genericToJSONKey
64− , GFromJSONKey()
65− , genericFromJSONKey
66− -- * Object key-value pairs
67− , KeyValue(..)
68−
69− -- * List functions
70− , listEncoding
71− , listValue
72− , listParser
73−
74− -- * Inspecting @'Value's@
75− , withObject
76− , withText
77− , withArray
78− , withScientific
79− , withBool
80− , withEmbeddedJSON
81−
82− -- * Functions
83− , fromJSON
84− , ifromJSON
85− , typeMismatch
86− , unexpected
87− , parseField
88− , parseFieldMaybe
89− , parseFieldMaybe'
90− , explicitParseField
91− , explicitParseFieldMaybe
92− , explicitParseFieldMaybe'
93− -- ** Operators
94− , (.:)
95− , (.:?)
96− , (.:!)
97− , (.!=)
98 ) where
26 ) where
99
27
28+import Data.Aeson.Types.Internal
29+import GHC.Generics
100
30
101−import Data.Aeson.Types.FromJSON
31+-- | Class of generic representation types ('Rep') that can be converted to JSON.
102−import Data.Aeson.Types.Generic (One, Zero)
32+class GToJSON f where
103−import Data.Aeson.Types.ToJSON hiding (GToJSON)
33+ -- | This method (applied to 'defaultOptions') is used as the
104−import qualified Data.Aeson.Types.ToJSON as ToJSON
34+ -- default generic implementation of 'toJSON'.
105−import Data.Aeson.Types.Internal (Value)
35+ gToJSON :: Options -> f a -> Value
106−import Data.Aeson.Encoding (Encoding)
107
36
108−type GToJSON = ToJSON.GToJSON Value
37+ -- | This method (applied to 'defaultOptions') is used as the
109−type GToEncoding = ToJSON.GToJSON Encoding
38+ -- default generic implementation of 'toEncoding'.
39+ gToEncoding :: Options -> f a -> Encoding
40+
41+-- | Class of generic representation types ('Rep') that can be converted from JSON.
42+class GFromJSON f where
43+ -- | This method (applied to 'defaultOptions') is used as the
44+ -- default generic implementation of 'parseJSON'.
45+ gParseJSON :: Options -> Value -> Parser (f a)
46+
47+-- | A configurable generic JSON creator. This function applied to
48+-- 'defaultOptions' is used as the default for 'toJSON' when the type
49+-- is an instance of 'Generic'.
50+genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value
51+genericToJSON opts = gToJSON opts . from
52+
53+-- | A configurable generic JSON encoder. This function applied to
54+-- 'defaultOptions' is used as the default for 'toEncoding' when the type
55+-- is an instance of 'Generic'.
56+genericToEncoding :: (Generic a, GToJSON (Rep a)) => Options -> a -> Encoding
57+genericToEncoding opts = gToEncoding opts . from
58+
59+-- | A configurable generic JSON decoder. This function applied to
60+-- 'defaultOptions' is used as the default for 'parseJSON' when the
61+-- type is an instance of 'Generic'.
62+genericParseJSON :: (Generic a, GFromJSON (Rep a)) => Options -> Value -> Parser a
63+genericParseJSON opts = fmap to . gParseJSON opts
64+
65+-- | A type that can be converted to JSON.
66+--
67+-- An example type and instance:
68+--
69+-- @{-\# LANGUAGE OverloadedStrings #-}
70+--
71+-- data Coord = Coord { x :: Double, y :: Double }
72+--
73+-- instance ToJSON Coord where
74+-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
75+-- @
76+--
77+-- Note the use of the @OverloadedStrings@ language extension which enables
78+-- 'Text' values to be written as string literals.
79+--
80+-- Instead of manually writing your 'ToJSON' instance, there are three options
81+-- to do it automatically:
82+--
83+-- * "Data.Aeson.TH" provides template-haskell functions which will derive an
84+-- instance at compile-time. The generated instance is optimized for your type
85+-- so will probably be more efficient than the following two options:
86+--
87+-- * "Data.Aeson.Generic" provides a generic @toJSON@ function that accepts any
88+-- type which is an instance of 'Data'.
89+--
90+-- * If your compiler has support for the @DeriveGeneric@ and
91+-- @DefaultSignatures@ language extensions (GHC 7.2 and newer),
92+-- @toJSON@ will have a default generic implementation.
93+--
94+-- To use the latter option, simply add a @deriving 'Generic'@ clause to your
95+-- datatype and declare a @ToJSON@ instance for your datatype without giving a
96+-- definition for @toJSON@.
97+--
98+-- For example the previous example can be simplified to just:
99+--
100+-- @{-\# LANGUAGE DeriveGeneric \#-}
101+--
102+-- import GHC.Generics
103+--
104+-- data Coord = Coord { x :: Double, y :: Double } deriving Generic
105+--
106+-- instance ToJSON Coord
107+-- @
108+--
109+-- Note that, instead of using @DefaultSignatures@, it's also possible
110+-- to parameterize the generic encoding using 'genericToJSON' applied
111+-- to your encoding/decoding 'Options':
112+--
113+-- @
114+-- instance ToJSON Coord where
115+-- toJSON = 'genericToJSON' 'defaultOptions'
116+-- toEncoding = 'genericToEncoding' 'defaultOptions'
117+-- @
118+class ToJSON a where
119+ toJSON :: a -> Value
120+
121+ default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value
122+ toJSON = genericToJSON defaultOptions
123+
124+ toEncoding :: a -> Encoding
125+
126+ default toEncoding :: (Generic a, GToJSON (Rep a)) => a -> Encoding
127+ toEncoding = genericToEncoding defaultOptions
128+
129+-- | A type that can be converted from JSON, with the possibility of
130+-- failure.
131+--
132+-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a
133+-- conversion fail, e.g. if an 'Object' is missing a required key, or
134+-- the value is of the wrong type.
135+--
136+-- An example type and instance:
137+--
138+-- @
139+-- {-\# LANGUAGE OverloadedStrings #-}
140+--
141+-- data Coord = Coord { x :: Double, y :: Double }
142+--
143+-- instance FromJSON Coord where
144+-- parseJSON ('Object' v) = Coord '<$>'
145+-- v '.:' \"x\" '<*>'
146+-- v '.:' \"y\"
147+--
148+-- \-- A non-'Object' value is of the wrong type, so use 'mzero' to fail.
149+-- parseJSON _ = 'mzero'
150+-- @
151+--
152+-- Note the use of the @OverloadedStrings@ language extension which enables
153+-- 'Text' values to be written as string literals.
154+--
155+-- Instead of manually writing your 'FromJSON' instance, there are three options
156+-- to do it automatically:
157+--
158+-- * "Data.Aeson.TH" provides template-haskell functions which will derive an
159+-- instance at compile-time. The generated instance is optimized for your type
160+-- so will probably be more efficient than the following two options:
161+--
162+-- * "Data.Aeson.Generic" provides a generic @fromJSON@ function that parses to
163+-- any type which is an instance of 'Data'.
164+--
165+-- * If your compiler has support for the @DeriveGeneric@ and
166+-- @DefaultSignatures@ language extensions, @parseJSON@ will have a default
167+-- generic implementation.
168+--
169+-- To use this, simply add a @deriving 'Generic'@ clause to your datatype and
170+-- declare a @FromJSON@ instance for your datatype without giving a definition
171+-- for @parseJSON@.
172+--
173+-- For example the previous example can be simplified to just:
174+--
175+-- @
176+-- {-\# LANGUAGE DeriveGeneric \#-}
177+--
178+-- import GHC.Generics
179+--
180+-- data Coord = Coord { x :: Double, y :: Double } deriving Generic
181+--
182+-- instance FromJSON Coord
183+-- @
184+--
185+-- Note that, instead of using @DefaultSignatures@, it's also possible
186+-- to parameterize the generic decoding using 'genericParseJSON' applied
187+-- to your encoding/decoding 'Options':
188+--
189+-- @
190+-- instance FromJSON Coord where
191+-- parseJSON = 'genericParseJSON' 'defaultOptions'
192+-- @
193+
194+class FromJSON a where
195+ parseJSON :: Value -> Parser a
196+
197+ default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
198+ parseJSON = genericParseJSON defaultOptions
Data/Aeson/Types/FromJSON.hsdeleted−2647
@@ -1,2647 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DefaultSignatures #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE GADTs #-}
7−{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE NoImplicitPrelude #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE RecordWildCards #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
13−{-# LANGUAGE TypeOperators #-}
14−{-# LANGUAGE TupleSections #-}
15−{-# LANGUAGE UndecidableInstances #-}
16−{-# LANGUAGE ViewPatterns #-}
17−
18−#include "incoherent-compat.h"
19−#include "overlapping-compat.h"
20−
21−-- TODO: Drop this when we remove support for Data.Attoparsec.Number
22−{-# OPTIONS_GHC -fno-warn-deprecations #-}
23−
24−module Data.Aeson.Types.FromJSON
25− (
26− -- * Core JSON classes
27− FromJSON(..)
28− -- * Liftings to unary and binary type constructors
29− , FromJSON1(..)
30− , parseJSON1
31− , FromJSON2(..)
32− , parseJSON2
33− -- * Generic JSON classes
34− , GFromJSON(..)
35− , FromArgs(..)
36− , genericParseJSON
37− , genericLiftParseJSON
38− -- * Classes and types for map keys
39− , FromJSONKey(..)
40− , FromJSONKeyFunction(..)
41− , fromJSONKeyCoerce
42− , coerceFromJSONKeyFunction
43− , mapFromJSONKeyFunction
44−
45− , GFromJSONKey()
46− , genericFromJSONKey
47−
48− -- * List functions
49− , listParser
50−
51− -- * Inspecting @'Value's@
52− , withObject
53− , withText
54− , withArray
55− , withScientific
56− , withBool
57− , withEmbeddedJSON
58−
59− -- * Functions
60− , fromJSON
61− , ifromJSON
62− , typeMismatch
63− , unexpected
64− , parseField
65− , parseFieldMaybe
66− , parseFieldMaybe'
67− , explicitParseField
68− , explicitParseFieldMaybe
69− , explicitParseFieldMaybe'
70− , parseIndexedJSON
71− -- ** Operators
72− , (.:)
73− , (.:?)
74− , (.:!)
75− , (.!=)
76−
77− -- * Internal
78− , parseOptionalFieldWith
79− ) where
80−
81−import Prelude.Compat
82−
83−import Control.Applicative ((<|>), Const(..), liftA2)
84−import Control.Monad (zipWithM)
85−import Data.Aeson.Internal.Functions (mapKey)
86−import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF)
87−import Data.Aeson.Types.Generic
88−import Data.Aeson.Types.Internal
89−import Data.Bits (unsafeShiftR)
90−import Data.Fixed (Fixed, HasResolution (resolution), Nano)
91−import Data.Functor.Compose (Compose(..))
92−import Data.Functor.Identity (Identity(..))
93−import Data.Functor.Product (Product(..))
94−import Data.Functor.Sum (Sum(..))
95−import Data.Hashable (Hashable(..))
96−import Data.Int (Int16, Int32, Int64, Int8)
97−import Data.List.NonEmpty (NonEmpty(..))
98−import Data.Maybe (fromMaybe)
99−import Data.Semigroup ((<>))
100−import Data.Proxy (Proxy(..))
101−import Data.Ratio ((%), Ratio)
102−import Data.Scientific (Scientific, base10Exponent)
103−import Data.Tagged (Tagged(..))
104−import Data.Text (Text, pack, unpack)
105−import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
106−import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
107−import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
108−import Data.Time.Clock.System.Compat (SystemTime (..))
109−import Data.Time.Format.Compat (parseTimeM, defaultTimeLocale)
110−import Data.Traversable as Tr (sequence)
111−import Data.Vector (Vector)
112−import Data.Version (Version, parseVersion)
113−import Data.Void (Void)
114−import Data.Word (Word16, Word32, Word64, Word8)
115−import Foreign.Storable (Storable)
116−import Foreign.C.Types (CTime (..))
117−import GHC.Generics
118−import Numeric.Natural (Natural)
119−import Text.ParserCombinators.ReadP (readP_to_S)
120−import Unsafe.Coerce (unsafeCoerce)
121−import qualified Data.Aeson.Parser.Time as Time
122−import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
123−import qualified Data.ByteString.Lazy as L
124−import qualified Data.DList as DList
125−import qualified Data.HashMap.Strict as H
126−import qualified Data.HashSet as HashSet
127−import qualified Data.IntMap as IntMap
128−import qualified Data.IntSet as IntSet
129−import qualified Data.Map as M
130−import qualified Data.Monoid as Monoid
131−import qualified Data.Scientific as Scientific
132−import qualified Data.Semigroup as Semigroup
133−import qualified Data.Sequence as Seq
134−import qualified Data.Set as Set
135−import qualified Data.Text as T
136−import qualified Data.Text.Encoding as T
137−import qualified Data.Text.Lazy as LT
138−import qualified Data.Tree as Tree
139−import qualified Data.UUID.Types as UUID
140−import qualified Data.Vector as V
141−import qualified Data.Vector.Generic as VG
142−import qualified Data.Vector.Primitive as VP
143−import qualified Data.Vector.Storable as VS
144−import qualified Data.Vector.Unboxed as VU
145−
146−import qualified GHC.Exts as Exts
147−import qualified Data.Primitive.Array as PM
148−import qualified Data.Primitive.SmallArray as PM
149−import qualified Data.Primitive.Types as PM
150−
151−#if MIN_VERSION_primitive(0,6,4)
152−#if !MIN_VERSION_primitive(0,7,0)
153−import qualified Data.Primitive.UnliftedArray as PM
154−#endif
155−import qualified Data.Primitive.PrimArray as PM
156−#endif
157−
158−
159−import Data.Coerce (Coercible, coerce)
160−
161−parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
162−parseIndexedJSON p idx value = p value <?> Index idx
163−{-# INLINE parseIndexedJSON #-}
164−
165−parseIndexedJSONPair :: (Value -> Parser a) -> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
166−parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx
167− where
168− p = withArray "(k, v)" $ \ab ->
169− let n = V.length ab
170− in if n == 2
171− then (,) <$> parseJSONElemAtIndex keyParser 0 ab
172− <*> parseJSONElemAtIndex valParser 1 ab
173− else fail $ "cannot unpack array of length " ++
174− show n ++ " into a pair"
175−{-# INLINE parseIndexedJSONPair #-}
176−
177−parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
178−parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx
179−
180−parseRealFloat :: RealFloat a => String -> Value -> Parser a
181−parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
182−parseRealFloat _ Null = pure (0/0)
183−parseRealFloat name v = prependContext name (unexpected v)
184−{-# INLINE parseRealFloat #-}
185−
186−parseIntegralFromScientific :: forall a. Integral a => Scientific -> Parser a
187−parseIntegralFromScientific s =
188− case Scientific.floatingOrInteger s :: Either Double a of
189− Right x -> pure x
190− Left _ -> fail $ "unexpected floating number " ++ show s
191−{-# INLINE parseIntegralFromScientific #-}
192−
193−parseIntegral :: Integral a => String -> Value -> Parser a
194−parseIntegral name =
195− prependContext name . withBoundedScientific' parseIntegralFromScientific
196−{-# INLINE parseIntegral #-}
197−
198−parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => Scientific -> Parser a
199−parseBoundedIntegralFromScientific s = maybe
200− (fail $ "value is either floating or will cause over or underflow " ++ show s)
201− pure
202− (Scientific.toBoundedInteger s)
203−{-# INLINE parseBoundedIntegralFromScientific #-}
204−
205−parseBoundedIntegral :: (Bounded a, Integral a) => String -> Value -> Parser a
206−parseBoundedIntegral name =
207− prependContext name . withScientific' parseBoundedIntegralFromScientific
208−{-# INLINE parseBoundedIntegral #-}
209−
210−parseScientificText :: Text -> Parser Scientific
211−parseScientificText
212− = either fail pure
213− . A.parseOnly (A.scientific <* A.endOfInput)
214− . T.encodeUtf8
215−
216−parseIntegralText :: Integral a => String -> Text -> Parser a
217−parseIntegralText name t =
218− prependContext name $
219− parseScientificText t
220− >>= rejectLargeExponent
221− >>= parseIntegralFromScientific
222− where
223− rejectLargeExponent :: Scientific -> Parser Scientific
224− rejectLargeExponent s = withBoundedScientific' pure (Number s)
225−{-# INLINE parseIntegralText #-}
226−
227−parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a
228−parseBoundedIntegralText name t =
229− prependContext name $
230− parseScientificText t >>= parseBoundedIntegralFromScientific
231−
232−parseOptionalFieldWith :: (Value -> Parser (Maybe a))
233− -> Object -> Text -> Parser (Maybe a)
234−parseOptionalFieldWith pj obj key =
235− case H.lookup key obj of
236− Nothing -> pure Nothing
237− Just v -> pj v <?> Key key
238−{-# INLINE parseOptionalFieldWith #-}
239−
240−-------------------------------------------------------------------------------
241−-- Generics
242−-------------------------------------------------------------------------------
243−
244−-- | Class of generic representation types that can be converted from JSON.
245−class GFromJSON arity f where
246− -- | This method (applied to 'defaultOptions') is used as the
247− -- default generic implementation of 'parseJSON' (if the @arity@ is 'Zero')
248− -- or 'liftParseJSON' (if the @arity@ is 'One').
249− gParseJSON :: Options -> FromArgs arity a -> Value -> Parser (f a)
250−
251−-- | A 'FromArgs' value either stores nothing (for 'FromJSON') or it stores the
252−-- two function arguments that decode occurrences of the type parameter (for
253−-- 'FromJSON1').
254−data FromArgs arity a where
255− NoFromArgs :: FromArgs Zero a
256− From1Args :: (Value -> Parser a) -> (Value -> Parser [a]) -> FromArgs One a
257−
258−-- | A configurable generic JSON decoder. This function applied to
259−-- 'defaultOptions' is used as the default for 'parseJSON' when the
260−-- type is an instance of 'Generic'.
261−genericParseJSON :: (Generic a, GFromJSON Zero (Rep a))
262− => Options -> Value -> Parser a
263−genericParseJSON opts = fmap to . gParseJSON opts NoFromArgs
264−
265−-- | A configurable generic JSON decoder. This function applied to
266−-- 'defaultOptions' is used as the default for 'liftParseJSON' when the
267−-- type is an instance of 'Generic1'.
268−genericLiftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))
269− => Options -> (Value -> Parser a) -> (Value -> Parser [a])
270− -> Value -> Parser (f a)
271−genericLiftParseJSON opts pj pjl = fmap to1 . gParseJSON opts (From1Args pj pjl)
272−
273−-------------------------------------------------------------------------------
274−-- Class
275−-------------------------------------------------------------------------------
276−
277−-- | A type that can be converted from JSON, with the possibility of
278−-- failure.
279−--
280−-- In many cases, you can get the compiler to generate parsing code
281−-- for you (see below). To begin, let's cover writing an instance by
282−-- hand.
283−--
284−-- There are various reasons a conversion could fail. For example, an
285−-- 'Object' could be missing a required key, an 'Array' could be of
286−-- the wrong size, or a value could be of an incompatible type.
287−--
288−-- The basic ways to signal a failed conversion are as follows:
289−--
290−-- * 'fail' yields a custom error message: it is the recommended way of
291−-- reporting a failure;
292−--
293−-- * 'Control.Applicative.empty' (or 'Control.Monad.mzero') is uninformative:
294−-- use it when the error is meant to be caught by some @('<|>')@;
295−--
296−-- * 'typeMismatch' can be used to report a failure when the encountered value
297−-- is not of the expected JSON type; 'unexpected' is an appropriate alternative
298−-- when more than one type may be expected, or to keep the expected type
299−-- implicit.
300−--
301−-- 'prependFailure' (or 'modifyFailure') add more information to a parser's
302−-- error messages.
303−--
304−-- An example type and instance using 'typeMismatch' and 'prependFailure':
305−--
306−-- @
307−-- \-- Allow ourselves to write 'Text' literals.
308−-- {-\# LANGUAGE OverloadedStrings #-}
309−--
310−-- data Coord = Coord { x :: Double, y :: Double }
311−--
312−-- instance 'FromJSON' Coord where
313−-- 'parseJSON' ('Object' v) = Coord
314−-- '<$>' v '.:' \"x\"
315−-- '<*>' v '.:' \"y\"
316−--
317−-- \-- We do not expect a non-'Object' value here.
318−-- \-- We could use 'Control.Applicative.empty' to fail, but 'typeMismatch'
319−-- \-- gives a much more informative error message.
320−-- 'parseJSON' invalid =
321−-- 'prependFailure' "parsing Coord failed, "
322−-- ('typeMismatch' \"Object\" invalid)
323−-- @
324−--
325−-- For this common case of only being concerned with a single
326−-- type of JSON value, the functions 'withObject', 'withScientific', etc.
327−-- are provided. Their use is to be preferred when possible, since
328−-- they are more terse. Using 'withObject', we can rewrite the above instance
329−-- (assuming the same language extension and data type) as:
330−--
331−-- @
332−-- instance 'FromJSON' Coord where
333−-- 'parseJSON' = 'withObject' \"Coord\" $ \\v -> Coord
334−-- '<$>' v '.:' \"x\"
335−-- '<*>' v '.:' \"y\"
336−-- @
337−--
338−-- Instead of manually writing your 'FromJSON' instance, there are two options
339−-- to do it automatically:
340−--
341−-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
342−-- instance at compile time. The generated instance is optimized for your type
343−-- so it will probably be more efficient than the following option.
344−--
345−-- * The compiler can provide a default generic implementation for
346−-- 'parseJSON'.
347−--
348−-- To use the second, simply add a @deriving 'Generic'@ clause to your
349−-- datatype and declare a 'FromJSON' instance for your datatype without giving
350−-- a definition for 'parseJSON'.
351−--
352−-- For example, the previous example can be simplified to just:
353−--
354−-- @
355−-- {-\# LANGUAGE DeriveGeneric \#-}
356−--
357−-- import "GHC.Generics"
358−--
359−-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
360−--
361−-- instance 'FromJSON' Coord
362−-- @
363−--
364−-- The default implementation will be equivalent to
365−-- @parseJSON = 'genericParseJSON' 'defaultOptions'@; if you need different
366−-- options, you can customize the generic decoding by defining:
367−--
368−-- @
369−-- customOptions = 'defaultOptions'
370−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
371−-- }
372−--
373−-- instance 'FromJSON' Coord where
374−-- 'parseJSON' = 'genericParseJSON' customOptions
375−-- @
376−class FromJSON a where
377− parseJSON :: Value -> Parser a
378−
379− default parseJSON :: (Generic a, GFromJSON Zero (Rep a)) => Value -> Parser a
380− parseJSON = genericParseJSON defaultOptions
381−
382− parseJSONList :: Value -> Parser [a]
383− parseJSONList = withArray "[]" $ \a ->
384− zipWithM (parseIndexedJSON parseJSON) [0..]
385− . V.toList
386− $ a
387−
388−-------------------------------------------------------------------------------
389−-- Classes and types for map keys
390−-------------------------------------------------------------------------------
391−
392−-- | Read the docs for 'ToJSONKey' first. This class is a conversion
393−-- in the opposite direction. If you have a newtype wrapper around 'Text',
394−-- the recommended way to define instances is with generalized newtype deriving:
395−--
396−-- > newtype SomeId = SomeId { getSomeId :: Text }
397−-- > deriving (Eq,Ord,Hashable,FromJSONKey)
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−-- @
409−class FromJSONKey a where
410− -- | Strategy for parsing the key of a map-like container.
411− fromJSONKey :: FromJSONKeyFunction a
412− default fromJSONKey :: FromJSON a => FromJSONKeyFunction a
413− fromJSONKey = FromJSONKeyValue parseJSON
414−
415− -- | This is similar in spirit to the 'readList' method of 'Read'.
416− -- It makes it possible to give 'String' keys special treatment
417− -- without using @OverlappingInstances@. End users should always
418− -- be able to use the default implementation of this method.
419− fromJSONKeyList :: FromJSONKeyFunction [a]
420− default fromJSONKeyList :: FromJSON a => FromJSONKeyFunction [a]
421− fromJSONKeyList = FromJSONKeyValue parseJSON
422−
423−-- | With GHC 7.8+ we carry around @'Coercible' 'Text' a@ dictionary,
424−-- to give us an assurance that the program will not segfault.
425−-- Unfortunately we cannot enforce that the 'Eq' instances or the
426−-- 'Hashable' instances for 'Text' and @a@ agree.
427−--
428−-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'
429−-- can be inspected, but cannot be constructed.
430−data CoerceText a where
431− CoerceText :: Coercible Text a => CoerceText a
432−
433−-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the
434−-- 'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'
435−-- instance. The other three data constructors for this type all correspond to
436−-- 'ToJSONKeyText'. Strictly speaking, 'FromJSONKeyTextParser' is more powerful than
437−-- 'FromJSONKeyText', which is in turn more powerful than 'FromJSONKeyCoerce'.
438−-- For performance reasons, these exist as three options instead of one.
439−data FromJSONKeyFunction a
440− = FromJSONKeyCoerce !(CoerceText a)
441− -- ^ uses 'coerce' ('unsafeCoerce' in older GHCs)
442− | FromJSONKeyText !(Text -> a)
443− -- ^ conversion from 'Text' that always succeeds
444− | FromJSONKeyTextParser !(Text -> Parser a)
445− -- ^ conversion from 'Text' that may fail
446− | FromJSONKeyValue !(Value -> Parser a)
447− -- ^ conversion for non-textual keys
448−
449−-- | Only law abiding up to interpretation
450−instance Functor FromJSONKeyFunction where
451− fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce)
452− fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)
453− fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)
454− fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)
455−
456−-- | Construct 'FromJSONKeyFunction' for types coercible from 'Text'. This
457−-- conversion is still unsafe, as 'Hashable' and 'Eq' instances of @a@ should be
458−-- compatible with 'Text' i.e. hash values should be equal for wrapped values as well.
459−-- This property will always be maintained if the 'Hashable' and 'Eq' instances
460−-- are derived with generalized newtype deriving.
461−-- compatible with 'Text' i.e. hash values be equal for wrapped values as well.
462−--
463−-- On pre GHC 7.8 this is unconstrainted function.
464−fromJSONKeyCoerce ::
465− Coercible Text a =>
466− FromJSONKeyFunction a
467−fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
468−
469−-- | Semantically the same as @coerceFromJSONKeyFunction = fmap coerce = coerce@.
470−--
471−-- See note on 'fromJSONKeyCoerce'.
472−coerceFromJSONKeyFunction ::
473− Coercible a b =>
474− FromJSONKeyFunction a -> FromJSONKeyFunction b
475−coerceFromJSONKeyFunction = coerce
476−
477−{-# RULES
478− "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).
479− fmap id x = x
480− #-}
481−{-# RULES
482− "FromJSONKeyCoerce: fmap coerce" forall x .
483− fmap coerce x = coerceFromJSONKeyFunction x
484− #-}
485−
486−-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.
487−mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
488−mapFromJSONKeyFunction = fmap
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−
519−-------------------------------------------------------------------------------
520−-- Functions needed for documentation
521−-------------------------------------------------------------------------------
522−
523−-- | Fail parsing due to a type mismatch, with a descriptive message.
524−--
525−-- The following wrappers should generally be prefered:
526−-- 'withObject', 'withArray', 'withText', 'withBool'.
527−--
528−-- ==== Error message example
529−--
530−-- > typeMismatch "Object" (String "oops")
531−-- > -- Error: "expected Object, but encountered String"
532−typeMismatch :: String -- ^ The name of the JSON type being parsed
533− -- (@\"Object\"@, @\"Array\"@, @\"String\"@, @\"Number\"@,
534− -- @\"Boolean\"@, or @\"Null\"@).
535− -> Value -- ^ The actual value encountered.
536− -> Parser a
537−typeMismatch expected actual =
538− fail $ "expected " ++ expected ++ ", but encountered " ++ typeOf actual
539−
540−-- | Fail parsing due to a type mismatch, when the expected types are implicit.
541−--
542−-- ==== Error message example
543−--
544−-- > unexpected (String "oops")
545−-- > -- Error: "unexpected String"
546−unexpected :: Value -> Parser a
547−unexpected actual = fail $ "unexpected " ++ typeOf actual
548−
549−-- | JSON type of a value, name of the head constructor.
550−typeOf :: Value -> String
551−typeOf v = case v of
552− Object _ -> "Object"
553− Array _ -> "Array"
554− String _ -> "String"
555− Number _ -> "Number"
556− Bool _ -> "Boolean"
557− Null -> "Null"
558−
559−-------------------------------------------------------------------------------
560−-- Lifings of FromJSON and ToJSON to unary and binary type constructors
561−-------------------------------------------------------------------------------
562−
563−-- | Lifting of the 'FromJSON' class to unary type constructors.
564−--
565−-- Instead of manually writing your 'FromJSON1' instance, there are two options
566−-- to do it automatically:
567−--
568−-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
569−-- instance at compile time. The generated instance is optimized for your type
570−-- so it will probably be more efficient than the following option.
571−--
572−-- * The compiler can provide a default generic implementation for
573−-- 'liftParseJSON'.
574−--
575−-- To use the second, simply add a @deriving 'Generic1'@ clause to your
576−-- datatype and declare a 'FromJSON1' instance for your datatype without giving
577−-- a definition for 'liftParseJSON'.
578−--
579−-- For example:
580−--
581−-- @
582−-- {-\# LANGUAGE DeriveGeneric \#-}
583−--
584−-- import "GHC.Generics"
585−--
586−-- data Pair a b = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
587−--
588−-- instance 'FromJSON' a => 'FromJSON1' (Pair a)
589−-- @
590−--
591−-- If the default implementation doesn't give exactly the results you want,
592−-- you can customize the generic decoding with only a tiny amount of
593−-- effort, using 'genericLiftParseJSON' with your preferred 'Options':
594−--
595−-- @
596−-- customOptions = 'defaultOptions'
597−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
598−-- }
599−--
600−-- instance 'FromJSON' a => 'FromJSON1' (Pair a) where
601−-- 'liftParseJSON' = 'genericLiftParseJSON' customOptions
602−-- @
603−class FromJSON1 f where
604− liftParseJSON :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
605−
606− default liftParseJSON :: (Generic1 f, GFromJSON One (Rep1 f))
607− => (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
608− liftParseJSON = genericLiftParseJSON defaultOptions
609−
610− liftParseJSONList :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser [f a]
611− liftParseJSONList f g v = listParser (liftParseJSON f g) v
612−
613−-- | Lift the standard 'parseJSON' function through the type constructor.
614−parseJSON1 :: (FromJSON1 f, FromJSON a) => Value -> Parser (f a)
615−parseJSON1 = liftParseJSON parseJSON parseJSONList
616−{-# INLINE parseJSON1 #-}
617−
618−-- | Lifting of the 'FromJSON' class to binary type constructors.
619−--
620−-- Instead of manually writing your 'FromJSON2' instance, "Data.Aeson.TH"
621−-- provides Template Haskell functions which will derive an instance at compile time.
622−
623−-- The compiler cannot provide a default generic implementation for 'liftParseJSON2',
624−-- unlike 'parseJSON' and 'liftParseJSON'.
625−class FromJSON2 f where
626− liftParseJSON2
627− :: (Value -> Parser a)
628− -> (Value -> Parser [a])
629− -> (Value -> Parser b)
630− -> (Value -> Parser [b])
631− -> Value -> Parser (f a b)
632− liftParseJSONList2
633− :: (Value -> Parser a)
634− -> (Value -> Parser [a])
635− -> (Value -> Parser b)
636− -> (Value -> Parser [b])
637− -> Value -> Parser [f a b]
638− liftParseJSONList2 fa ga fb gb = withArray "[]" $ \vals ->
639− fmap V.toList (V.mapM (liftParseJSON2 fa ga fb gb) vals)
640−
641−-- | Lift the standard 'parseJSON' function through the type constructor.
642−parseJSON2 :: (FromJSON2 f, FromJSON a, FromJSON b) => Value -> Parser (f a b)
643−parseJSON2 = liftParseJSON2 parseJSON parseJSONList parseJSON parseJSONList
644−{-# INLINE parseJSON2 #-}
645−
646−-------------------------------------------------------------------------------
647−-- List functions
648−-------------------------------------------------------------------------------
649−
650−-- | Helper function to use with 'liftParseJSON'. See 'Data.Aeson.ToJSON.listEncoding'.
651−listParser :: (Value -> Parser a) -> Value -> Parser [a]
652−listParser f (Array xs) = fmap V.toList (V.mapM f xs)
653−listParser _ v = typeMismatch "Array" v
654−{-# INLINE listParser #-}
655−
656−-------------------------------------------------------------------------------
657−-- [] instances
658−-------------------------------------------------------------------------------
659−
660−instance FromJSON1 [] where
661− liftParseJSON _ p' = p'
662− {-# INLINE liftParseJSON #-}
663−
664−instance (FromJSON a) => FromJSON [a] where
665− parseJSON = parseJSON1
666−
667−-------------------------------------------------------------------------------
668−-- Functions
669−-------------------------------------------------------------------------------
670−
671−-- | Add context to a failure message, indicating the name of the structure
672−-- being parsed.
673−--
674−-- > prependContext "MyType" (fail "[error message]")
675−-- > -- Error: "parsing MyType failed, [error message]"
676−prependContext :: String -> Parser a -> Parser a
677−prependContext name = prependFailure ("parsing " ++ name ++ " failed, ")
678−
679−-- | @'withObject' name f value@ applies @f@ to the 'Object' when @value@
680−-- is an 'Data.Aeson.Object' and fails otherwise.
681−--
682−-- ==== Error message example
683−--
684−-- > withObject "MyType" f (String "oops")
685−-- > -- Error: "parsing MyType failed, expected Object, but encountered String"
686−withObject :: String -> (Object -> Parser a) -> Value -> Parser a
687−withObject _ f (Object obj) = f obj
688−withObject name _ v = prependContext name (typeMismatch "Object" v)
689−{-# INLINE withObject #-}
690−
691−-- | @'withText' name f value@ applies @f@ to the 'Text' when @value@ is a
692−-- 'Data.Aeson.String' and fails otherwise.
693−--
694−-- ==== Error message example
695−--
696−-- > withText "MyType" f Null
697−-- > -- Error: "parsing MyType failed, expected String, but encountered Null"
698−withText :: String -> (Text -> Parser a) -> Value -> Parser a
699−withText _ f (String txt) = f txt
700−withText name _ v = prependContext name (typeMismatch "String" v)
701−{-# INLINE withText #-}
702−
703−-- | @'withArray' expected f value@ applies @f@ to the 'Array' when @value@ is
704−-- an 'Data.Aeson.Array' and fails otherwise.
705−--
706−-- ==== Error message example
707−--
708−-- > withArray "MyType" f (String "oops")
709−-- > -- Error: "parsing MyType failed, expected Array, but encountered String"
710−withArray :: String -> (Array -> Parser a) -> Value -> Parser a
711−withArray _ f (Array arr) = f arr
712−withArray name _ v = prependContext name (typeMismatch "Array" v)
713−{-# INLINE withArray #-}
714−
715−-- | @'withScientific' name f value@ applies @f@ to the 'Scientific' number
716−-- when @value@ is a 'Data.Aeson.Number' and fails using 'typeMismatch'
717−-- otherwise.
718−--
719−-- /Warning/: If you are converting from a scientific to an unbounded
720−-- type such as 'Integer' you may want to add a restriction on the
721−-- size of the exponent (see 'withBoundedScientific') to prevent
722−-- malicious input from filling up the memory of the target system.
723−--
724−-- ==== Error message example
725−--
726−-- > withScientific "MyType" f (String "oops")
727−-- > -- Error: "parsing MyType failed, expected Number, but encountered String"
728−withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
729−withScientific _ f (Number scientific) = f scientific
730−withScientific name _ v = prependContext name (typeMismatch "Number" v)
731−{-# INLINE withScientific #-}
732−
733−-- | A variant of 'withScientific' which doesn't use 'prependContext', so that
734−-- such context can be added separately in a way that also applies when the
735−-- continuation @f :: Scientific -> Parser a@ fails.
736−--
737−-- /Warning/: If you are converting from a scientific to an unbounded
738−-- type such as 'Integer' you may want to add a restriction on the
739−-- size of the exponent (see 'withBoundedScientific') to prevent
740−-- malicious input from filling up the memory of the target system.
741−--
742−-- ==== Error message examples
743−--
744−-- > withScientific' f (String "oops")
745−-- > -- Error: "unexpected String"
746−-- >
747−-- > prependContext "MyType" (withScientific' f (String "oops"))
748−-- > -- Error: "parsing MyType failed, unexpected String"
749−withScientific' :: (Scientific -> Parser a) -> Value -> Parser a
750−withScientific' f v = case v of
751− Number n -> f n
752− _ -> typeMismatch "Number" v
753−{-# INLINE withScientific' #-}
754−
755−-- | @'withBoundedScientific' name f value@ applies @f@ to the 'Scientific' number
756−-- when @value@ is a 'Number' with exponent less than or equal to 1024.
757−withBoundedScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
758−withBoundedScientific name f v = withBoundedScientific_ (prependContext name) f v
759−{-# INLINE withBoundedScientific #-}
760−
761−-- | A variant of 'withBoundedScientific' which doesn't use 'prependContext',
762−-- so that such context can be added separately in a way that also applies
763−-- when the continuation @f :: Scientific -> Parser a@ fails.
764−withBoundedScientific' :: (Scientific -> Parser a) -> Value -> Parser a
765−withBoundedScientific' f v = withBoundedScientific_ id f v
766−{-# INLINE withBoundedScientific' #-}
767−
768−-- | A variant of 'withBoundedScientific_' parameterized by a function to apply
769−-- to the 'Parser' in case of failure.
770−withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
771−withBoundedScientific_ whenFail f (Number scientific) =
772− if exp10 > 1024
773− then whenFail (fail msg)
774− else f scientific
775− where
776− exp10 = base10Exponent scientific
777− msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024"
778−withBoundedScientific_ whenFail _ v =
779− whenFail (typeMismatch "Number" v)
780−{-# INLINE withBoundedScientific_ #-}
781−
782−-- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a
783−-- 'Boolean' and fails otherwise.
784−--
785−-- ==== Error message example
786−--
787−-- > withBool "MyType" f (String "oops")
788−-- > -- Error: "parsing MyType failed, expected Boolean, but encountered String"
789−withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
790−withBool _ f (Bool arr) = f arr
791−withBool name _ v = prependContext name (typeMismatch "Boolean" v)
792−{-# INLINE withBool #-}
793−
794−-- | Decode a nested JSON-encoded string.
795−withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
796−withEmbeddedJSON _ innerParser (String txt) =
797− either fail innerParser $ eitherDecode (L.fromStrict $ T.encodeUtf8 txt)
798− where
799− eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
800− eitherFormatError = either (Left . uncurry formatError) Right
801−withEmbeddedJSON name _ v = prependContext name (typeMismatch "String" v)
802−{-# INLINE withEmbeddedJSON #-}
803−
804−-- | Convert a value from JSON, failing if the types do not match.
805−fromJSON :: (FromJSON a) => Value -> Result a
806−fromJSON = parse parseJSON
807−{-# INLINE fromJSON #-}
808−
809−-- | Convert a value from JSON, failing if the types do not match.
810−ifromJSON :: (FromJSON a) => Value -> IResult a
811−ifromJSON = iparse parseJSON
812−{-# INLINE ifromJSON #-}
813−
814−-- | Retrieve the value associated with the given key of an 'Object'.
815−-- The result is 'empty' if the key is not present or the value cannot
816−-- be converted to the desired type.
817−--
818−-- This accessor is appropriate if the key and value /must/ be present
819−-- in an object for it to be valid. If the key and value are
820−-- optional, use '.:?' instead.
821−(.:) :: (FromJSON a) => Object -> Text -> Parser a
822−(.:) = explicitParseField parseJSON
823−{-# INLINE (.:) #-}
824−
825−-- | Retrieve the value associated with the given key of an 'Object'. The
826−-- result is 'Nothing' if the key is not present or if its value is 'Null',
827−-- or 'empty' if the value cannot be converted to the desired type.
828−--
829−-- This accessor is most useful if the key and value can be absent
830−-- from an object without affecting its validity. If the key and
831−-- value are mandatory, use '.:' instead.
832−(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
833−(.:?) = explicitParseFieldMaybe parseJSON
834−{-# INLINE (.:?) #-}
835−
836−-- | Retrieve the value associated with the given key of an 'Object'.
837−-- The result is 'Nothing' if the key is not present or 'empty' if the
838−-- value cannot be converted to the desired type.
839−--
840−-- This differs from '.:?' by attempting to parse 'Null' the same as any
841−-- other JSON value, instead of interpreting it as 'Nothing'.
842−(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
843−(.:!) = explicitParseFieldMaybe' parseJSON
844−{-# INLINE (.:!) #-}
845−
846−-- | Function variant of '.:'.
847−parseField :: (FromJSON a) => Object -> Text -> Parser a
848−parseField = (.:)
849−{-# INLINE parseField #-}
850−
851−-- | Function variant of '.:?'.
852−parseFieldMaybe :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
853−parseFieldMaybe = (.:?)
854−{-# INLINE parseFieldMaybe #-}
855−
856−-- | Function variant of '.:!'.
857−parseFieldMaybe' :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
858−parseFieldMaybe' = (.:!)
859−{-# INLINE parseFieldMaybe' #-}
860−
861−-- | Variant of '.:' with explicit parser function.
862−--
863−-- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@
864−explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
865−explicitParseField p obj key = case H.lookup key obj of
866− Nothing -> fail $ "key " ++ show key ++ " not found"
867− Just v -> p v <?> Key key
868−{-# INLINE explicitParseField #-}
869−
870−-- | Variant of '.:?' with explicit parser function.
871−explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
872−explicitParseFieldMaybe p obj key = case H.lookup key obj of
873− Nothing -> pure Nothing
874− Just v -> liftParseJSON p (listParser p) v <?> Key key -- listParser isn't used by maybe instance.
875−{-# INLINE explicitParseFieldMaybe #-}
876−
877−-- | Variant of '.:!' with explicit parser function.
878−explicitParseFieldMaybe' :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
879−explicitParseFieldMaybe' p obj key = case H.lookup key obj of
880− Nothing -> pure Nothing
881− Just v -> Just <$> p v <?> Key key
882−{-# INLINE explicitParseFieldMaybe' #-}
883−
884−-- | Helper for use in combination with '.:?' to provide default
885−-- values for optional JSON object fields.
886−--
887−-- This combinator is most useful if the key and value can be absent
888−-- from an object without affecting its validity and we know a default
889−-- value to assign in that case. If the key and value are mandatory,
890−-- use '.:' instead.
891−--
892−-- Example usage:
893−--
894−-- @ v1 <- o '.:?' \"opt_field_with_dfl\" .!= \"default_val\"
895−-- v2 <- o '.:' \"mandatory_field\"
896−-- v3 <- o '.:?' \"opt_field2\"
897−-- @
898−(.!=) :: Parser (Maybe a) -> a -> Parser a
899−pmval .!= val = fromMaybe val <$> pmval
900−{-# INLINE (.!=) #-}
901−
902−--------------------------------------------------------------------------------
903−-- Generic parseJSON
904−-------------------------------------------------------------------------------
905−
906−instance GFromJSON arity V1 where
907− -- Whereof we cannot format, thereof we cannot parse:
908− gParseJSON _ _ _ = fail "Attempted to parse empty type"
909−
910−
911−instance OVERLAPPABLE_ (GFromJSON arity a) => GFromJSON arity (M1 i c a) where
912− -- Meta-information, which is not handled elsewhere, is just added to the
913− -- parsed value:
914− gParseJSON opts fargs = fmap M1 . gParseJSON opts fargs
915−
916−-- Information for error messages
917−
918−type TypeName = String
919−type ConName = String
920−
921−-- | Add the name of the type being parsed to a parser's error messages.
922−contextType :: TypeName -> Parser a -> Parser a
923−contextType = prependContext
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−
935−-- | Add the name of the constructor being parsed to a parser's error messages.
936−contextCons :: ConName -> TypeName -> Parser a -> Parser a
937−contextCons cname tname = prependContext (showCons cname tname)
938−
939−-- | Render a constructor as @\"MyType(MyConstructor)\"@.
940−showCons :: ConName -> TypeName -> String
941−showCons cname tname = tname ++ "(" ++ cname ++ ")"
942−
943−--------------------------------------------------------------------------------
944−
945−-- Parsing single fields
946−
947−instance (FromJSON a) => GFromJSON arity (K1 i a) where
948− -- Constant values are decoded using their FromJSON instance:
949− gParseJSON _opts _ = fmap K1 . parseJSON
950−
951−instance GFromJSON One Par1 where
952− -- Direct occurrences of the last type parameter are decoded with the
953− -- function passed in as an argument:
954− gParseJSON _opts (From1Args pj _) = fmap Par1 . pj
955−
956−instance (FromJSON1 f) => GFromJSON One (Rec1 f) where
957− -- Recursive occurrences of the last type parameter are decoded using their
958− -- FromJSON1 instance:
959− gParseJSON _opts (From1Args pj pjl) = fmap Rec1 . liftParseJSON pj pjl
960−
961−instance (FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) where
962− -- If an occurrence of the last type parameter is nested inside two
963− -- composed types, it is decoded by using the outermost type's FromJSON1
964− -- instance to generically decode the innermost type:
965− gParseJSON opts fargs =
966− let gpj = gParseJSON opts fargs in
967− fmap Comp1 . liftParseJSON gpj (listParser gpj)
968−
969−--------------------------------------------------------------------------------
970−
971−instance (GFromJSON' arity a, Datatype d) => GFromJSON arity (D1 d a) where
972− -- Meta-information, which is not handled elsewhere, is just added to the
973− -- parsed value:
974− gParseJSON opts fargs = fmap M1 . gParseJSON' (tname :* opts :* fargs)
975− where
976− tname = moduleName proxy ++ "." ++ datatypeName proxy
977− proxy = undefined :: M1 _i d _f _p
978−
979−-- | 'GFromJSON', after unwrapping the 'D1' constructor, now carrying the data
980−-- type's name.
981−class GFromJSON' arity f where
982− gParseJSON' :: TypeName :* Options :* FromArgs arity a
983− -> Value
984− -> Parser (f a)
985−
986−-- | Single constructor.
987−instance ( ConsFromJSON arity a
988− , AllNullary (C1 c a) allNullary
989− , ParseSum arity (C1 c a) allNullary
990− , Constructor c
991− ) => GFromJSON' arity (C1 c a) where
992− -- The option 'tagSingleConstructors' determines whether to wrap
993− -- a single-constructor type.
994− gParseJSON' p@(_ :* opts :* _)
995− | tagSingleConstructors opts
996− = (unTagged :: Tagged allNullary (Parser (C1 c a p)) -> Parser (C1 c a p))
997− . parseSum p
998− | otherwise = fmap M1 . consParseJSON (cname :* p)
999− where
1000− cname = conName (undefined :: M1 _i c _f _p)
1001−
1002−-- | Multiple constructors.
1003−instance ( AllNullary (a :+: b) allNullary
1004− , ParseSum arity (a :+: b) allNullary
1005− ) => GFromJSON' arity (a :+: b) where
1006− -- If all constructors of a sum datatype are nullary and the
1007− -- 'allNullaryToStringTag' option is set they are expected to be
1008− -- encoded as strings. This distinction is made by 'parseSum':
1009− gParseJSON' p =
1010− (unTagged :: Tagged allNullary (Parser ((a :+: b) _d)) ->
1011− Parser ((a :+: b) _d))
1012− . parseSum p
1013−
1014−--------------------------------------------------------------------------------
1015−
1016−class ParseSum arity f allNullary where
1017− parseSum :: TypeName :* Options :* FromArgs arity a
1018− -> Value
1019− -> Tagged allNullary (Parser (f a))
1020−
1021−instance ( ConstructorNames f
1022− , SumFromString f
1023− , FromPair arity f
1024− , FromTaggedObject arity f
1025− , FromUntaggedValue arity f
1026− ) => ParseSum arity f True where
1027− parseSum p@(tname :* opts :* _)
1028− | allNullaryToStringTag opts = Tagged . parseAllNullarySum tname opts
1029− | otherwise = Tagged . parseNonAllNullarySum p
1030−
1031−instance ( ConstructorNames f
1032− , FromPair arity f
1033− , FromTaggedObject arity f
1034− , FromUntaggedValue arity f
1035− ) => ParseSum arity f False where
1036− parseSum p = Tagged . parseNonAllNullarySum p
1037−
1038−--------------------------------------------------------------------------------
1039−
1040−parseAllNullarySum :: (SumFromString f, ConstructorNames f)
1041− => TypeName -> Options -> Value -> Parser (f a)
1042−parseAllNullarySum tname opts =
1043− withText tname $ \tag ->
1044− maybe (badTag tag) return $
1045− parseSumFromString modifier tag
1046− where
1047− badTag tag = failWithCTags tname modifier $ \cnames ->
1048− "expected one of the tags " ++ show cnames ++
1049− ", but found tag " ++ show tag
1050− modifier = constructorTagModifier opts
1051−
1052−-- | Fail with an informative error message about a mismatched tag.
1053−-- The error message is parameterized by the list of expected tags,
1054−-- to be inferred from the result type of the parser.
1055−failWithCTags
1056− :: forall f a t. ConstructorNames f
1057− => TypeName -> (String -> t) -> ([t] -> String) -> Parser (f a)
1058−failWithCTags tname modifier f =
1059− contextType tname . fail $ f cnames
1060− where
1061− cnames = unTagged2 (constructorTags modifier :: Tagged2 f [t])
1062−
1063−class SumFromString f where
1064− parseSumFromString :: (String -> String) -> Text -> Maybe (f a)
1065−
1066−instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where
1067− parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>
1068− (R1 <$> parseSumFromString opts key)
1069−
1070−instance (Constructor c) => SumFromString (C1 c U1) where
1071− parseSumFromString modifier key
1072− | key == name = Just $ M1 U1
1073− | otherwise = Nothing
1074− where
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
1080−
1081−-- | List of all constructor tags.
1082−constructorTags :: ConstructorNames a => (String -> t) -> Tagged2 a [t]
1083−constructorTags modifier =
1084− fmap DList.toList (constructorNames' modifier)
1085−
1086−-- | List of all constructor names of an ADT, after a given conversion
1087−-- function. (Better inlining.)
1088−class ConstructorNames a where
1089− constructorNames' :: (String -> t) -> Tagged2 a (DList.DList t)
1090−
1091−instance (ConstructorNames a, ConstructorNames b) => ConstructorNames (a :+: b) where
1092− constructorNames' = liftA2 append constructorNames' constructorNames'
1093− where
1094− append
1095− :: Tagged2 a (DList.DList t)
1096− -> Tagged2 b (DList.DList t)
1097− -> Tagged2 (a :+: b) (DList.DList t)
1098− append (Tagged2 xs) (Tagged2 ys) = Tagged2 (DList.append xs ys)
1099−
1100−instance Constructor c => ConstructorNames (C1 c a) where
1101− constructorNames' f = Tagged2 (pure (f cname))
1102− where
1103− cname = conName (undefined :: M1 _i c _f _p)
1104−
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
1111−
1112−--------------------------------------------------------------------------------
1113−parseNonAllNullarySum :: forall f c arity.
1114− ( FromPair arity f
1115− , FromTaggedObject arity f
1116− , FromUntaggedValue arity f
1117− , ConstructorNames f
1118− ) => TypeName :* Options :* FromArgs arity c
1119− -> Value -> Parser (f c)
1120−parseNonAllNullarySum p@(tname :* opts :* _) =
1121− case sumEncoding opts of
1122− TaggedObject{..} ->
1123− withObject tname $ \obj -> do
1124− tag <- contextType tname . contextTag tagKey cnames_ $ obj .: tagKey
1125− fromMaybe (badTag tag <?> Key tagKey) $
1126− parseFromTaggedObject (tag :* contentsFieldName :* p) obj
1127− where
1128− tagKey = pack tagFieldName
1129− badTag tag = failWith_ $ \cnames ->
1130− "expected tag field to be one of " ++ show cnames ++
1131− ", but found tag " ++ show tag
1132− cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String])
1133−
1134− ObjectWithSingleField ->
1135− withObject tname $ \obj -> case H.toList obj of
1136− [(tag, v)] -> maybe (badTag tag) (<?> Key tag) $
1137− parsePair (tag :* p) v
1138− _ -> contextType tname . fail $
1139− "expected an Object with a single pair, but found " ++
1140− show (H.size obj) ++ " pairs"
1141− where
1142− badTag tag = failWith_ $ \cnames ->
1143− "expected an Object with a single pair where the tag is one of " ++
1144− show cnames ++ ", but found tag " ++ show tag
1145−
1146− TwoElemArray ->
1147− withArray tname $ \arr -> case V.length arr of
1148− 2 | String tag <- V.unsafeIndex arr 0 ->
1149− maybe (badTag tag <?> Index 0) (<?> Index 1) $
1150− parsePair (tag :* p) (V.unsafeIndex arr 1)
1151− | otherwise ->
1152− contextType tname $
1153− fail "tag element is not a String" <?> Index 0
1154− len -> contextType tname . fail $
1155− "expected a 2-element Array, but encountered an Array of length " ++
1156− show len
1157− where
1158− badTag tag = failWith_ $ \cnames ->
1159− "expected tag of the 2-element Array to be one of " ++
1160− show cnames ++ ", but found tag " ++ show tag
1161−
1162− UntaggedValue -> parseUntaggedValue p
1163− where
1164− failWith_ = failWithCTags tname (constructorTagModifier opts)
1165−
1166−--------------------------------------------------------------------------------
1167−
1168−class FromTaggedObject arity f where
1169− -- The first two components of the parameter tuple are: the constructor tag
1170− -- to match against, and the contents field name.
1171− parseFromTaggedObject
1172− :: Text :* String :* TypeName :* Options :* FromArgs arity a
1173− -> Object
1174− -> Maybe (Parser (f a))
1175−
1176−instance ( FromTaggedObject arity a, FromTaggedObject arity b) =>
1177− FromTaggedObject arity (a :+: b) where
1178− parseFromTaggedObject p obj =
1179− (fmap L1 <$> parseFromTaggedObject p obj) <|>
1180− (fmap R1 <$> parseFromTaggedObject p obj)
1181−
1182−instance ( IsRecord f isRecord
1183− , FromTaggedObject' arity f isRecord
1184− , Constructor c
1185− ) => FromTaggedObject arity (C1 c f) where
1186− parseFromTaggedObject (tag :* contentsFieldName :* p@(_ :* opts :* _))
1187− | tag == tag'
1188− = Just . fmap M1 .
1189− (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .
1190− parseFromTaggedObject' (contentsFieldName :* cname :* p)
1191− | otherwise = const Nothing
1192− where
1193− tag' = pack $ constructorTagModifier opts cname
1194− cname = conName (undefined :: M1 _i c _f _p)
1195−
1196−--------------------------------------------------------------------------------
1197−
1198−class FromTaggedObject' arity f isRecord where
1199− -- The first component of the parameter tuple is the contents field name.
1200− parseFromTaggedObject'
1201− :: String :* ConName :* TypeName :* Options :* FromArgs arity a
1202− -> Object -> Tagged isRecord (Parser (f a))
1203−
1204−instance (RecordFromJSON arity f, FieldNames f) => FromTaggedObject' arity f True where
1205− -- Records are unpacked in the tagged object
1206− parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON (True :* p)
1207−
1208−instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where
1209− -- Nonnullary nonrecords are encoded in the contents field
1210− parseFromTaggedObject' p obj = Tagged $ do
1211− contents <- contextCons cname tname (obj .: key)
1212− consParseJSON p' contents <?> Key key
1213− where
1214− key = pack contentsFieldName
1215− contentsFieldName :* p'@(cname :* tname :* _) = p
1216−
1217−instance OVERLAPPING_ FromTaggedObject' arity U1 False where
1218− -- Nullary constructors don't need a contents field
1219− parseFromTaggedObject' _ _ = Tagged (pure U1)
1220−
1221−--------------------------------------------------------------------------------
1222−
1223−-- | Constructors need to be decoded differently depending on whether they're
1224−-- a record or not. This distinction is made by 'ConsParseJSON'.
1225−class ConsFromJSON arity f where
1226− consParseJSON
1227− :: ConName :* TypeName :* Options :* FromArgs arity a
1228− -> Value -> Parser (f a)
1229−
1230−class ConsFromJSON' arity f isRecord where
1231− consParseJSON'
1232− :: ConName :* TypeName :* Options :* FromArgs arity a
1233− -> Value -> Tagged isRecord (Parser (f a))
1234−
1235−instance ( IsRecord f isRecord
1236− , ConsFromJSON' arity f isRecord
1237− ) => ConsFromJSON arity f where
1238− consParseJSON p =
1239− (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
1240− . consParseJSON' p
1241−
1242−instance OVERLAPPING_
1243− ( GFromJSON arity a, RecordFromJSON arity (S1 s a)
1244− ) => ConsFromJSON' arity (S1 s a) True where
1245− consParseJSON' p@(cname :* tname :* opts :* fargs)
1246− | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs
1247− | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))
1248−
1249−instance RecordFromJSON arity f => ConsFromJSON' arity f True where
1250− consParseJSON' p@(cname :* tname :* _) =
1251− Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))
1252−
1253−instance OVERLAPPING_
1254− ConsFromJSON' arity U1 False where
1255− -- Empty constructors are expected to be encoded as an empty array:
1256− consParseJSON' (cname :* tname :* _) v =
1257− Tagged . contextCons cname tname $ case v of
1258− Array a | V.null a -> pure U1
1259− | otherwise -> fail_ a
1260− _ -> typeMismatch "Array" v
1261− where
1262− fail_ a = fail $
1263− "expected an empty Array, but encountered an Array of length " ++
1264− show (V.length a)
1265−
1266−instance OVERLAPPING_
1267− GFromJSON arity f => ConsFromJSON' arity (S1 s f) False where
1268− consParseJSON' (_ :* _ :* opts :* fargs) =
1269− Tagged . fmap M1 . gParseJSON opts fargs
1270−
1271−instance (ProductFromJSON arity f, ProductSize f
1272− ) => ConsFromJSON' arity f False where
1273− consParseJSON' p = Tagged . productParseJSON0 p
1274−
1275−--------------------------------------------------------------------------------
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−
1288−class RecordFromJSON arity f where
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'
1313− :: ConName :* TypeName :* Options :* FromArgs arity a
1314− -> Object -> Parser (f a)
1315−
1316−instance ( RecordFromJSON' arity a
1317− , RecordFromJSON' arity b
1318− ) => RecordFromJSON' arity (a :*: b) where
1319− recordParseJSON' p obj =
1320− (:*:) <$> recordParseJSON' p obj
1321− <*> recordParseJSON' p obj
1322−
1323−instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
1324− RecordFromJSON' arity (S1 s a) where
1325− recordParseJSON' (cname :* tname :* opts :* fargs) obj = do
1326− fv <- contextCons cname tname (obj .: label)
1327− M1 <$> gParseJSON opts fargs fv <?> Key label
1328− where
1329− label = pack $ fieldLabelModifier opts sname
1330− sname = selName (undefined :: M1 _i s _f _p)
1331−
1332−instance INCOHERENT_ (Selector s, FromJSON a) =>
1333− RecordFromJSON' arity (S1 s (K1 i (Maybe a))) where
1334− recordParseJSON' (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label
1335− where
1336− label = fieldLabelModifier opts sname
1337− sname = selName (undefined :: M1 _i s _f _p)
1338−
1339−-- Parse an Option like a Maybe.
1340−instance INCOHERENT_ (Selector s, FromJSON a) =>
1341− RecordFromJSON' arity (S1 s (K1 i (Semigroup.Option a))) where
1342− recordParseJSON' p obj = wrap <$> recordParseJSON' p obj
1343− where
1344− wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p
1345− wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))
1346−
1347−--------------------------------------------------------------------------------
1348−
1349−productParseJSON0
1350− :: forall f arity a. (ProductFromJSON arity f, ProductSize f)
1351− => ConName :* TypeName :* Options :* FromArgs arity a
1352− -> Value -> Parser (f a)
1353− -- Products are expected to be encoded to an array. Here we check whether we
1354− -- got an array of the same size as the product, then parse each of the
1355− -- product's elements using productParseJSON:
1356−productParseJSON0 p@(cname :* tname :* _ :* _) =
1357− withArray (showCons cname tname) $ \arr ->
1358− let lenArray = V.length arr
1359− lenProduct = (unTagged2 :: Tagged2 f Int -> Int)
1360− productSize in
1361− if lenArray == lenProduct
1362− then productParseJSON p arr 0 lenProduct
1363− else contextCons cname tname $
1364− fail $ "expected an Array of length " ++ show lenProduct ++
1365− ", but encountered an Array of length " ++ show lenArray
1366−
1367−--
1368−
1369−class ProductFromJSON arity f where
1370− productParseJSON :: ConName :* TypeName :* Options :* FromArgs arity a
1371− -> Array -> Int -> Int
1372− -> Parser (f a)
1373−
1374−instance ( ProductFromJSON arity a
1375− , ProductFromJSON arity b
1376− ) => ProductFromJSON arity (a :*: b) where
1377− productParseJSON p arr ix len =
1378− (:*:) <$> productParseJSON p arr ix lenL
1379− <*> productParseJSON p arr ixR lenR
1380− where
1381− lenL = len `unsafeShiftR` 1
1382− ixR = ix + lenL
1383− lenR = len - lenL
1384−
1385−instance (GFromJSON arity a) => ProductFromJSON arity (S1 s a) where
1386− productParseJSON (_ :* _ :* opts :* fargs) arr ix _ =
1387− M1 <$> gParseJSON opts fargs (V.unsafeIndex arr ix) <?> Index ix
1388−
1389−--------------------------------------------------------------------------------
1390−
1391−class FromPair arity f where
1392− -- The first component of the parameter tuple is the tag to match.
1393− parsePair :: Text :* TypeName :* Options :* FromArgs arity a
1394− -> Value
1395− -> Maybe (Parser (f a))
1396−
1397−instance ( FromPair arity a
1398− , FromPair arity b
1399− ) => FromPair arity (a :+: b) where
1400− parsePair p pair =
1401− (fmap L1 <$> parsePair p pair) <|>
1402− (fmap R1 <$> parsePair p pair)
1403−
1404−instance ( Constructor c
1405− , ConsFromJSON arity a
1406− ) => FromPair arity (C1 c a) where
1407− parsePair (tag :* p@(_ :* opts :* _)) v
1408− | tag == tag' = Just $ M1 <$> consParseJSON (cname :* p) v
1409− | otherwise = Nothing
1410− where
1411− tag' = pack $ constructorTagModifier opts cname
1412− cname = conName (undefined :: M1 _i c _a _p)
1413−
1414−--------------------------------------------------------------------------------
1415−
1416−class FromUntaggedValue arity f where
1417− parseUntaggedValue :: TypeName :* Options :* FromArgs arity a
1418− -> Value
1419− -> Parser (f a)
1420−
1421−instance
1422− ( FromUntaggedValue arity a
1423− , FromUntaggedValue arity b
1424− ) => FromUntaggedValue arity (a :+: b)
1425− where
1426− parseUntaggedValue p value =
1427− L1 <$> parseUntaggedValue p value <|>
1428− R1 <$> parseUntaggedValue p value
1429−
1430−instance OVERLAPPABLE_
1431− ( ConsFromJSON arity a
1432− , Constructor c
1433− ) => FromUntaggedValue arity (C1 c a)
1434− where
1435− parseUntaggedValue p = fmap M1 . consParseJSON (cname :* p)
1436− where
1437− cname = conName (undefined :: M1 _i c _f _p)
1438−
1439−instance OVERLAPPING_
1440− ( Constructor c )
1441− => FromUntaggedValue arity (C1 c U1)
1442− where
1443− parseUntaggedValue (tname :* opts :* _) v =
1444− contextCons cname tname $ case v of
1445− String tag
1446− | tag == tag' -> pure $ M1 U1
1447− | otherwise -> fail_ tag
1448− _ -> typeMismatch "String" v
1449− where
1450− tag' = pack $ constructorTagModifier opts cname
1451− cname = conName (undefined :: M1 _i c _f _p)
1452− fail_ tag = fail $
1453− "expected tag " ++ show tag' ++ ", but found tag " ++ show tag
1454−
1455−-------------------------------------------------------------------------------
1456−-- Instances
1457−-------------------------------------------------------------------------------
1458−
1459−-------------------------------------------------------------------------------
1460−-- base
1461−-------------------------------------------------------------------------------
1462−
1463−
1464−instance FromJSON2 Const where
1465− liftParseJSON2 p _ _ _ = fmap Const . p
1466− {-# INLINE liftParseJSON2 #-}
1467−
1468−instance FromJSON a => FromJSON1 (Const a) where
1469− liftParseJSON _ _ = fmap Const . parseJSON
1470− {-# INLINE liftParseJSON #-}
1471−
1472−instance FromJSON a => FromJSON (Const a b) where
1473− {-# INLINE parseJSON #-}
1474− parseJSON = fmap Const . parseJSON
1475−
1476−
1477−instance FromJSON1 Maybe where
1478− liftParseJSON _ _ Null = pure Nothing
1479− liftParseJSON p _ a = Just <$> p a
1480− {-# INLINE liftParseJSON #-}
1481−
1482−instance (FromJSON a) => FromJSON (Maybe a) where
1483− parseJSON = parseJSON1
1484− {-# INLINE parseJSON #-}
1485−
1486−
1487−
1488−instance FromJSON2 Either where
1489− liftParseJSON2 pA _ pB _ (Object (H.toList -> [(key, value)]))
1490− | key == left = Left <$> pA value <?> Key left
1491− | key == right = Right <$> pB value <?> Key right
1492− where
1493− left, right :: Text
1494− left = "Left"
1495− right = "Right"
1496−
1497− liftParseJSON2 _ _ _ _ _ = fail $
1498− "expected an object with a single property " ++
1499− "where the property key should be either " ++
1500− "\"Left\" or \"Right\""
1501− {-# INLINE liftParseJSON2 #-}
1502−
1503−instance (FromJSON a) => FromJSON1 (Either a) where
1504− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
1505− {-# INLINE liftParseJSON #-}
1506−
1507−instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where
1508− parseJSON = parseJSON2
1509− {-# INLINE parseJSON #-}
1510−
1511−instance FromJSON Void where
1512− parseJSON _ = fail "Cannot parse Void"
1513− {-# INLINE parseJSON #-}
1514−
1515−instance FromJSON Bool where
1516− parseJSON (Bool b) = pure b
1517− parseJSON v = typeMismatch "Bool" v
1518− {-# INLINE parseJSON #-}
1519−
1520−instance FromJSONKey Bool where
1521− fromJSONKey = FromJSONKeyTextParser $ \t -> case t of
1522− "true" -> pure True
1523− "false" -> pure False
1524− _ -> fail $ "cannot parse key " ++ show t ++ " into Bool"
1525−
1526−instance FromJSON Ordering where
1527− parseJSON = withText "Ordering" $ \s ->
1528− case s of
1529− "LT" -> return LT
1530− "EQ" -> return EQ
1531− "GT" -> return GT
1532− _ -> fail $ "parsing Ordering failed, unexpected " ++ show s ++
1533− " (expected \"LT\", \"EQ\", or \"GT\")"
1534−
1535−instance FromJSON () where
1536− parseJSON = withArray "()" $ \v ->
1537− if V.null v
1538− then pure ()
1539− else prependContext "()" $ fail "expected an empty array"
1540− {-# INLINE parseJSON #-}
1541−
1542−instance FromJSON Char where
1543− parseJSON = withText "Char" parseChar
1544− {-# INLINE parseJSON #-}
1545−
1546− parseJSONList (String s) = pure (T.unpack s)
1547− parseJSONList v = typeMismatch "String" v
1548− {-# INLINE parseJSONList #-}
1549−
1550−parseChar :: Text -> Parser Char
1551−parseChar t =
1552− if T.compareLength t 1 == EQ
1553− then pure $ T.head t
1554− else prependContext "Char" $ fail "expected a string of length 1"
1555−
1556−instance FromJSON Double where
1557− parseJSON = parseRealFloat "Double"
1558− {-# INLINE parseJSON #-}
1559−
1560−instance FromJSONKey Double where
1561− fromJSONKey = FromJSONKeyTextParser $ \t -> case t of
1562− "NaN" -> pure (0/0)
1563− "Infinity" -> pure (1/0)
1564− "-Infinity" -> pure (negate 1/0)
1565− _ -> Scientific.toRealFloat <$> parseScientificText t
1566−
1567−instance FromJSON Float where
1568− parseJSON = parseRealFloat "Float"
1569− {-# INLINE parseJSON #-}
1570−
1571−instance FromJSONKey Float where
1572− fromJSONKey = FromJSONKeyTextParser $ \t -> case t of
1573− "NaN" -> pure (0/0)
1574− "Infinity" -> pure (1/0)
1575− "-Infinity" -> pure (negate 1/0)
1576− _ -> Scientific.toRealFloat <$> parseScientificText t
1577−
1578−instance (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
1589− objParser = withObject "Rational" $ \obj -> do
1590− numerator <- obj .: "numerator"
1591− denominator <- obj .: "denominator"
1592− if denominator == 0
1593− then fail "Ratio denominator was 0"
1594− else pure $ numerator % denominator
1595− {-# INLINE parseJSON #-}
1596−
1597−-- | This instance includes a bounds check to prevent maliciously
1598−-- large inputs to fill up the memory of the target system. You can
1599−-- newtype 'Scientific' and provide your own instance using
1600−-- 'withScientific' if you want to allow larger inputs.
1601−instance HasResolution a => FromJSON (Fixed a) where
1602− parseJSON = prependContext "Fixed" . withBoundedScientific' (pure . realToFrac)
1603− {-# INLINE parseJSON #-}
1604−
1605−instance FromJSON Int where
1606− parseJSON = parseBoundedIntegral "Int"
1607− {-# INLINE parseJSON #-}
1608−
1609−instance FromJSONKey Int where
1610− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int"
1611−
1612−-- | This instance includes a bounds check to prevent maliciously
1613−-- large inputs to fill up the memory of the target system. You can
1614−-- newtype 'Scientific' and provide your own instance using
1615−-- 'withScientific' if you want to allow larger inputs.
1616−instance FromJSON Integer where
1617− parseJSON = parseIntegral "Integer"
1618− {-# INLINE parseJSON #-}
1619−
1620−instance FromJSONKey Integer where
1621− fromJSONKey = FromJSONKeyTextParser $ parseIntegralText "Integer"
1622−
1623−instance FromJSON Natural where
1624− parseJSON value = do
1625− integer <- parseIntegral "Natural" value
1626− parseNatural integer
1627−
1628−instance FromJSONKey Natural where
1629− fromJSONKey = FromJSONKeyTextParser $ \text -> do
1630− integer <- parseIntegralText "Natural" text
1631− parseNatural integer
1632−
1633−parseNatural :: Integer -> Parser Natural
1634−parseNatural integer =
1635− if integer < 0 then
1636− fail $ "parsing Natural failed, unexpected negative number " <> show integer
1637− else
1638− pure $ fromIntegral integer
1639−
1640−instance FromJSON Int8 where
1641− parseJSON = parseBoundedIntegral "Int8"
1642− {-# INLINE parseJSON #-}
1643−
1644−instance FromJSONKey Int8 where
1645− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int8"
1646−
1647−instance FromJSON Int16 where
1648− parseJSON = parseBoundedIntegral "Int16"
1649− {-# INLINE parseJSON #-}
1650−
1651−instance FromJSONKey Int16 where
1652− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int16"
1653−
1654−instance FromJSON Int32 where
1655− parseJSON = parseBoundedIntegral "Int32"
1656− {-# INLINE parseJSON #-}
1657−
1658−instance FromJSONKey Int32 where
1659− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int32"
1660−
1661−instance FromJSON Int64 where
1662− parseJSON = parseBoundedIntegral "Int64"
1663− {-# INLINE parseJSON #-}
1664−
1665−instance FromJSONKey Int64 where
1666− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int64"
1667−
1668−instance FromJSON Word where
1669− parseJSON = parseBoundedIntegral "Word"
1670− {-# INLINE parseJSON #-}
1671−
1672−instance FromJSONKey Word where
1673− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word"
1674−
1675−instance FromJSON Word8 where
1676− parseJSON = parseBoundedIntegral "Word8"
1677− {-# INLINE parseJSON #-}
1678−
1679−instance FromJSONKey Word8 where
1680− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word8"
1681−
1682−instance FromJSON Word16 where
1683− parseJSON = parseBoundedIntegral "Word16"
1684− {-# INLINE parseJSON #-}
1685−
1686−instance FromJSONKey Word16 where
1687− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word16"
1688−
1689−instance FromJSON Word32 where
1690− parseJSON = parseBoundedIntegral "Word32"
1691− {-# INLINE parseJSON #-}
1692−
1693−instance FromJSONKey Word32 where
1694− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word32"
1695−
1696−instance FromJSON Word64 where
1697− parseJSON = parseBoundedIntegral "Word64"
1698− {-# INLINE parseJSON #-}
1699−
1700−instance FromJSONKey Word64 where
1701− fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word64"
1702−
1703−instance FromJSON CTime where
1704− parseJSON = fmap CTime . parseJSON
1705− {-# INLINE parseJSON #-}
1706−
1707−instance FromJSON Text where
1708− parseJSON = withText "Text" pure
1709− {-# INLINE parseJSON #-}
1710−
1711−instance FromJSONKey Text where
1712− fromJSONKey = fromJSONKeyCoerce
1713−
1714−
1715−instance FromJSON LT.Text where
1716− parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
1717− {-# INLINE parseJSON #-}
1718−
1719−instance FromJSONKey LT.Text where
1720− fromJSONKey = FromJSONKeyText LT.fromStrict
1721−
1722−
1723−instance FromJSON Version where
1724− parseJSON = withText "Version" parseVersionText
1725− {-# INLINE parseJSON #-}
1726−
1727−instance FromJSONKey Version where
1728− fromJSONKey = FromJSONKeyTextParser parseVersionText
1729−
1730−parseVersionText :: Text -> Parser Version
1731−parseVersionText = go . readP_to_S parseVersion . unpack
1732− where
1733− go [(v,[])] = return v
1734− go (_ : xs) = go xs
1735− go _ = fail "parsing Version failed"
1736−
1737−-------------------------------------------------------------------------------
1738−-- semigroups NonEmpty
1739−-------------------------------------------------------------------------------
1740−
1741−instance FromJSON1 NonEmpty where
1742− liftParseJSON p _ = withArray "NonEmpty" $
1743− (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
1744− where
1745− ne [] = fail "parsing NonEmpty failed, unexpected empty list"
1746− ne (x:xs) = pure (x :| xs)
1747− {-# INLINE liftParseJSON #-}
1748−
1749−instance (FromJSON a) => FromJSON (NonEmpty a) where
1750− parseJSON = parseJSON1
1751− {-# INLINE parseJSON #-}
1752−
1753−-------------------------------------------------------------------------------
1754−-- scientific
1755−-------------------------------------------------------------------------------
1756−
1757−instance FromJSON Scientific where
1758− parseJSON = withScientific "Scientific" pure
1759− {-# INLINE parseJSON #-}
1760−
1761−-------------------------------------------------------------------------------
1762−-- DList
1763−-------------------------------------------------------------------------------
1764−
1765−instance FromJSON1 DList.DList where
1766− liftParseJSON p _ = withArray "DList" $
1767− fmap DList.fromList .
1768− Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
1769− {-# INLINE liftParseJSON #-}
1770−
1771−instance (FromJSON a) => FromJSON (DList.DList a) where
1772− parseJSON = parseJSON1
1773− {-# INLINE parseJSON #-}
1774−
1775−-------------------------------------------------------------------------------
1776−-- tranformers - Functors
1777−-------------------------------------------------------------------------------
1778−
1779−instance FromJSON1 Identity where
1780− liftParseJSON p _ a = Identity <$> p a
1781− {-# INLINE liftParseJSON #-}
1782−
1783− liftParseJSONList _ p a = fmap Identity <$> p a
1784− {-# INLINE liftParseJSONList #-}
1785−
1786−instance (FromJSON a) => FromJSON (Identity a) where
1787− parseJSON = parseJSON1
1788− {-# INLINE parseJSON #-}
1789−
1790− parseJSONList = liftParseJSONList parseJSON parseJSONList
1791− {-# INLINE parseJSONList #-}
1792−
1793−instance (FromJSONKey a) => FromJSONKey (Identity a) where
1794− fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction a)
1795− fromJSONKeyList = coerceFromJSONKeyFunction (fromJSONKeyList :: FromJSONKeyFunction [a])
1796−
1797−
1798−instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Compose f g) where
1799− liftParseJSON p pl a = Compose <$> liftParseJSON g gl a
1800− where
1801− g = liftParseJSON p pl
1802− gl = liftParseJSONList p pl
1803− {-# INLINE liftParseJSON #-}
1804−
1805− liftParseJSONList p pl a = map Compose <$> liftParseJSONList g gl a
1806− where
1807− g = liftParseJSON p pl
1808− gl = liftParseJSONList p pl
1809− {-# INLINE liftParseJSONList #-}
1810−
1811−instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Compose f g a) where
1812− parseJSON = parseJSON1
1813− {-# INLINE parseJSON #-}
1814−
1815− parseJSONList = liftParseJSONList parseJSON parseJSONList
1816− {-# INLINE parseJSONList #-}
1817−
1818−
1819−instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Product f g) where
1820− liftParseJSON p pl a = uncurry Pair <$> liftParseJSON2 px pxl py pyl a
1821− where
1822− px = liftParseJSON p pl
1823− pxl = liftParseJSONList p pl
1824− py = liftParseJSON p pl
1825− pyl = liftParseJSONList p pl
1826− {-# INLINE liftParseJSON #-}
1827−
1828−instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Product f g a) where
1829− parseJSON = parseJSON1
1830− {-# INLINE parseJSON #-}
1831−
1832−
1833−instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Sum f g) where
1834− liftParseJSON p pl (Object (H.toList -> [(key, value)]))
1835− | key == inl = InL <$> liftParseJSON p pl value <?> Key inl
1836− | key == inr = InR <$> liftParseJSON p pl value <?> Key inl
1837− where
1838− inl, inr :: Text
1839− inl = "InL"
1840− inr = "InR"
1841−
1842− liftParseJSON _ _ _ = fail $
1843− "parsing Sum failed, expected an object with a single property " ++
1844− "where the property key should be either " ++
1845− "\"InL\" or \"InR\""
1846− {-# INLINE liftParseJSON #-}
1847−
1848−instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Sum f g a) where
1849− parseJSON = parseJSON1
1850− {-# INLINE parseJSON #-}
1851−
1852−-------------------------------------------------------------------------------
1853−-- containers
1854−-------------------------------------------------------------------------------
1855−
1856−instance FromJSON1 Seq.Seq where
1857− liftParseJSON p _ = withArray "Seq" $
1858− fmap Seq.fromList .
1859− Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
1860− {-# INLINE liftParseJSON #-}
1861−
1862−instance (FromJSON a) => FromJSON (Seq.Seq a) where
1863− parseJSON = parseJSON1
1864− {-# INLINE parseJSON #-}
1865−
1866−
1867−instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where
1868− parseJSON = fmap Set.fromList . parseJSON
1869− {-# INLINE parseJSON #-}
1870−
1871−
1872−instance FromJSON IntSet.IntSet where
1873− parseJSON = fmap IntSet.fromList . parseJSON
1874− {-# INLINE parseJSON #-}
1875−
1876−
1877−instance FromJSON1 IntMap.IntMap where
1878− liftParseJSON p pl = fmap IntMap.fromList . liftParseJSON p' pl'
1879− where
1880− p' = liftParseJSON2 parseJSON parseJSONList p pl
1881− pl' = liftParseJSONList2 parseJSON parseJSONList p pl
1882− {-# INLINE liftParseJSON #-}
1883−
1884−instance FromJSON a => FromJSON (IntMap.IntMap a) where
1885− parseJSON = fmap IntMap.fromList . parseJSON
1886− {-# INLINE parseJSON #-}
1887−
1888−
1889−instance (FromJSONKey k, Ord k) => FromJSON1 (M.Map k) where
1890− liftParseJSON p _ = case fromJSONKey of
1891− FromJSONKeyCoerce _ -> withObject "Map" $
1892− fmap (H.foldrWithKey (M.insert . unsafeCoerce) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)
1893− FromJSONKeyText f -> withObject "Map" $
1894− fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)
1895− FromJSONKeyTextParser f -> withObject "Map" $
1896− H.foldrWithKey (\k v m -> M.insert <$> f k <?> Key k <*> p v <?> Key k <*> m) (pure M.empty)
1897− FromJSONKeyValue f -> withArray "Map" $ \arr ->
1898− fmap M.fromList . Tr.sequence .
1899− zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr
1900− {-# INLINE liftParseJSON #-}
1901−
1902−instance (FromJSONKey k, Ord k, FromJSON v) => FromJSON (M.Map k v) where
1903− parseJSON = parseJSON1
1904− {-# INLINE parseJSON #-}
1905−
1906−
1907−instance FromJSON1 Tree.Tree where
1908− liftParseJSON p pl = go
1909− where
1910− go v = uncurry Tree.Node <$> liftParseJSON2 p pl p' pl' v
1911−
1912− p' = liftParseJSON go (listParser go)
1913− pl'= liftParseJSONList go (listParser go)
1914−
1915−instance (FromJSON v) => FromJSON (Tree.Tree v) where
1916− parseJSON = parseJSON1
1917− {-# INLINE parseJSON #-}
1918−
1919−-------------------------------------------------------------------------------
1920−-- uuid
1921−-------------------------------------------------------------------------------
1922−
1923−instance FromJSON UUID.UUID where
1924− parseJSON = withText "UUID" $
1925− maybe (fail "invalid UUID") pure . UUID.fromText
1926−
1927−instance FromJSONKey UUID.UUID where
1928− fromJSONKey = FromJSONKeyTextParser $
1929− maybe (fail "invalid UUID") pure . UUID.fromText
1930−
1931−-------------------------------------------------------------------------------
1932−-- vector
1933−-------------------------------------------------------------------------------
1934−
1935−instance FromJSON1 Vector where
1936− liftParseJSON p _ = withArray "Vector" $
1937− V.mapM (uncurry $ parseIndexedJSON p) . V.indexed
1938− {-# INLINE liftParseJSON #-}
1939−
1940−instance (FromJSON a) => FromJSON (Vector a) where
1941− parseJSON = parseJSON1
1942− {-# INLINE parseJSON #-}
1943−
1944−
1945−vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
1946−vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry $ parseIndexedJSON parseJSON) . V.indexed
1947−{-# INLINE vectorParseJSON #-}
1948−
1949−instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where
1950− parseJSON = vectorParseJSON "Data.Vector.Storable.Vector"
1951−
1952−instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where
1953− parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector"
1954− {-# INLINE parseJSON #-}
1955−
1956−instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where
1957− parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector"
1958− {-# INLINE parseJSON #-}
1959−
1960−-------------------------------------------------------------------------------
1961−-- unordered-containers
1962−-------------------------------------------------------------------------------
1963−
1964−instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where
1965− parseJSON = fmap HashSet.fromList . parseJSON
1966− {-# INLINE parseJSON #-}
1967−
1968−
1969−instance (FromJSONKey k, Eq k, Hashable k) => FromJSON1 (H.HashMap k) where
1970− liftParseJSON p _ = case fromJSONKey of
1971− FromJSONKeyCoerce _ -> withObject "HashMap ~Text" $
1972− uc . H.traverseWithKey (\k v -> p v <?> Key k)
1973− FromJSONKeyText f -> withObject "HashMap" $
1974− fmap (mapKey f) . H.traverseWithKey (\k v -> p v <?> Key k)
1975− FromJSONKeyTextParser f -> withObject "HashMap" $
1976− H.foldrWithKey (\k v m -> H.insert <$> f k <?> Key k <*> p v <?> Key k <*> m) (pure H.empty)
1977− FromJSONKeyValue f -> withArray "Map" $ \arr ->
1978− fmap H.fromList . Tr.sequence .
1979− zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr
1980− where
1981− uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)
1982− uc = unsafeCoerce
1983−
1984−instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where
1985− parseJSON = parseJSON1
1986− {-# INLINE parseJSON #-}
1987−
1988−-------------------------------------------------------------------------------
1989−-- aeson
1990−-------------------------------------------------------------------------------
1991−
1992−instance FromJSON Value where
1993− parseJSON = pure
1994− {-# INLINE parseJSON #-}
1995−
1996−instance FromJSON DotNetTime where
1997− parseJSON = withText "DotNetTime" $ \t ->
1998− let (s,m) = T.splitAt (T.length t - 5) t
1999− t' = T.concat [s,".",m]
2000− in case parseTimeM True defaultTimeLocale "/Date(%s%Q)/" (unpack t') of
2001− Just d -> pure (DotNetTime d)
2002− _ -> fail "could not parse .NET time"
2003− {-# INLINE parseJSON #-}
2004−
2005−-------------------------------------------------------------------------------
2006−-- primitive
2007−-------------------------------------------------------------------------------
2008−
2009−instance FromJSON a => FromJSON (PM.Array a) where
2010− -- note: we could do better than this if vector exposed the data
2011− -- constructor in Data.Vector.
2012− parseJSON = fmap Exts.fromList . parseJSON
2013−
2014−instance FromJSON a => FromJSON (PM.SmallArray a) where
2015− parseJSON = fmap Exts.fromList . parseJSON
2016−
2017−#if MIN_VERSION_primitive(0,6,4)
2018−instance (PM.Prim a,FromJSON a) => FromJSON (PM.PrimArray a) where
2019− parseJSON = fmap Exts.fromList . parseJSON
2020−
2021−#if !MIN_VERSION_primitive(0,7,0)
2022−instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where
2023− parseJSON = fmap Exts.fromList . parseJSON
2024−#endif
2025−#endif
2026−
2027−-------------------------------------------------------------------------------
2028−-- time
2029−-------------------------------------------------------------------------------
2030−
2031−instance FromJSON Day where
2032− parseJSON = withText "Day" (Time.run Time.day)
2033−
2034−instance FromJSONKey Day where
2035− fromJSONKey = FromJSONKeyTextParser (Time.run Time.day)
2036−
2037−
2038−instance FromJSON TimeOfDay where
2039− parseJSON = withText "TimeOfDay" (Time.run Time.timeOfDay)
2040−
2041−instance FromJSONKey TimeOfDay where
2042− fromJSONKey = FromJSONKeyTextParser (Time.run Time.timeOfDay)
2043−
2044−
2045−instance FromJSON LocalTime where
2046− parseJSON = withText "LocalTime" (Time.run Time.localTime)
2047−
2048−instance FromJSONKey LocalTime where
2049− fromJSONKey = FromJSONKeyTextParser (Time.run Time.localTime)
2050−
2051−
2052−-- | Supported string formats:
2053−--
2054−-- @YYYY-MM-DD HH:MM Z@
2055−-- @YYYY-MM-DD HH:MM:SS Z@
2056−-- @YYYY-MM-DD HH:MM:SS.SSS Z@
2057−--
2058−-- The first space may instead be a @T@, and the second space is
2059−-- optional. The @Z@ represents UTC. The @Z@ may be replaced with a
2060−-- time zone offset of the form @+0000@ or @-08:00@, where the first
2061−-- two digits are hours, the @:@ is optional and the second two digits
2062−-- (also optional) are minutes.
2063−instance FromJSON ZonedTime where
2064− parseJSON = withText "ZonedTime" (Time.run Time.zonedTime)
2065−
2066−instance FromJSONKey ZonedTime where
2067− fromJSONKey = FromJSONKeyTextParser (Time.run Time.zonedTime)
2068−
2069−
2070−instance FromJSON UTCTime where
2071− parseJSON = withText "UTCTime" (Time.run Time.utcTime)
2072−
2073−instance FromJSONKey UTCTime where
2074− fromJSONKey = FromJSONKeyTextParser (Time.run Time.utcTime)
2075−
2076−
2077−-- | This instance includes a bounds check to prevent maliciously
2078−-- large inputs to fill up the memory of the target system. You can
2079−-- newtype 'Scientific' and provide your own instance using
2080−-- 'withScientific' if you want to allow larger inputs.
2081−instance FromJSON NominalDiffTime where
2082− parseJSON = withBoundedScientific "NominalDiffTime" $ pure . realToFrac
2083− {-# INLINE parseJSON #-}
2084−
2085−
2086−-- | This instance includes a bounds check to prevent maliciously
2087−-- large inputs to fill up the memory of the target system. You can
2088−-- newtype 'Scientific' and provide your own instance using
2089−-- 'withScientific' if you want to allow larger inputs.
2090−instance FromJSON DiffTime where
2091− parseJSON = withBoundedScientific "DiffTime" $ pure . realToFrac
2092− {-# INLINE parseJSON #-}
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−
2128−-------------------------------------------------------------------------------
2129−-- base Monoid/Semigroup
2130−-------------------------------------------------------------------------------
2131−
2132−instance FromJSON1 Monoid.Dual where
2133− liftParseJSON p _ = fmap Monoid.Dual . p
2134− {-# INLINE liftParseJSON #-}
2135−
2136−instance FromJSON a => FromJSON (Monoid.Dual a) where
2137− parseJSON = parseJSON1
2138− {-# INLINE parseJSON #-}
2139−
2140−
2141−instance FromJSON1 Monoid.First where
2142− liftParseJSON p p' = fmap Monoid.First . liftParseJSON p p'
2143− {-# INLINE liftParseJSON #-}
2144−
2145−instance FromJSON a => FromJSON (Monoid.First a) where
2146− parseJSON = parseJSON1
2147− {-# INLINE parseJSON #-}
2148−
2149−
2150−instance FromJSON1 Monoid.Last where
2151− liftParseJSON p p' = fmap Monoid.Last . liftParseJSON p p'
2152− {-# INLINE liftParseJSON #-}
2153−
2154−instance FromJSON a => FromJSON (Monoid.Last a) where
2155− parseJSON = parseJSON1
2156− {-# INLINE parseJSON #-}
2157−
2158−
2159−instance FromJSON1 Semigroup.Min where
2160− liftParseJSON p _ a = Semigroup.Min <$> p a
2161− {-# INLINE liftParseJSON #-}
2162−
2163− liftParseJSONList _ p a = fmap Semigroup.Min <$> p a
2164− {-# INLINE liftParseJSONList #-}
2165−
2166−instance (FromJSON a) => FromJSON (Semigroup.Min a) where
2167− parseJSON = parseJSON1
2168− {-# INLINE parseJSON #-}
2169−
2170− parseJSONList = liftParseJSONList parseJSON parseJSONList
2171− {-# INLINE parseJSONList #-}
2172−
2173−
2174−instance FromJSON1 Semigroup.Max where
2175− liftParseJSON p _ a = Semigroup.Max <$> p a
2176− {-# INLINE liftParseJSON #-}
2177−
2178− liftParseJSONList _ p a = fmap Semigroup.Max <$> p a
2179− {-# INLINE liftParseJSONList #-}
2180−
2181−instance (FromJSON a) => FromJSON (Semigroup.Max a) where
2182− parseJSON = parseJSON1
2183− {-# INLINE parseJSON #-}
2184−
2185− parseJSONList = liftParseJSONList parseJSON parseJSONList
2186− {-# INLINE parseJSONList #-}
2187−
2188−
2189−instance FromJSON1 Semigroup.First where
2190− liftParseJSON p _ a = Semigroup.First <$> p a
2191− {-# INLINE liftParseJSON #-}
2192−
2193− liftParseJSONList _ p a = fmap Semigroup.First <$> p a
2194− {-# INLINE liftParseJSONList #-}
2195−
2196−instance (FromJSON a) => FromJSON (Semigroup.First a) where
2197− parseJSON = parseJSON1
2198− {-# INLINE parseJSON #-}
2199−
2200− parseJSONList = liftParseJSONList parseJSON parseJSONList
2201− {-# INLINE parseJSONList #-}
2202−
2203−
2204−instance FromJSON1 Semigroup.Last where
2205− liftParseJSON p _ a = Semigroup.Last <$> p a
2206− {-# INLINE liftParseJSON #-}
2207−
2208− liftParseJSONList _ p a = fmap Semigroup.Last <$> p a
2209− {-# INLINE liftParseJSONList #-}
2210−
2211−instance (FromJSON a) => FromJSON (Semigroup.Last a) where
2212− parseJSON = parseJSON1
2213− {-# INLINE parseJSON #-}
2214−
2215− parseJSONList = liftParseJSONList parseJSON parseJSONList
2216− {-# INLINE parseJSONList #-}
2217−
2218−
2219−instance FromJSON1 Semigroup.WrappedMonoid where
2220− liftParseJSON p _ a = Semigroup.WrapMonoid <$> p a
2221− {-# INLINE liftParseJSON #-}
2222−
2223− liftParseJSONList _ p a = fmap Semigroup.WrapMonoid <$> p a
2224− {-# INLINE liftParseJSONList #-}
2225−
2226−instance (FromJSON a) => FromJSON (Semigroup.WrappedMonoid a) where
2227− parseJSON = parseJSON1
2228− {-# INLINE parseJSON #-}
2229−
2230− parseJSONList = liftParseJSONList parseJSON parseJSONList
2231− {-# INLINE parseJSONList #-}
2232−
2233−
2234−instance FromJSON1 Semigroup.Option where
2235− liftParseJSON p p' = fmap Semigroup.Option . liftParseJSON p p'
2236− {-# INLINE liftParseJSON #-}
2237−
2238−instance FromJSON a => FromJSON (Semigroup.Option a) where
2239− parseJSON = parseJSON1
2240− {-# INLINE parseJSON #-}
2241−
2242−-------------------------------------------------------------------------------
2243−-- tagged
2244−-------------------------------------------------------------------------------
2245−
2246−instance FromJSON1 Proxy where
2247− {-# INLINE liftParseJSON #-}
2248− liftParseJSON _ _ = fromNull "Proxy" Proxy
2249−
2250−instance FromJSON (Proxy a) where
2251− {-# INLINE parseJSON #-}
2252− parseJSON = fromNull "Proxy" Proxy
2253−
2254−fromNull :: String -> a -> Value -> Parser a
2255−fromNull _ a Null = pure a
2256−fromNull c _ v = prependContext c (typeMismatch "Null" v)
2257−
2258−instance FromJSON2 Tagged where
2259− liftParseJSON2 _ _ p _ = fmap Tagged . p
2260− {-# INLINE liftParseJSON2 #-}
2261−
2262−instance FromJSON1 (Tagged a) where
2263− liftParseJSON p _ = fmap Tagged . p
2264− {-# INLINE liftParseJSON #-}
2265−
2266−instance FromJSON b => FromJSON (Tagged a b) where
2267− parseJSON = parseJSON1
2268− {-# INLINE parseJSON #-}
2269−
2270−instance FromJSONKey b => FromJSONKey (Tagged a b) where
2271− fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)
2272− fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList
2273−
2274−-------------------------------------------------------------------------------
2275−-- Instances for converting from map keys
2276−-------------------------------------------------------------------------------
2277−
2278−instance (FromJSON a, FromJSON b) => FromJSONKey (a,b)
2279−instance (FromJSON a, FromJSON b, FromJSON c) => FromJSONKey (a,b,c)
2280−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSONKey (a,b,c,d)
2281−
2282−instance FromJSONKey Char where
2283− fromJSONKey = FromJSONKeyTextParser parseChar
2284− fromJSONKeyList = FromJSONKeyText T.unpack
2285−
2286−instance (FromJSONKey a, FromJSON a) => FromJSONKey [a] where
2287− fromJSONKey = fromJSONKeyList
2288−
2289−-------------------------------------------------------------------------------
2290−-- Tuple instances, see tuple-instances-from.hs
2291−-------------------------------------------------------------------------------
2292−
2293−instance FromJSON2 (,) where
2294− liftParseJSON2 pA _ pB _ = withArray "(a, b)" $ \t ->
2295− let n = V.length t
2296− in if n == 2
2297− then (,)
2298− <$> parseJSONElemAtIndex pA 0 t
2299− <*> parseJSONElemAtIndex pB 1 t
2300− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 2"
2301− {-# INLINE liftParseJSON2 #-}
2302−
2303−instance (FromJSON a) => FromJSON1 ((,) a) where
2304− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2305− {-# INLINE liftParseJSON #-}
2306−
2307−instance (FromJSON a, FromJSON b) => FromJSON (a, b) where
2308− parseJSON = parseJSON2
2309− {-# INLINE parseJSON #-}
2310−
2311−
2312−instance (FromJSON a) => FromJSON2 ((,,) a) where
2313− liftParseJSON2 pB _ pC _ = withArray "(a, b, c)" $ \t ->
2314− let n = V.length t
2315− in if n == 3
2316− then (,,)
2317− <$> parseJSONElemAtIndex parseJSON 0 t
2318− <*> parseJSONElemAtIndex pB 1 t
2319− <*> parseJSONElemAtIndex pC 2 t
2320− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 3"
2321− {-# INLINE liftParseJSON2 #-}
2322−
2323−instance (FromJSON a, FromJSON b) => FromJSON1 ((,,) a b) where
2324− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2325− {-# INLINE liftParseJSON #-}
2326−
2327−instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a, b, c) where
2328− parseJSON = parseJSON2
2329− {-# INLINE parseJSON #-}
2330−
2331−
2332−instance (FromJSON a, FromJSON b) => FromJSON2 ((,,,) a b) where
2333− liftParseJSON2 pC _ pD _ = withArray "(a, b, c, d)" $ \t ->
2334− let n = V.length t
2335− in if n == 4
2336− then (,,,)
2337− <$> parseJSONElemAtIndex parseJSON 0 t
2338− <*> parseJSONElemAtIndex parseJSON 1 t
2339− <*> parseJSONElemAtIndex pC 2 t
2340− <*> parseJSONElemAtIndex pD 3 t
2341− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 4"
2342− {-# INLINE liftParseJSON2 #-}
2343−
2344−instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON1 ((,,,) a b c) where
2345− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2346− {-# INLINE liftParseJSON #-}
2347−
2348−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a, b, c, d) where
2349− parseJSON = parseJSON2
2350− {-# INLINE parseJSON #-}
2351−
2352−
2353−instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON2 ((,,,,) a b c) where
2354− liftParseJSON2 pD _ pE _ = withArray "(a, b, c, d, e)" $ \t ->
2355− let n = V.length t
2356− in if n == 5
2357− then (,,,,)
2358− <$> parseJSONElemAtIndex parseJSON 0 t
2359− <*> parseJSONElemAtIndex parseJSON 1 t
2360− <*> parseJSONElemAtIndex parseJSON 2 t
2361− <*> parseJSONElemAtIndex pD 3 t
2362− <*> parseJSONElemAtIndex pE 4 t
2363− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 5"
2364− {-# INLINE liftParseJSON2 #-}
2365−
2366−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON1 ((,,,,) a b c d) where
2367− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2368− {-# INLINE liftParseJSON #-}
2369−
2370−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON (a, b, c, d, e) where
2371− parseJSON = parseJSON2
2372− {-# INLINE parseJSON #-}
2373−
2374−
2375−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON2 ((,,,,,) a b c d) where
2376− liftParseJSON2 pE _ pF _ = withArray "(a, b, c, d, e, f)" $ \t ->
2377− let n = V.length t
2378− in if n == 6
2379− then (,,,,,)
2380− <$> parseJSONElemAtIndex parseJSON 0 t
2381− <*> parseJSONElemAtIndex parseJSON 1 t
2382− <*> parseJSONElemAtIndex parseJSON 2 t
2383− <*> parseJSONElemAtIndex parseJSON 3 t
2384− <*> parseJSONElemAtIndex pE 4 t
2385− <*> parseJSONElemAtIndex pF 5 t
2386− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 6"
2387− {-# INLINE liftParseJSON2 #-}
2388−
2389−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON1 ((,,,,,) a b c d e) where
2390− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2391− {-# INLINE liftParseJSON #-}
2392−
2393−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON (a, b, c, d, e, f) where
2394− parseJSON = parseJSON2
2395− {-# INLINE parseJSON #-}
2396−
2397−
2398−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON2 ((,,,,,,) a b c d e) where
2399− liftParseJSON2 pF _ pG _ = withArray "(a, b, c, d, e, f, g)" $ \t ->
2400− let n = V.length t
2401− in if n == 7
2402− then (,,,,,,)
2403− <$> parseJSONElemAtIndex parseJSON 0 t
2404− <*> parseJSONElemAtIndex parseJSON 1 t
2405− <*> parseJSONElemAtIndex parseJSON 2 t
2406− <*> parseJSONElemAtIndex parseJSON 3 t
2407− <*> parseJSONElemAtIndex parseJSON 4 t
2408− <*> parseJSONElemAtIndex pF 5 t
2409− <*> parseJSONElemAtIndex pG 6 t
2410− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 7"
2411− {-# INLINE liftParseJSON2 #-}
2412−
2413−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON1 ((,,,,,,) a b c d e f) where
2414− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2415− {-# INLINE liftParseJSON #-}
2416−
2417−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON (a, b, c, d, e, f, g) where
2418− parseJSON = parseJSON2
2419− {-# INLINE parseJSON #-}
2420−
2421−
2422−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON2 ((,,,,,,,) a b c d e f) where
2423− liftParseJSON2 pG _ pH _ = withArray "(a, b, c, d, e, f, g, h)" $ \t ->
2424− let n = V.length t
2425− in if n == 8
2426− then (,,,,,,,)
2427− <$> parseJSONElemAtIndex parseJSON 0 t
2428− <*> parseJSONElemAtIndex parseJSON 1 t
2429− <*> parseJSONElemAtIndex parseJSON 2 t
2430− <*> parseJSONElemAtIndex parseJSON 3 t
2431− <*> parseJSONElemAtIndex parseJSON 4 t
2432− <*> parseJSONElemAtIndex parseJSON 5 t
2433− <*> parseJSONElemAtIndex pG 6 t
2434− <*> parseJSONElemAtIndex pH 7 t
2435− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 8"
2436− {-# INLINE liftParseJSON2 #-}
2437−
2438−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON1 ((,,,,,,,) a b c d e f g) where
2439− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2440− {-# INLINE liftParseJSON #-}
2441−
2442−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON (a, b, c, d, e, f, g, h) where
2443− parseJSON = parseJSON2
2444− {-# INLINE parseJSON #-}
2445−
2446−
2447−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON2 ((,,,,,,,,) a b c d e f g) where
2448− liftParseJSON2 pH _ pI _ = withArray "(a, b, c, d, e, f, g, h, i)" $ \t ->
2449− let n = V.length t
2450− in if n == 9
2451− then (,,,,,,,,)
2452− <$> parseJSONElemAtIndex parseJSON 0 t
2453− <*> parseJSONElemAtIndex parseJSON 1 t
2454− <*> parseJSONElemAtIndex parseJSON 2 t
2455− <*> parseJSONElemAtIndex parseJSON 3 t
2456− <*> parseJSONElemAtIndex parseJSON 4 t
2457− <*> parseJSONElemAtIndex parseJSON 5 t
2458− <*> parseJSONElemAtIndex parseJSON 6 t
2459− <*> parseJSONElemAtIndex pH 7 t
2460− <*> parseJSONElemAtIndex pI 8 t
2461− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 9"
2462− {-# INLINE liftParseJSON2 #-}
2463−
2464−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON1 ((,,,,,,,,) a b c d e f g h) where
2465− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2466− {-# INLINE liftParseJSON #-}
2467−
2468−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON (a, b, c, d, e, f, g, h, i) where
2469− parseJSON = parseJSON2
2470− {-# INLINE parseJSON #-}
2471−
2472−
2473−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON2 ((,,,,,,,,,) a b c d e f g h) where
2474− liftParseJSON2 pI _ pJ _ = withArray "(a, b, c, d, e, f, g, h, i, j)" $ \t ->
2475− let n = V.length t
2476− in if n == 10
2477− then (,,,,,,,,,)
2478− <$> parseJSONElemAtIndex parseJSON 0 t
2479− <*> parseJSONElemAtIndex parseJSON 1 t
2480− <*> parseJSONElemAtIndex parseJSON 2 t
2481− <*> parseJSONElemAtIndex parseJSON 3 t
2482− <*> parseJSONElemAtIndex parseJSON 4 t
2483− <*> parseJSONElemAtIndex parseJSON 5 t
2484− <*> parseJSONElemAtIndex parseJSON 6 t
2485− <*> parseJSONElemAtIndex parseJSON 7 t
2486− <*> parseJSONElemAtIndex pI 8 t
2487− <*> parseJSONElemAtIndex pJ 9 t
2488− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 10"
2489− {-# INLINE liftParseJSON2 #-}
2490−
2491−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON1 ((,,,,,,,,,) a b c d e f g h i) where
2492− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2493− {-# INLINE liftParseJSON #-}
2494−
2495−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON (a, b, c, d, e, f, g, h, i, j) where
2496− parseJSON = parseJSON2
2497− {-# INLINE parseJSON #-}
2498−
2499−
2500−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON2 ((,,,,,,,,,,) a b c d e f g h i) where
2501− liftParseJSON2 pJ _ pK _ = withArray "(a, b, c, d, e, f, g, h, i, j, k)" $ \t ->
2502− let n = V.length t
2503− in if n == 11
2504− then (,,,,,,,,,,)
2505− <$> parseJSONElemAtIndex parseJSON 0 t
2506− <*> parseJSONElemAtIndex parseJSON 1 t
2507− <*> parseJSONElemAtIndex parseJSON 2 t
2508− <*> parseJSONElemAtIndex parseJSON 3 t
2509− <*> parseJSONElemAtIndex parseJSON 4 t
2510− <*> parseJSONElemAtIndex parseJSON 5 t
2511− <*> parseJSONElemAtIndex parseJSON 6 t
2512− <*> parseJSONElemAtIndex parseJSON 7 t
2513− <*> parseJSONElemAtIndex parseJSON 8 t
2514− <*> parseJSONElemAtIndex pJ 9 t
2515− <*> parseJSONElemAtIndex pK 10 t
2516− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 11"
2517− {-# INLINE liftParseJSON2 #-}
2518−
2519−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
2520− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2521− {-# INLINE liftParseJSON #-}
2522−
2523−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON (a, b, c, d, e, f, g, h, i, j, k) where
2524− parseJSON = parseJSON2
2525− {-# INLINE parseJSON #-}
2526−
2527−
2528−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) where
2529− liftParseJSON2 pK _ pL _ = withArray "(a, b, c, d, e, f, g, h, i, j, k, l)" $ \t ->
2530− let n = V.length t
2531− in if n == 12
2532− then (,,,,,,,,,,,)
2533− <$> parseJSONElemAtIndex parseJSON 0 t
2534− <*> parseJSONElemAtIndex parseJSON 1 t
2535− <*> parseJSONElemAtIndex parseJSON 2 t
2536− <*> parseJSONElemAtIndex parseJSON 3 t
2537− <*> parseJSONElemAtIndex parseJSON 4 t
2538− <*> parseJSONElemAtIndex parseJSON 5 t
2539− <*> parseJSONElemAtIndex parseJSON 6 t
2540− <*> parseJSONElemAtIndex parseJSON 7 t
2541− <*> parseJSONElemAtIndex parseJSON 8 t
2542− <*> parseJSONElemAtIndex parseJSON 9 t
2543− <*> parseJSONElemAtIndex pK 10 t
2544− <*> parseJSONElemAtIndex pL 11 t
2545− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 12"
2546− {-# INLINE liftParseJSON2 #-}
2547−
2548−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
2549− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2550− {-# INLINE liftParseJSON #-}
2551−
2552−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l) where
2553− parseJSON = parseJSON2
2554− {-# INLINE parseJSON #-}
2555−
2556−
2557−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) where
2558− liftParseJSON2 pL _ pM _ = withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m)" $ \t ->
2559− let n = V.length t
2560− in if n == 13
2561− then (,,,,,,,,,,,,)
2562− <$> parseJSONElemAtIndex parseJSON 0 t
2563− <*> parseJSONElemAtIndex parseJSON 1 t
2564− <*> parseJSONElemAtIndex parseJSON 2 t
2565− <*> parseJSONElemAtIndex parseJSON 3 t
2566− <*> parseJSONElemAtIndex parseJSON 4 t
2567− <*> parseJSONElemAtIndex parseJSON 5 t
2568− <*> parseJSONElemAtIndex parseJSON 6 t
2569− <*> parseJSONElemAtIndex parseJSON 7 t
2570− <*> parseJSONElemAtIndex parseJSON 8 t
2571− <*> parseJSONElemAtIndex parseJSON 9 t
2572− <*> parseJSONElemAtIndex parseJSON 10 t
2573− <*> parseJSONElemAtIndex pL 11 t
2574− <*> parseJSONElemAtIndex pM 12 t
2575− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 13"
2576− {-# INLINE liftParseJSON2 #-}
2577−
2578−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
2579− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2580− {-# INLINE liftParseJSON #-}
2581−
2582−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) where
2583− parseJSON = parseJSON2
2584− {-# INLINE parseJSON #-}
2585−
2586−
2587−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) where
2588− liftParseJSON2 pM _ pN _ = withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m, n)" $ \t ->
2589− let n = V.length t
2590− in if n == 14
2591− then (,,,,,,,,,,,,,)
2592− <$> parseJSONElemAtIndex parseJSON 0 t
2593− <*> parseJSONElemAtIndex parseJSON 1 t
2594− <*> parseJSONElemAtIndex parseJSON 2 t
2595− <*> parseJSONElemAtIndex parseJSON 3 t
2596− <*> parseJSONElemAtIndex parseJSON 4 t
2597− <*> parseJSONElemAtIndex parseJSON 5 t
2598− <*> parseJSONElemAtIndex parseJSON 6 t
2599− <*> parseJSONElemAtIndex parseJSON 7 t
2600− <*> parseJSONElemAtIndex parseJSON 8 t
2601− <*> parseJSONElemAtIndex parseJSON 9 t
2602− <*> parseJSONElemAtIndex parseJSON 10 t
2603− <*> parseJSONElemAtIndex parseJSON 11 t
2604− <*> parseJSONElemAtIndex pM 12 t
2605− <*> parseJSONElemAtIndex pN 13 t
2606− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 14"
2607− {-# INLINE liftParseJSON2 #-}
2608−
2609−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
2610− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2611− {-# INLINE liftParseJSON #-}
2612−
2613−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
2614− parseJSON = parseJSON2
2615− {-# INLINE parseJSON #-}
2616−
2617−
2618−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
2619− liftParseJSON2 pN _ pO _ = withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)" $ \t ->
2620− let n = V.length t
2621− in if n == 15
2622− then (,,,,,,,,,,,,,,)
2623− <$> parseJSONElemAtIndex parseJSON 0 t
2624− <*> parseJSONElemAtIndex parseJSON 1 t
2625− <*> parseJSONElemAtIndex parseJSON 2 t
2626− <*> parseJSONElemAtIndex parseJSON 3 t
2627− <*> parseJSONElemAtIndex parseJSON 4 t
2628− <*> parseJSONElemAtIndex parseJSON 5 t
2629− <*> parseJSONElemAtIndex parseJSON 6 t
2630− <*> parseJSONElemAtIndex parseJSON 7 t
2631− <*> parseJSONElemAtIndex parseJSON 8 t
2632− <*> parseJSONElemAtIndex parseJSON 9 t
2633− <*> parseJSONElemAtIndex parseJSON 10 t
2634− <*> parseJSONElemAtIndex parseJSON 11 t
2635− <*> parseJSONElemAtIndex parseJSON 12 t
2636− <*> parseJSONElemAtIndex pN 13 t
2637− <*> parseJSONElemAtIndex pO 14 t
2638− else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 15"
2639− {-# INLINE liftParseJSON2 #-}
2640−
2641−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n) => FromJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
2642− liftParseJSON = liftParseJSON2 parseJSON parseJSONList
2643− {-# INLINE liftParseJSON #-}
2644−
2645−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
2646− parseJSON = parseJSON2
2647− {-# INLINE parseJSON #-}
Data/Aeson/Types/Generic.hs+686−66
@@ -1,62 +1,703 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveFunctor #-}
4−{-# LANGUAGE EmptyDataDecls #-}
5−{-# LANGUAGE FlexibleInstances #-}
1+{-# LANGUAGE DefaultSignatures, EmptyDataDecls, FlexibleInstances,
6−{-# LANGUAGE FunctionalDependencies #-}
2+ FunctionalDependencies, KindSignatures, OverlappingInstances,
7−{-# LANGUAGE KindSignatures #-}
8−{-# LANGUAGE NoImplicitPrelude #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE TypeOperators #-}
11−{-# LANGUAGE UndecidableInstances #-}
3+ ScopedTypeVariables, TypeOperators, UndecidableInstances,
12−
4+ ViewPatterns, NamedFieldPuns, FlexibleContexts, PatternGuards,
13−#include "overlapping-compat.h"
5+ RecordWildCards #-}
6+{-# OPTIONS_GHC -fno-warn-orphans #-}
14
7
15-- |
8-- |
16-- Module: Data.Aeson.Types.Generic
9-- Module: Data.Aeson.Types.Generic
17−-- Copyright: (c) 2012-2016 Bryan O'Sullivan
10+-- Copyright: (c) 2012 Bryan O'Sullivan
18-- (c) 2011, 2012 Bas Van Dijk
11-- (c) 2011, 2012 Bas Van Dijk
19-- (c) 2011 MailRank, Inc.
12-- (c) 2011 MailRank, Inc.
20−-- License: BSD3
13+-- License: Apache
21-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
14-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
22-- Stability: experimental
15-- Stability: experimental
23-- Portability: portable
16-- Portability: portable
24--
17--
25−-- Helpers for generic derivations.
18+-- Types for working with JSON data.
26−
27−module Data.Aeson.Types.Generic
28− (
29− IsRecord
30− , AllNullary
31− , Tagged2(..)
32− , True
33− , False
34− , And
35− , Zero
36− , One
37− , ProductSize(..)
38− , (:*)(..)
39− ) where
40−
41−import Prelude.Compat
42
19
20+module Data.Aeson.Types.Generic ( ) where
21+
22+import Control.Applicative ((<*>), (<$>), (<|>), pure)
23+import Control.Monad ((<=<))
24+import Control.Monad.ST (ST)
25+import Data.Aeson.Types.Instances
26+import Data.Aeson.Types.Internal
27+import Data.Bits
28+import Data.Aeson.Encode.ByteString (emptyArray_)
29+import Data.ByteString.Builder as B
30+import Data.Monoid ((<>), mempty)
31+import Data.DList (DList, toList, empty)
32+import Data.Maybe (fromMaybe)
33+import Data.Text (Text, pack, unpack)
43import GHC.Generics
34import GHC.Generics
35+import qualified Data.HashMap.Strict as H
36+import qualified Data.Vector as V
37+import qualified Data.Vector.Mutable as VM
38+
39+--------------------------------------------------------------------------------
40+-- Generic toJSON
41+
42+instance (GToJSON a) => GToJSON (M1 i c a) where
43+ -- Meta-information, which is not handled elsewhere, is ignored:
44+ gToJSON opts = gToJSON opts . unM1
45+ {-# INLINE gToJSON #-}
46+
47+ gToEncoding opts = gToEncoding opts . unM1
48+ {-# INLINE gToEncoding #-}
49+
50+instance (ToJSON a) => GToJSON (K1 i a) where
51+ -- Constant values are encoded using their ToJSON instance:
52+ gToJSON _opts = toJSON . unK1
53+ {-# INLINE gToJSON #-}
54+
55+ gToEncoding _opts = toEncoding . unK1
56+ {-# INLINE gToEncoding #-}
57+
58+instance GToJSON U1 where
59+ -- Empty constructors are encoded to an empty array:
60+ gToJSON _opts _ = emptyArray
61+ {-# INLINE gToJSON #-}
62+
63+ gToEncoding _opts _ = emptyArray_
64+ {-# INLINE gToEncoding #-}
65+
66+instance (ConsToJSON a) => GToJSON (C1 c a) where
67+ -- Constructors need to be encoded differently depending on whether they're
68+ -- a record or not. This distinction is made by 'consToJSON':
69+ gToJSON opts = consToJSON opts . unM1
70+ {-# INLINE gToJSON #-}
71+
72+ gToEncoding opts = consToEncoding opts . unM1
73+ {-# INLINE gToEncoding #-}
74+
75+instance ( WriteProduct a, WriteProduct b
76+ , ProductSize a, ProductSize b ) => GToJSON (a :*: b) where
77+ -- Products are encoded to an array. Here we allocate a mutable vector of
78+ -- the same size as the product and write the product's elements to it using
79+ -- 'writeProduct':
80+ gToJSON opts p =
81+ Array $ V.create $ do
82+ mv <- VM.unsafeNew lenProduct
83+ writeProduct opts mv 0 lenProduct p
84+ return mv
85+ where
86+ lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
87+ productSize
88+ {-# INLINE gToJSON #-}
89+
90+ gToEncoding opts p = B.char7 '[' <> encodeProduct opts p <> B.char7 ']'
91+
92+instance ( AllNullary (a :+: b) allNullary
93+ , SumToJSON (a :+: b) allNullary ) => GToJSON (a :+: b) where
94+ -- If all constructors of a sum datatype are nullary and the
95+ -- 'allNullaryToStringTag' option is set they are encoded to
96+ -- strings. This distinction is made by 'sumToJSON':
97+ gToJSON opts = (unTagged :: Tagged allNullary Value -> Value)
98+ . sumToJSON opts
99+ {-# INLINE gToJSON #-}
100+
101+ gToEncoding opts = (unTagged :: Tagged allNullary B.Builder -> B.Builder)
102+ . sumToEncoding opts
103+ {-# INLINE gToEncoding #-}
104+
105+--------------------------------------------------------------------------------
106+
107+class SumToJSON f allNullary where
108+ sumToJSON :: Options -> f a -> Tagged allNullary Value
109+ sumToEncoding :: Options -> f a -> Tagged allNullary B.Builder
110+
111+instance ( GetConName f
112+ , TaggedObject f
113+ , ObjectWithSingleField f
114+ , TwoElemArray f ) => SumToJSON f True where
115+ sumToJSON opts
116+ | allNullaryToStringTag opts = Tagged . String . pack
117+ . constructorTagModifier opts . getConName
118+ | otherwise = Tagged . nonAllNullarySumToJSON opts
119+ {-# INLINE sumToJSON #-}
120+
121+ sumToEncoding opts
122+ | allNullaryToStringTag opts = Tagged . toEncoding .
123+ constructorTagModifier opts . getConName
124+ | otherwise = Tagged . nonAllNullarySumToEncoding opts
125+ {-# INLINE sumToEncoding #-}
126+
127+instance ( TwoElemArray f
128+ , TaggedObject f
129+ , ObjectWithSingleField f ) => SumToJSON f False where
130+ sumToJSON opts = Tagged . nonAllNullarySumToJSON opts
131+ {-# INLINE sumToJSON #-}
132+ sumToEncoding opts = Tagged . nonAllNullarySumToEncoding opts
133+ {-# INLINE sumToEncoding #-}
134+
135+nonAllNullarySumToJSON :: ( TwoElemArray f
136+ , TaggedObject f
137+ , ObjectWithSingleField f
138+ ) => Options -> f a -> Value
139+nonAllNullarySumToJSON opts =
140+ case sumEncoding opts of
141+ TaggedObject{..} ->
142+ object . taggedObjectPairs opts tagFieldName contentsFieldName
143+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts
144+ TwoElemArray -> Array . twoElemArrayObj opts
145+{-# INLINE nonAllNullarySumToJSON #-}
146+
147+nonAllNullarySumToEncoding :: ( TwoElemArray f
148+ , TaggedObject f
149+ , ObjectWithSingleField f
150+ ) => Options -> f a -> B.Builder
151+nonAllNullarySumToEncoding opts =
152+ case sumEncoding opts of
153+ TaggedObject{..} ->
154+ taggedObjectEnc opts tagFieldName contentsFieldName
155+ ObjectWithSingleField -> objectWithSingleFieldEnc opts
156+ TwoElemArray -> twoElemArrayEnc opts
157+{-# INLINE nonAllNullarySumToEncoding #-}
158+
159+--------------------------------------------------------------------------------
160+
161+class TaggedObject f where
162+ taggedObjectPairs :: Options -> String -> String -> f a -> [Pair]
163+ taggedObjectEnc :: Options -> String -> String -> f a -> B.Builder
164+
165+instance ( TaggedObject a
166+ , TaggedObject b ) => TaggedObject (a :+: b) where
167+ taggedObjectPairs opts tagFieldName contentsFieldName (L1 x) =
168+ taggedObjectPairs opts tagFieldName contentsFieldName x
169+ taggedObjectPairs opts tagFieldName contentsFieldName (R1 x) =
170+ taggedObjectPairs opts tagFieldName contentsFieldName x
171+ {-# INLINE taggedObjectPairs #-}
172+
173+ taggedObjectEnc opts tagFieldName contentsFieldName (L1 x) =
174+ taggedObjectEnc opts tagFieldName contentsFieldName x
175+ taggedObjectEnc opts tagFieldName contentsFieldName (R1 x) =
176+ taggedObjectEnc opts tagFieldName contentsFieldName x
177+ {-# INLINE taggedObjectEnc #-}
178+
179+instance ( IsRecord a isRecord
180+ , TaggedObject' a isRecord
181+ , Constructor c ) => TaggedObject (C1 c a) where
182+ taggedObjectPairs opts tagFieldName contentsFieldName =
183+ (pack tagFieldName .= constructorTagModifier opts
184+ (conName (undefined :: t c a p)) :) .
185+ (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
186+ taggedObjectPairs' opts contentsFieldName . unM1
187+ {-# INLINE taggedObjectPairs #-}
188+
189+ taggedObjectEnc opts tagFieldName contentsFieldName v =
190+ B.char7 '{' <>
191+ (toEncoding tagFieldName <>
192+ B.char7 ':' <>
193+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
194+ B.char7 ',' <>
195+ ((unTagged :: Tagged isRecord B.Builder -> B.Builder) .
196+ taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>
197+ B.char7 '}'
198+ {-# INLINE taggedObjectEnc #-}
199+
200+class TaggedObject' f isRecord where
201+ taggedObjectPairs' :: Options -> String -> f a -> Tagged isRecord [Pair]
202+ taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord B.Builder
203+
204+instance (RecordTo f) => TaggedObject' f True where
205+ taggedObjectPairs' opts _ = Tagged . toList . recordToPairs opts
206+ {-# INLINE taggedObjectPairs' #-}
207+
208+ taggedObjectEnc' opts _ = Tagged . recordToEncoding opts
209+ {-# INLINE taggedObjectEnc' #-}
210+
211+instance (GToJSON f) => TaggedObject' f False where
212+ taggedObjectPairs' opts contentsFieldName =
213+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts
214+ {-# INLINE taggedObjectPairs' #-}
215+
216+ taggedObjectEnc' opts contentsFieldName =
217+ Tagged . (\z -> toEncoding contentsFieldName <> B.char7 ':' <> z) .
218+ gToEncoding opts
219+ {-# INLINE taggedObjectEnc' #-}
220+
221+--------------------------------------------------------------------------------
222+
223+-- | Get the name of the constructor of a sum datatype.
224+class GetConName f where
225+ getConName :: f a -> String
226+
227+instance (GetConName a, GetConName b) => GetConName (a :+: b) where
228+ getConName (L1 x) = getConName x
229+ getConName (R1 x) = getConName x
230+ {-# INLINE getConName #-}
231+
232+instance (Constructor c, GToJSON a, ConsToJSON a) => GetConName (C1 c a) where
233+ getConName = conName
234+ {-# INLINE getConName #-}
235+
236+--------------------------------------------------------------------------------
237+
238+class TwoElemArray f where
239+ twoElemArrayObj :: Options -> f a -> V.Vector Value
240+ twoElemArrayEnc :: Options -> f a -> B.Builder
241+
242+instance (TwoElemArray a, TwoElemArray b) => TwoElemArray (a :+: b) where
243+ twoElemArrayObj opts (L1 x) = twoElemArrayObj opts x
244+ twoElemArrayObj opts (R1 x) = twoElemArrayObj opts x
245+ {-# INLINE twoElemArrayObj #-}
246+
247+ twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
248+ twoElemArrayEnc opts (R1 x) = twoElemArrayEnc opts x
249+ {-# INLINE twoElemArrayEnc #-}
250+
251+instance ( GToJSON a, ConsToJSON a
252+ , Constructor c ) => TwoElemArray (C1 c a) where
253+ twoElemArrayObj opts x = V.create $ do
254+ mv <- VM.unsafeNew 2
255+ VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
256+ $ conName (undefined :: t c a p)
257+ VM.unsafeWrite mv 1 $ gToJSON opts x
258+ return mv
259+ {-# INLINE twoElemArrayObj #-}
260+
261+ twoElemArrayEnc opts x =
262+ B.char7 '[' <>
263+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) <>
264+ B.char7 ',' <>
265+ gToEncoding opts x <>
266+ B.char7 ']'
267+ {-# INLINE twoElemArrayEnc #-}
268+
269+--------------------------------------------------------------------------------
270+
271+class ConsToJSON f where
272+ consToJSON :: Options -> f a -> Value
273+ consToEncoding :: Options -> f a -> B.Builder
274+
275+class ConsToJSON' f isRecord where
276+ consToJSON' :: Options -> f a -> Tagged isRecord Value
277+ consToEncoding' :: Options -> f a -> Tagged isRecord B.Builder
278+
279+instance ( IsRecord f isRecord
280+ , ConsToJSON' f isRecord ) => ConsToJSON f where
281+ consToJSON opts = (unTagged :: Tagged isRecord Value -> Value)
282+ . consToJSON' opts
283+ {-# INLINE consToJSON #-}
284+
285+ consToEncoding opts = (unTagged :: Tagged isRecord B.Builder -> B.Builder)
286+ . consToEncoding' opts
287+ {-# INLINE consToEncoding #-}
288+
289+instance (RecordTo f) => ConsToJSON' f True where
290+ consToJSON' opts = Tagged . object . toList . recordToPairs opts
291+ {-# INLINE consToJSON' #-}
292+
293+ consToEncoding' opts x = Tagged $
294+ B.char7 '{' <>
295+ recordToEncoding opts x <>
296+ B.char7 '}'
297+ {-# INLINE consToEncoding' #-}
298+
299+instance GToJSON f => ConsToJSON' f False where
300+ consToJSON' opts = Tagged . gToJSON opts
301+ {-# INLINE consToJSON' #-}
302+ consToEncoding' opts = Tagged . gToEncoding opts
303+ {-# INLINE consToEncoding' #-}
304+
305+--------------------------------------------------------------------------------
306+
307+class RecordTo f where
308+ recordToPairs :: Options -> f a -> DList Pair
309+ recordToEncoding :: Options -> f a -> B.Builder
310+
311+instance (RecordTo a, RecordTo b) => RecordTo (a :*: b) where
312+ recordToPairs opts (a :*: b) = recordToPairs opts a <>
313+ recordToPairs opts b
314+ {-# INLINE recordToPairs #-}
315+
316+ recordToEncoding opts (a :*: b) = recordToEncoding opts a <>
317+ B.char7 ',' <>
318+ recordToEncoding opts b
319+ {-# INLINE recordToEncoding #-}
320+
321+instance (Selector s, GToJSON a) => RecordTo (S1 s a) where
322+ recordToPairs = fieldToPair
323+ {-# INLINE recordToPairs #-}
324+
325+ recordToEncoding = fieldToEncoding
326+ {-# INLINE recordToEncoding #-}
327+
328+instance (Selector s, ToJSON a) => RecordTo (S1 s (K1 i (Maybe a))) where
329+ recordToPairs opts (M1 k1) | omitNothingFields opts
330+ , K1 Nothing <- k1 = empty
331+ recordToPairs opts m1 = fieldToPair opts m1
332+ {-# INLINE recordToPairs #-}
333+
334+ recordToEncoding opts (M1 k1) | omitNothingFields opts
335+ , K1 Nothing <- k1 = mempty
336+ recordToEncoding opts m1 = fieldToEncoding opts m1
337+ {-# INLINE recordToEncoding #-}
338+
339+fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair
340+fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
341+ , gToJSON opts (unM1 m1)
342+ )
343+{-# INLINE fieldToPair #-}
344+
345+fieldToEncoding :: (Selector s, GToJSON a) => Options -> S1 s a p -> B.Builder
346+fieldToEncoding opts m1 =
347+ toEncoding (fieldLabelModifier opts $ selName m1) <>
348+ B.char7 ':' <>
349+ gToEncoding opts (unM1 m1)
350+{-# INLINE fieldToEncoding #-}
351+
352+--------------------------------------------------------------------------------
353+
354+class WriteProduct f where
355+ writeProduct :: Options
356+ -> VM.MVector s Value
357+ -> Int -- ^ index
358+ -> Int -- ^ length
359+ -> f a
360+ -> ST s ()
361+ encodeProduct :: Options -> f a -> B.Builder
362+
363+instance ( WriteProduct a
364+ , WriteProduct b ) => WriteProduct (a :*: b) where
365+ writeProduct opts mv ix len (a :*: b) = do
366+ writeProduct opts mv ix lenL a
367+ writeProduct opts mv ixR lenR b
368+ where
369+ lenL = len `unsafeShiftR` 1
370+ lenR = len - lenL
371+ ixR = ix + lenL
372+ {-# INLINE writeProduct #-}
373+
374+ encodeProduct opts (a :*: b) = encodeProduct opts a <>
375+ B.char7 ',' <>
376+ encodeProduct opts b
377+ {-# INLINE encodeProduct #-}
378+
379+instance (GToJSON a) => WriteProduct a where
380+ writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts
381+ {-# INLINE writeProduct #-}
382+
383+ encodeProduct opts = gToEncoding opts
384+ {-# INLINE encodeProduct #-}
385+
386+--------------------------------------------------------------------------------
387+
388+class ObjectWithSingleField f where
389+ objectWithSingleFieldObj :: Options -> f a -> Object
390+ objectWithSingleFieldEnc :: Options -> f a -> B.Builder
391+
392+instance ( ObjectWithSingleField a
393+ , ObjectWithSingleField b ) => ObjectWithSingleField (a :+: b) where
394+ objectWithSingleFieldObj opts (L1 x) = objectWithSingleFieldObj opts x
395+ objectWithSingleFieldObj opts (R1 x) = objectWithSingleFieldObj opts x
396+ {-# INLINE objectWithSingleFieldObj #-}
397+
398+ objectWithSingleFieldEnc opts (L1 x) = objectWithSingleFieldEnc opts x
399+ objectWithSingleFieldEnc opts (R1 x) = objectWithSingleFieldEnc opts x
400+ {-# INLINE objectWithSingleFieldEnc #-}
401+
402+instance ( GToJSON a, ConsToJSON a
403+ , Constructor c ) => ObjectWithSingleField (C1 c a) where
404+ objectWithSingleFieldObj opts = H.singleton typ . gToJSON opts
405+ where
406+ typ = pack $ constructorTagModifier opts $
407+ conName (undefined :: t c a p)
408+ {-# INLINE objectWithSingleFieldObj #-}
409+
410+ objectWithSingleFieldEnc opts v =
411+ B.char7 '{' <>
412+ toEncoding (constructorTagModifier opts
413+ (conName (undefined :: t c a p))) <>
414+ B.char7 ':' <>
415+ gToEncoding opts v <>
416+ B.char7 '}'
417+ {-# INLINE objectWithSingleFieldEnc #-}
418+
419+--------------------------------------------------------------------------------
420+-- Generic parseJSON
421+
422+instance (GFromJSON a) => GFromJSON (M1 i c a) where
423+ -- Meta-information, which is not handled elsewhere, is just added to the
424+ -- parsed value:
425+ gParseJSON opts = fmap M1 . gParseJSON opts
426+ {-# INLINE gParseJSON #-}
427+
428+instance (FromJSON a) => GFromJSON (K1 i a) where
429+ -- Constant values are decoded using their FromJSON instance:
430+ gParseJSON _opts = fmap K1 . parseJSON
431+ {-# INLINE gParseJSON #-}
432+
433+instance GFromJSON U1 where
434+ -- Empty constructors are expected to be encoded as an empty array:
435+ gParseJSON _opts v
436+ | isEmptyArray v = pure U1
437+ | otherwise = typeMismatch "unit constructor (U1)" v
438+ {-# INLINE gParseJSON #-}
439+
440+instance (ConsFromJSON a) => GFromJSON (C1 c a) where
441+ -- Constructors need to be decoded differently depending on whether they're
442+ -- a record or not. This distinction is made by consParseJSON:
443+ gParseJSON opts = fmap M1 . consParseJSON opts
444+ {-# INLINE gParseJSON #-}
445+
446+instance ( FromProduct a, FromProduct b
447+ , ProductSize a, ProductSize b ) => GFromJSON (a :*: b) where
448+ -- Products are expected to be encoded to an array. Here we check whether we
449+ -- got an array of the same size as the product, then parse each of the
450+ -- product's elements using parseProduct:
451+ gParseJSON opts = withArray "product (:*:)" $ \arr ->
452+ let lenArray = V.length arr
453+ lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
454+ productSize in
455+ if lenArray == lenProduct
456+ then parseProduct opts arr 0 lenProduct
457+ else fail $ "When expecting a product of " ++ show lenProduct ++
458+ " values, encountered an Array of " ++ show lenArray ++
459+ " elements instead"
460+ {-# INLINE gParseJSON #-}
461+
462+instance ( AllNullary (a :+: b) allNullary
463+ , ParseSum (a :+: b) allNullary ) => GFromJSON (a :+: b) where
464+ -- If all constructors of a sum datatype are nullary and the
465+ -- 'allNullaryToStringTag' option is set they are expected to be
466+ -- encoded as strings. This distinction is made by 'parseSum':
467+ gParseJSON opts = (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->
468+ (Parser ((a :+: b) d)))
469+ . parseSum opts
470+ {-# INLINE gParseJSON #-}
471+
472+--------------------------------------------------------------------------------
473+
474+class ParseSum f allNullary where
475+ parseSum :: Options -> Value -> Tagged allNullary (Parser (f a))
476+
477+instance ( SumFromString (a :+: b)
478+ , FromPair (a :+: b)
479+ , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) True where
480+ parseSum opts
481+ | allNullaryToStringTag opts = Tagged . parseAllNullarySum opts
482+ | otherwise = Tagged . parseNonAllNullarySum opts
483+ {-# INLINE parseSum #-}
484+
485+instance ( FromPair (a :+: b)
486+ , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) False where
487+ parseSum opts = Tagged . parseNonAllNullarySum opts
488+ {-# INLINE parseSum #-}
489+
490+--------------------------------------------------------------------------------
491+
492+parseAllNullarySum :: SumFromString f => Options -> Value -> Parser (f a)
493+parseAllNullarySum opts = withText "Text" $ \key ->
494+ maybe (notFound $ unpack key) return $
495+ parseSumFromString opts key
496+{-# INLINE parseAllNullarySum #-}
497+
498+class SumFromString f where
499+ parseSumFromString :: Options -> Text -> Maybe (f a)
500+
501+instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where
502+ parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>
503+ (R1 <$> parseSumFromString opts key)
504+ {-# INLINE parseSumFromString #-}
505+
506+instance (Constructor c) => SumFromString (C1 c U1) where
507+ parseSumFromString opts key | key == name = Just $ M1 U1
508+ | otherwise = Nothing
509+ where
510+ name = pack $ constructorTagModifier opts $
511+ conName (undefined :: t c U1 p)
512+ {-# INLINE parseSumFromString #-}
513+
514+--------------------------------------------------------------------------------
515+
516+parseNonAllNullarySum :: ( FromPair (a :+: b)
517+ , FromTaggedObject (a :+: b)
518+ ) => Options -> Value -> Parser ((a :+: b) c)
519+parseNonAllNullarySum opts =
520+ case sumEncoding opts of
521+ TaggedObject{..} ->
522+ withObject "Object" $ \obj -> do
523+ tag <- obj .: pack tagFieldName
524+ fromMaybe (notFound $ unpack tag) $
525+ parseFromTaggedObject opts contentsFieldName obj tag
526+
527+ ObjectWithSingleField ->
528+ withObject "Object" $ \obj ->
529+ case H.toList obj of
530+ [pair@(tag, _)] -> fromMaybe (notFound $ unpack tag) $
531+ parsePair opts pair
532+ _ -> fail "Object doesn't have a single field"
533+
534+ TwoElemArray ->
535+ withArray "Array" $ \arr ->
536+ if V.length arr == 2
537+ then case V.unsafeIndex arr 0 of
538+ String tag -> fromMaybe (notFound $ unpack tag) $
539+ parsePair opts (tag, V.unsafeIndex arr 1)
540+ _ -> fail "First element is not a String"
541+ else fail "Array doesn't have 2 elements"
542+{-# INLINE parseNonAllNullarySum #-}
543+
544+--------------------------------------------------------------------------------
545+
546+class FromTaggedObject f where
547+ parseFromTaggedObject :: Options -> String -> Object -> Text
548+ -> Maybe (Parser (f a))
549+
550+instance (FromTaggedObject a, FromTaggedObject b) =>
551+ FromTaggedObject (a :+: b) where
552+ parseFromTaggedObject opts contentsFieldName obj tag =
553+ (fmap L1 <$> parseFromTaggedObject opts contentsFieldName obj tag) <|>
554+ (fmap R1 <$> parseFromTaggedObject opts contentsFieldName obj tag)
555+ {-# INLINE parseFromTaggedObject #-}
556+
557+instance ( FromTaggedObject' f
558+ , Constructor c ) => FromTaggedObject (C1 c f) where
559+ parseFromTaggedObject opts contentsFieldName obj tag
560+ | tag == name = Just $ M1 <$> parseFromTaggedObject'
561+ opts contentsFieldName obj
562+ | otherwise = Nothing
563+ where
564+ name = pack $ constructorTagModifier opts $
565+ conName (undefined :: t c f p)
566+ {-# INLINE parseFromTaggedObject #-}
567+
568+--------------------------------------------------------------------------------
569+
570+class FromTaggedObject' f where
571+ parseFromTaggedObject' :: Options -> String -> Object -> Parser (f a)
572+
573+class FromTaggedObject'' f isRecord where
574+ parseFromTaggedObject'' :: Options -> String -> Object
575+ -> Tagged isRecord (Parser (f a))
576+
577+instance ( IsRecord f isRecord
578+ , FromTaggedObject'' f isRecord
579+ ) => FromTaggedObject' f where
580+ parseFromTaggedObject' opts contentsFieldName =
581+ (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .
582+ parseFromTaggedObject'' opts contentsFieldName
583+ {-# INLINE parseFromTaggedObject' #-}
584+
585+instance (FromRecord f) => FromTaggedObject'' f True where
586+ parseFromTaggedObject'' opts _ = Tagged . parseRecord opts
587+ {-# INLINE parseFromTaggedObject'' #-}
588+
589+instance (GFromJSON f) => FromTaggedObject'' f False where
590+ parseFromTaggedObject'' opts contentsFieldName = Tagged .
591+ (gParseJSON opts <=< (.: pack contentsFieldName))
592+ {-# INLINE parseFromTaggedObject'' #-}
593+
594+--------------------------------------------------------------------------------
595+
596+class ConsFromJSON f where
597+ consParseJSON :: Options -> Value -> Parser (f a)
598+
599+class ConsFromJSON' f isRecord where
600+ consParseJSON' :: Options -> Value -> Tagged isRecord (Parser (f a))
601+
602+instance ( IsRecord f isRecord
603+ , ConsFromJSON' f isRecord
604+ ) => ConsFromJSON f where
605+ consParseJSON opts = (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
606+ . consParseJSON' opts
607+ {-# INLINE consParseJSON #-}
608+
609+instance (FromRecord f) => ConsFromJSON' f True where
610+ consParseJSON' opts = Tagged . (withObject "record (:*:)" $ parseRecord opts)
611+ {-# INLINE consParseJSON' #-}
612+
613+instance (GFromJSON f) => ConsFromJSON' f False where
614+ consParseJSON' opts = Tagged . gParseJSON opts
615+ {-# INLINE consParseJSON' #-}
616+
617+--------------------------------------------------------------------------------
618+
619+class FromRecord f where
620+ parseRecord :: Options -> Object -> Parser (f a)
621+
622+instance (FromRecord a, FromRecord b) => FromRecord (a :*: b) where
623+ parseRecord opts obj = (:*:) <$> parseRecord opts obj
624+ <*> parseRecord opts obj
625+ {-# INLINE parseRecord #-}
626+
627+instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where
628+ parseRecord opts = maybe (notFound label) (gParseJSON opts)
629+ . H.lookup (pack label)
630+ where
631+ label = fieldLabelModifier opts $ selName (undefined :: t s a p)
632+ {-# INLINE parseRecord #-}
633+
634+instance (Selector s, FromJSON a) => FromRecord (S1 s (K1 i (Maybe a))) where
635+ parseRecord opts obj = (M1 . K1) <$> obj .:? pack label
636+ where
637+ label = fieldLabelModifier opts $
638+ selName (undefined :: t s (K1 i (Maybe a)) p)
639+ {-# INLINE parseRecord #-}
640+
641+--------------------------------------------------------------------------------
642+
643+class ProductSize f where
644+ productSize :: Tagged2 f Int
645+
646+instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where
647+ productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) +
648+ unTagged2 (productSize :: Tagged2 b Int)
649+ {-# INLINE productSize #-}
650+
651+instance ProductSize (S1 s a) where
652+ productSize = Tagged2 1
653+ {-# INLINE productSize #-}
654+
655+--------------------------------------------------------------------------------
656+
657+class FromProduct f where
658+ parseProduct :: Options -> Array -> Int -> Int -> Parser (f a)
659+
660+instance (FromProduct a, FromProduct b) => FromProduct (a :*: b) where
661+ parseProduct opts arr ix len =
662+ (:*:) <$> parseProduct opts arr ix lenL
663+ <*> parseProduct opts arr ixR lenR
664+ where
665+ lenL = len `unsafeShiftR` 1
666+ ixR = ix + lenL
667+ lenR = len - lenL
668+ {-# INLINE parseProduct #-}
669+
670+instance (GFromJSON a) => FromProduct (S1 s a) where
671+ parseProduct opts arr ix _ = gParseJSON opts $ V.unsafeIndex arr ix
672+ {-# INLINE parseProduct #-}
673+
674+--------------------------------------------------------------------------------
675+
676+class FromPair f where
677+ parsePair :: Options -> Pair -> Maybe (Parser (f a))
678+
679+instance (FromPair a, FromPair b) => FromPair (a :+: b) where
680+ parsePair opts pair = (fmap L1 <$> parsePair opts pair) <|>
681+ (fmap R1 <$> parsePair opts pair)
682+ {-# INLINE parsePair #-}
683+
684+instance (Constructor c, GFromJSON a, ConsFromJSON a) => FromPair (C1 c a) where
685+ parsePair opts (tag, value)
686+ | tag == tag' = Just $ gParseJSON opts value
687+ | otherwise = Nothing
688+ where
689+ tag' = pack $ constructorTagModifier opts $
690+ conName (undefined :: t c a p)
691+ {-# INLINE parsePair #-}
44
692
45--------------------------------------------------------------------------------
693--------------------------------------------------------------------------------
46
694
47class IsRecord (f :: * -> *) isRecord | f -> isRecord
695class IsRecord (f :: * -> *) isRecord | f -> isRecord
48
696
49instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
697instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
50−#if MIN_VERSION_base(4,9,0)
51−instance OVERLAPPING_ IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False
52−#else
53−instance OVERLAPPING_ IsRecord (M1 S NoSelector f) False
698+instance IsRecord (M1 S NoSelector f) False
54−#endif
55instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
699instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
56instance IsRecord (K1 i c) True
700instance IsRecord (K1 i c) True
57−instance IsRecord Par1 True
58−instance IsRecord (Rec1 f) True
59−instance IsRecord (f :.: g) True
60instance IsRecord U1 False
701instance IsRecord U1 False
61
702
62--------------------------------------------------------------------------------
703--------------------------------------------------------------------------------
@@ -69,15 +710,9 @@ instance ( AllNullary a allNullaryL
69 ) => AllNullary (a :+: b) allNullary
710 ) => AllNullary (a :+: b) allNullary
70instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
711instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
71instance AllNullary (a :*: b) False
712instance AllNullary (a :*: b) False
72−instance AllNullary (a :.: b) False
73instance AllNullary (K1 i c) False
713instance AllNullary (K1 i c) False
74−instance AllNullary Par1 False
75−instance AllNullary (Rec1 f) False
76instance AllNullary U1 True
714instance AllNullary U1 True
77
715
78−newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}
79− deriving Functor
80−
81--------------------------------------------------------------------------------
716--------------------------------------------------------------------------------
82
717
83data True
718data True
@@ -92,27 +727,12 @@ instance And True False False
92
727
93--------------------------------------------------------------------------------
728--------------------------------------------------------------------------------
94
729
95−-- | A type-level indicator that 'ToJSON' or 'FromJSON' is being derived generically.
730+newtype Tagged s b = Tagged {unTagged :: b}
96−data Zero
97−
98−-- | A type-level indicator that 'ToJSON1' or 'FromJSON1' is being derived generically.
99−data One
100
731
101−--------------------------------------------------------------------------------
732+newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}
102−
103−class ProductSize f where
104− productSize :: Tagged2 f Int
105−
106−instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where
107− productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) +
108− unTagged2 (productSize :: Tagged2 b Int)
109−
110−instance ProductSize (S1 s a) where
111− productSize = Tagged2 1
112
733
113--------------------------------------------------------------------------------
734--------------------------------------------------------------------------------
114
735
115−-- | Simple extensible tuple type to simplify passing around many parameters.
736+notFound :: String -> Parser a
116−data a :* b = a :* b
737+notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
117−
738+{-# INLINE notFound #-}
118−infixr 1 :*
Data/Aeson/Types/Instances.hsnew file+1519
@@ -0,0 +1,1519 @@
1+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,
2+ GeneralizedNewtypeDeriving, IncoherentInstances, OverlappingInstances,
3+ OverloadedStrings, UndecidableInstances, ViewPatterns #-}
4+{-# LANGUAGE DefaultSignatures #-}
5+{-# OPTIONS_GHC -fno-warn-orphans #-}
6+
7+-- TODO: Drop this when we remove support for Data.Attoparsec.Number
8+{-# OPTIONS_GHC -fno-warn-deprecations #-}
9+
10+-- |
11+-- Module: Data.Aeson.Types.Instances
12+-- Copyright: (c) 2011-2013 Bryan O'Sullivan
13+-- (c) 2011 MailRank, Inc.
14+-- License: Apache
15+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
16+-- Stability: experimental
17+-- Portability: portable
18+--
19+-- Types for working with JSON data.
20+
21+module Data.Aeson.Types.Instances
22+ (
23+ -- * Type classes
24+ -- ** Core JSON classes
25+ FromJSON(..)
26+ , ToJSON(..)
27+ -- ** Generic JSON classes
28+ , GFromJSON(..)
29+ , GToJSON(..)
30+ , genericToJSON
31+ , genericParseJSON
32+
33+ -- * Types
34+ , DotNetTime(..)
35+
36+ -- * Inspecting @'Value's@
37+ , withObject
38+ , withText
39+ , withArray
40+ , withNumber
41+ , withScientific
42+ , withBool
43+
44+ -- * Functions
45+ , fromJSON
46+ , (.:)
47+ , (.:?)
48+ , (.!=)
49+ , (.=)
50+ , typeMismatch
51+ ) where
52+
53+import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)
54+import qualified Data.Aeson.Encode.ByteString as E
55+import qualified Data.ByteString.Builder as B
56+import qualified Data.ByteString.Builder.Prim as BP
57+import Data.Aeson.Functions
58+import Data.Monoid ((<>), mempty)
59+import Data.Aeson.Types.Class
60+import Data.Aeson.Types.Internal
61+import Data.Scientific (Scientific)
62+import qualified Data.Scientific as Scientific (coefficient, base10Exponent, fromFloatDigits, toRealFloat)
63+import Data.Attoparsec.Number (Number(..))
64+import Data.Fixed
65+import Data.Foldable (Foldable, toList)
66+import Data.Functor.Identity (Identity(..))
67+import Data.Hashable (Hashable(..))
68+import Data.Int (Int8, Int16, Int32, Int64)
69+import Data.Maybe (fromMaybe)
70+import Data.Monoid (Dual(..), First(..), Last(..))
71+import Data.Ratio (Ratio, (%), numerator, denominator)
72+import Data.Text (Text, pack, unpack)
73+import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))
74+import Data.Time.Format (FormatTime, formatTime, parseTime)
75+import Data.Traversable (traverse)
76+import Data.Vector (Vector)
77+import Data.Word (Word, Word8, Word16, Word32, Word64)
78+import Foreign.Storable (Storable)
79+import Prelude hiding (foldr)
80+import qualified Data.HashMap.Strict as H
81+import qualified Data.HashSet as HashSet
82+import qualified Data.IntMap as IntMap
83+import qualified Data.IntSet as IntSet
84+import qualified Data.Map as M
85+import qualified Data.Set as Set
86+import qualified Data.Sequence as Seq
87+import qualified Data.Tree as Tree
88+import qualified Data.Text as T
89+import qualified Data.Text.Lazy as LT
90+import qualified Data.Vector as V
91+import qualified Data.Vector.Generic as VG
92+import qualified Data.Vector.Primitive as VP
93+import qualified Data.Vector.Storable as VS
94+import qualified Data.Vector.Unboxed as VU
95+import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )
96+import qualified Prelude as P
97+
98+#if MIN_VERSION_time(1,5,0)
99+import Data.Time.Format (defaultTimeLocale, dateTimeFmt)
100+#else
101+import System.Locale (defaultTimeLocale, dateTimeFmt)
102+#endif
103+
104+instance (ToJSON a) => ToJSON (Identity a) where
105+ toJSON (Identity a) = toJSON a
106+ {-# INLINE toJSON #-}
107+
108+ toEncoding (Identity a) = toEncoding a
109+ {-# INLINE toEncoding #-}
110+
111+instance (FromJSON a) => FromJSON (Identity a) where
112+ parseJSON a = Identity <$> parseJSON a
113+ {-# INLINE parseJSON #-}
114+
115+instance (ToJSON a) => ToJSON (Maybe a) where
116+ toJSON (Just a) = toJSON a
117+ toJSON Nothing = Null
118+ {-# INLINE toJSON #-}
119+
120+ toEncoding (Just a) = toEncoding a
121+ toEncoding Nothing = E.null_
122+
123+instance (FromJSON a) => FromJSON (Maybe a) where
124+ parseJSON Null = pure Nothing
125+ parseJSON a = Just <$> parseJSON a
126+ {-# INLINE parseJSON #-}
127+
128+instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
129+ toJSON (Left a) = object [left .= a]
130+ toJSON (Right b) = object [right .= b]
131+ {-# INLINE toJSON #-}
132+
133+ toEncoding (Left a) =
134+ B.shortByteString "{\"left\":" <> toEncoding a <> B.char7 '}'
135+ toEncoding (Right a) =
136+ B.shortByteString "{\"right\":" <> toEncoding a <> B.char7 '}'
137+
138+instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where
139+ parseJSON (Object (H.toList -> [(key, value)]))
140+ | key == left = Left <$> parseJSON value
141+ | key == right = Right <$> parseJSON value
142+ parseJSON _ = fail $
143+ "expected an object with a single property " ++
144+ "where the property key should be either " ++
145+ "\"Left\" or \"Right\""
146+ {-# INLINE parseJSON #-}
147+
148+left, right :: Text
149+left = "Left"
150+right = "Right"
151+
152+instance ToJSON Bool where
153+ toJSON = Bool
154+ {-# INLINE toJSON #-}
155+
156+ toEncoding v = E.bool v
157+
158+instance FromJSON Bool where
159+ parseJSON = withBool "Bool" pure
160+ {-# INLINE parseJSON #-}
161+
162+instance ToJSON () where
163+ toJSON _ = emptyArray
164+ {-# INLINE toJSON #-}
165+
166+ toEncoding _ = E.emptyArray_
167+
168+instance FromJSON () where
169+ parseJSON = withArray "()" $ \v ->
170+ if V.null v
171+ then pure ()
172+ else fail "Expected an empty array"
173+ {-# INLINE parseJSON #-}
174+
175+instance ToJSON [Char] where
176+ toJSON = String . T.pack
177+ {-# INLINE toJSON #-}
178+
179+ toEncoding = E.text . T.pack
180+
181+instance FromJSON [Char] where
182+ parseJSON = withText "String" $ pure . T.unpack
183+ {-# INLINE parseJSON #-}
184+
185+instance ToJSON Char where
186+ toJSON = String . T.singleton
187+ {-# INLINE toJSON #-}
188+
189+ toEncoding = E.text . T.singleton
190+
191+instance FromJSON Char where
192+ parseJSON = withText "Char" $ \t ->
193+ if T.compareLength t 1 == EQ
194+ then pure $ T.head t
195+ else fail "Expected a string of length 1"
196+ {-# INLINE parseJSON #-}
197+
198+instance ToJSON Scientific where
199+ toJSON = Number
200+ {-# INLINE toJSON #-}
201+
202+ toEncoding v = E.number v
203+ {-# INLINE toEncoding #-}
204+
205+instance FromJSON Scientific where
206+ parseJSON = withScientific "Scientific" pure
207+ {-# INLINE parseJSON #-}
208+
209+instance ToJSON Double where
210+ toJSON = realFloatToJSON
211+ {-# INLINE toJSON #-}
212+
213+ toEncoding = realFloatToEncoding
214+ {-# INLINE toEncoding #-}
215+
216+instance FromJSON Double where
217+ parseJSON = parseRealFloat "Double"
218+ {-# INLINE parseJSON #-}
219+
220+instance ToJSON Number where
221+ toJSON (D d) = toJSON d
222+ toJSON (I i) = toJSON i
223+ {-# INLINE toJSON #-}
224+
225+ toEncoding (D d) = toEncoding d
226+ toEncoding (I i) = toEncoding i
227+ {-# INLINE toEncoding #-}
228+
229+instance FromJSON Number where
230+ parseJSON (Number s) = pure $ scientificToNumber s
231+ parseJSON Null = pure (D (0/0))
232+ parseJSON v = typeMismatch "Number" v
233+ {-# INLINE parseJSON #-}
234+
235+instance ToJSON Float where
236+ toJSON = realFloatToJSON
237+ {-# INLINE toJSON #-}
238+
239+ toEncoding = realFloatToEncoding
240+ {-# INLINE toEncoding #-}
241+
242+instance FromJSON Float where
243+ parseJSON = parseRealFloat "Float"
244+ {-# INLINE parseJSON #-}
245+
246+instance ToJSON (Ratio Integer) where
247+ toJSON r = object [ "numerator" .= numerator r
248+ , "denominator" .= denominator r
249+ ]
250+
251+ toEncoding r =
252+ B.shortByteString "{\"numerator\":" <> toEncoding (numerator r) <>
253+ B.shortByteString ",\"denominator\":" <> toEncoding (denominator r) <>
254+ B.char7 '}'
255+
256+instance FromJSON (Ratio Integer) where
257+ parseJSON = withObject "Rational" $ \obj ->
258+ (%) <$> obj .: "numerator"
259+ <*> obj .: "denominator"
260+ {-# INLINE parseJSON #-}
261+
262+instance HasResolution a => ToJSON (Fixed a) where
263+ toJSON = Number . realToFrac
264+ {-# INLINE toJSON #-}
265+
266+ toEncoding = E.number . realToFrac
267+
268+-- | /WARNING:/ Only parse fixed-precision numbers from trusted input
269+-- since an attacker could easily fill up the memory of the target
270+-- system by specifying a scientific number with a big exponent like
271+-- @1e1000000000@.
272+instance HasResolution a => FromJSON (Fixed a) where
273+ parseJSON = withScientific "Fixed" $ pure . realToFrac
274+ {-# INLINE parseJSON #-}
275+
276+instance ToJSON Int where
277+ toJSON = Number . fromIntegral
278+ {-# INLINE toJSON #-}
279+
280+ toEncoding = B.intDec
281+ {-# INLINE toEncoding #-}
282+
283+instance FromJSON Int where
284+ parseJSON = parseIntegral "Int"
285+ {-# INLINE parseJSON #-}
286+
287+instance ToJSON Integer where
288+ toJSON = Number . fromInteger
289+ {-# INLINE toJSON #-}
290+
291+ toEncoding = B.integerDec
292+
293+-- | /WARNING:/ Only parse Integers from trusted input since an
294+-- attacker could easily fill up the memory of the target system by
295+-- specifying a scientific number with a big exponent like
296+-- @1e1000000000@.
297+instance FromJSON Integer where
298+ parseJSON = withScientific "Integral" $ pure . floor
299+ {-# INLINE parseJSON #-}
300+
301+instance ToJSON Int8 where
302+ toJSON = Number . fromIntegral
303+ {-# INLINE toJSON #-}
304+
305+ toEncoding = B.int8Dec
306+
307+instance FromJSON Int8 where
308+ parseJSON = parseIntegral "Int8"
309+ {-# INLINE parseJSON #-}
310+
311+instance ToJSON Int16 where
312+ toJSON = Number . fromIntegral
313+ {-# INLINE toJSON #-}
314+
315+ toEncoding = B.int16Dec
316+
317+instance FromJSON Int16 where
318+ parseJSON = parseIntegral "Int16"
319+ {-# INLINE parseJSON #-}
320+
321+instance ToJSON Int32 where
322+ toJSON = Number . fromIntegral
323+ {-# INLINE toJSON #-}
324+
325+ toEncoding = B.int32Dec
326+
327+instance FromJSON Int32 where
328+ parseJSON = parseIntegral "Int32"
329+ {-# INLINE parseJSON #-}
330+
331+instance ToJSON Int64 where
332+ toJSON = Number . fromIntegral
333+ {-# INLINE toJSON #-}
334+
335+ toEncoding = B.int64Dec
336+
337+instance FromJSON Int64 where
338+ parseJSON = parseIntegral "Int64"
339+ {-# INLINE parseJSON #-}
340+
341+instance ToJSON Word where
342+ toJSON = Number . fromIntegral
343+ {-# INLINE toJSON #-}
344+
345+ toEncoding = B.wordDec
346+
347+instance FromJSON Word where
348+ parseJSON = parseIntegral "Word"
349+ {-# INLINE parseJSON #-}
350+
351+instance ToJSON Word8 where
352+ toJSON = Number . fromIntegral
353+ {-# INLINE toJSON #-}
354+
355+ toEncoding = B.word8Dec
356+
357+instance FromJSON Word8 where
358+ parseJSON = parseIntegral "Word8"
359+ {-# INLINE parseJSON #-}
360+
361+instance ToJSON Word16 where
362+ toJSON = Number . fromIntegral
363+ {-# INLINE toJSON #-}
364+
365+ toEncoding = B.word16Dec
366+
367+instance FromJSON Word16 where
368+ parseJSON = parseIntegral "Word16"
369+ {-# INLINE parseJSON #-}
370+
371+instance ToJSON Word32 where
372+ toJSON = Number . fromIntegral
373+ {-# INLINE toJSON #-}
374+
375+ toEncoding = B.word32Dec
376+
377+instance FromJSON Word32 where
378+ parseJSON = parseIntegral "Word32"
379+ {-# INLINE parseJSON #-}
380+
381+instance ToJSON Word64 where
382+ toJSON = Number . fromIntegral
383+ {-# INLINE toJSON #-}
384+
385+ toEncoding = B.word64Dec
386+
387+instance FromJSON Word64 where
388+ parseJSON = parseIntegral "Word64"
389+ {-# INLINE parseJSON #-}
390+
391+instance ToJSON Text where
392+ toJSON = String
393+ {-# INLINE toJSON #-}
394+
395+ toEncoding = E.text
396+
397+instance FromJSON Text where
398+ parseJSON = withText "Text" pure
399+ {-# INLINE parseJSON #-}
400+
401+instance ToJSON LT.Text where
402+ toJSON = String . LT.toStrict
403+ {-# INLINE toJSON #-}
404+
405+ toEncoding t =
406+ B.char7 '"' <>
407+ LT.foldrChunks (\x xs -> E.unquoted x <> xs) mempty t <>
408+ B.char7 '"'
409+
410+instance FromJSON LT.Text where
411+ parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
412+ {-# INLINE parseJSON #-}
413+
414+instance (ToJSON a) => ToJSON [a] where
415+ toJSON = Array . V.fromList . map toJSON
416+ {-# INLINE toJSON #-}
417+
418+ toEncoding [] = E.emptyArray_
419+ toEncoding (x:xs) = B.char7 '[' <> toEncoding x <> commas xs <> B.char7 ']'
420+ where commas = P.foldr (\v vs -> B.char7 ',' <> toEncoding v <> vs) mempty
421+
422+instance (FromJSON a) => FromJSON [a] where
423+ parseJSON = withArray "[a]" $ mapM parseJSON . V.toList
424+ {-# INLINE parseJSON #-}
425+
426+instance (Foldable t, ToJSON a) => ToJSON (t a) where
427+ toJSON = toJSON . toList
428+ {-# INLINE toJSON #-}
429+
430+ toEncoding = E.foldable
431+
432+instance (FromJSON a) => FromJSON (Seq.Seq a) where
433+ parseJSON = withArray "Seq a" $ traverse parseJSON . Seq.fromList . V.toList
434+ {-# INLINE parseJSON #-}
435+
436+instance (ToJSON a) => ToJSON (Vector a) where
437+ toJSON = Array . V.map toJSON
438+ {-# INLINE toJSON #-}
439+
440+ toEncoding = encodeVector
441+
442+encodeVector :: (ToJSON a, VG.Vector v a) => v a -> B.Builder
443+encodeVector xs
444+ | VG.null xs = E.emptyArray_
445+ | otherwise = B.char7 '[' <> toEncoding (VG.unsafeHead xs) <>
446+ VG.foldr go mempty (VG.unsafeTail xs) <>
447+ B.char7 ']'
448+ where go v b = B.char7 ',' <> toEncoding v <> b
449+
450+instance (FromJSON a) => FromJSON (Vector a) where
451+ parseJSON = withArray "Vector a" $ V.mapM parseJSON
452+ {-# INLINE parseJSON #-}
453+
454+vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
455+vectorToJSON = Array . V.map toJSON . V.convert
456+{-# INLINE vectorToJSON #-}
457+
458+vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
459+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM parseJSON
460+{-# INLINE vectorParseJSON #-}
461+
462+instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
463+ toJSON = vectorToJSON
464+
465+ toEncoding = encodeVector
466+
467+instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where
468+ parseJSON = vectorParseJSON "Data.Vector.Storable.Vector a"
469+
470+instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where
471+ toJSON = vectorToJSON
472+
473+ toEncoding = encodeVector
474+
475+instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where
476+ parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector a"
477+
478+instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where
479+ toJSON = vectorToJSON
480+
481+ toEncoding = encodeVector
482+
483+instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where
484+ parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"
485+
486+instance (ToJSON a) => ToJSON (Set.Set a) where
487+ toJSON = toJSON . Set.toList
488+ {-# INLINE toJSON #-}
489+
490+ toEncoding = encodeSet Set.minView Set.foldr
491+
492+instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where
493+ parseJSON = fmap Set.fromList . parseJSON
494+ {-# INLINE parseJSON #-}
495+
496+instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
497+ toJSON = toJSON . HashSet.toList
498+ {-# INLINE toJSON #-}
499+
500+ toEncoding = E.foldable
501+
502+instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where
503+ parseJSON = fmap HashSet.fromList . parseJSON
504+ {-# INLINE parseJSON #-}
505+
506+instance ToJSON IntSet.IntSet where
507+ toJSON = toJSON . IntSet.toList
508+ {-# INLINE toJSON #-}
509+
510+ toEncoding = encodeSet IntSet.minView IntSet.foldr
511+
512+encodeSet :: (ToJSON a) =>
513+ (s -> Maybe (a, s))
514+ -> ((a -> B.Builder -> B.Builder) -> B.Builder -> s -> B.Builder)
515+ -> s -> B.Builder
516+encodeSet minView foldr xs =
517+ case minView xs of
518+ Nothing -> E.emptyArray_
519+ Just (m,ys) -> B.char7 '[' <> toEncoding m <>
520+ foldr go mempty ys <>
521+ B.char7 ']'
522+ where go v b = B.char7 ',' <> toEncoding v <> b
523+
524+instance FromJSON IntSet.IntSet where
525+ parseJSON = fmap IntSet.fromList . parseJSON
526+ {-# INLINE parseJSON #-}
527+
528+instance ToJSON a => ToJSON (IntMap.IntMap a) where
529+ toJSON = toJSON . IntMap.toList
530+ {-# INLINE toJSON #-}
531+
532+ toEncoding = toEncoding . IntMap.toList
533+
534+instance FromJSON a => FromJSON (IntMap.IntMap a) where
535+ parseJSON = fmap IntMap.fromList . parseJSON
536+ {-# INLINE parseJSON #-}
537+
538+instance (ToJSON v) => ToJSON (M.Map Text v) where
539+ toJSON = Object . M.foldrWithKey (\k -> H.insert k . toJSON) H.empty
540+ {-# INLINE toJSON #-}
541+
542+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey
543+
544+encodeMap :: (ToJSON k, ToJSON v) =>
545+ (m -> Maybe ((k,v), m))
546+ -> ((k -> v -> B.Builder -> B.Builder) -> B.Builder -> m -> B.Builder)
547+ -> m -> B.Builder
548+encodeMap minViewWithKey foldrWithKey xs =
549+ case minViewWithKey xs of
550+ Nothing -> BP.primBounded (E.ascii2 ('{','}')) ()
551+ Just ((k,v),ys) -> B.char7 '{' <> encodePair k v <>
552+ foldrWithKey go mempty ys <> B.char7 '}'
553+ where go k v b = B.char7 ',' <> encodePair k v <> b
554+
555+encodeWithKey :: (ToJSON k, ToJSON v) =>
556+ ((k -> v -> Series -> Series) -> Series -> m -> Series)
557+ -> m -> B.Builder
558+encodeWithKey foldrWithKey xs = E.series '{' '}' . foldrWithKey go mempty $ xs
559+ where go k v c = Value (encodePair k v) <> c
560+
561+encodePair :: (ToJSON k, ToJSON v) => k -> v -> B.Builder
562+encodePair k v = toEncoding k <> B.char7 ':' <> toEncoding v
563+
564+instance (FromJSON v) => FromJSON (M.Map Text v) where
565+ parseJSON = withObject "Map Text a" $
566+ fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON
567+
568+instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
569+ toJSON = Object . mapHashKeyVal LT.toStrict toJSON
570+
571+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey
572+
573+instance (FromJSON v) => FromJSON (M.Map LT.Text v) where
574+ parseJSON = fmap (hashMapKey LT.fromStrict) . parseJSON
575+
576+instance (ToJSON v) => ToJSON (M.Map String v) where
577+ toJSON = Object . mapHashKeyVal pack toJSON
578+
579+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey
580+
581+instance (FromJSON v) => FromJSON (M.Map String v) where
582+ parseJSON = fmap (hashMapKey unpack) . parseJSON
583+
584+instance (ToJSON v) => ToJSON (H.HashMap Text v) where
585+ toJSON = Object . H.map toJSON
586+ {-# INLINE toJSON #-}
587+
588+ toEncoding = encodeWithKey H.foldrWithKey
589+
590+instance (FromJSON v) => FromJSON (H.HashMap Text v) where
591+ parseJSON = withObject "HashMap Text a" $ traverse parseJSON
592+
593+instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
594+ toJSON = Object . mapKeyVal LT.toStrict toJSON
595+
596+ toEncoding = encodeWithKey H.foldrWithKey
597+
598+instance (FromJSON v) => FromJSON (H.HashMap LT.Text v) where
599+ parseJSON = fmap (mapKey LT.fromStrict) . parseJSON
600+
601+instance (ToJSON v) => ToJSON (H.HashMap String v) where
602+ toJSON = Object . mapKeyVal pack toJSON
603+
604+ toEncoding = encodeWithKey H.foldrWithKey
605+
606+instance (FromJSON v) => FromJSON (H.HashMap String v) where
607+ parseJSON = fmap (mapKey unpack) . parseJSON
608+
609+instance (ToJSON v) => ToJSON (Tree.Tree v) where
610+ toJSON (Tree.Node root branches) = toJSON (root,branches)
611+
612+ toEncoding (Tree.Node root branches) = toEncoding (root,branches)
613+
614+instance (FromJSON v) => FromJSON (Tree.Tree v) where
615+ parseJSON j = uncurry Tree.Node <$> parseJSON j
616+
617+instance ToJSON Value where
618+ toJSON a = a
619+ {-# INLINE toJSON #-}
620+
621+ toEncoding = E.encodeToBuilder
622+
623+instance FromJSON Value where
624+ parseJSON a = pure a
625+ {-# INLINE parseJSON #-}
626+
627+instance ToJSON DotNetTime where
628+ toJSON = toJSON . dotNetTime
629+ {-# INLINE toJSON #-}
630+
631+ toEncoding = toEncoding . dotNetTime
632+
633+dotNetTime :: DotNetTime -> String
634+dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
635+ where secs = formatTime defaultTimeLocale "/Date(%s" t
636+
637+instance FromJSON DotNetTime where
638+ parseJSON = withText "DotNetTime" $ \t ->
639+ let (s,m) = T.splitAt (T.length t - 5) t
640+ t' = T.concat [s,".",m]
641+ in case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of
642+ Just d -> pure (DotNetTime d)
643+ _ -> fail "could not parse .NET time"
644+ {-# INLINE parseJSON #-}
645+
646+instance ToJSON ZonedTime where
647+ toJSON = toJSON . zonedTime
648+
649+ toEncoding = toEncoding . zonedTime
650+
651+zonedTime :: ZonedTime -> String
652+zonedTime t = formatTime defaultTimeLocale format t
653+ where
654+ format = "%FT%T." ++ formatMillis t ++ tzFormat
655+ tzFormat | timeZoneMinutes (zonedTimeZone t) == 0 = "Z"
656+ | otherwise = "%z"
657+
658+formatMillis :: (FormatTime t) => t -> String
659+formatMillis = take 3 . formatSubseconds
660+
661+formatSubseconds :: (FormatTime t) => t -> String
662+formatSubseconds = formatTime defaultTimeLocale "%q"
663+
664+instance FromJSON ZonedTime where
665+ parseJSON (String t) =
666+ tryFormats alternateFormats
667+ <|> fail "could not parse ECMA-262 ISO-8601 date"
668+ where
669+ tryFormat f =
670+ case parseTime defaultTimeLocale f (unpack t) of
671+ Just d -> pure d
672+ Nothing -> empty
673+ tryFormats = foldr1 (<|>) . map tryFormat
674+ alternateFormats =
675+ "%FT%T%QZ" : -- (javascript new Date().toISOString())
676+ "%F %T%Q%z" : -- (postgres)
677+ "%F %T%Q %Z" : -- (time's Show format)
678+ "%FT%T%Q%z" :
679+ "%Y-%mT%T%Q" :
680+ "%Y-%mT%R" :
681+ "%Y-%mT%T" :
682+ "%Y-%mT%T%QZ" :
683+ "%Y-%mT%T%Q%z" :
684+ "%YT%T%Q" :
685+ "%YT%R" :
686+ "%YT%T" :
687+ "%YT%T%QZ" :
688+ "%YT%T%Q%z" :
689+ "%FT%T%Q" :
690+ "%FT%R" :
691+ "%FT%T" :
692+ dateTimeFmt defaultTimeLocale :
693+ []
694+
695+ parseJSON v = typeMismatch "ZonedTime" v
696+
697+instance ToJSON UTCTime where
698+ toJSON = toJSON . utcTime
699+ {-# INLINE toJSON #-}
700+
701+ toEncoding = toEncoding . utcTime
702+
703+utcTime :: UTCTime -> String
704+utcTime t = formatTime defaultTimeLocale format t
705+ where format = "%FT%T." ++ formatSubseconds t ++ "Z"
706+
707+instance FromJSON UTCTime where
708+ parseJSON = withText "UTCTime" $ \t ->
709+ case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of
710+ Just d -> pure d
711+ _ -> fail "could not parse ISO-8601 date"
712+ {-# INLINE parseJSON #-}
713+
714+instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
715+ toJSON (a,b) = Array $ V.create $ do
716+ mv <- VM.unsafeNew 2
717+ VM.unsafeWrite mv 0 (toJSON a)
718+ VM.unsafeWrite mv 1 (toJSON b)
719+ return mv
720+ {-# INLINE toJSON #-}
721+
722+ toEncoding (a,b) = B.char7 '[' <>
723+ toEncoding a <> B.char7 ',' <>
724+ toEncoding b <> B.char7 ']'
725+
726+instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
727+ parseJSON = withArray "(a,b)" $ \ab ->
728+ let n = V.length ab
729+ in if n == 2
730+ then (,) <$> parseJSON (V.unsafeIndex ab 0)
731+ <*> parseJSON (V.unsafeIndex ab 1)
732+ else fail $ "cannot unpack array of length " ++
733+ show n ++ " into a pair"
734+ {-# INLINE parseJSON #-}
735+
736+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where
737+ toJSON (a,b,c) = Array $ V.create $ do
738+ mv <- VM.unsafeNew 3
739+ VM.unsafeWrite mv 0 (toJSON a)
740+ VM.unsafeWrite mv 1 (toJSON b)
741+ VM.unsafeWrite mv 2 (toJSON c)
742+ return mv
743+ {-# INLINE toJSON #-}
744+
745+ toEncoding (a,b,c) = B.char7 '[' <>
746+ toEncoding a <> B.char7 ',' <>
747+ toEncoding b <> B.char7 ',' <>
748+ toEncoding c <> B.char7 ']'
749+
750+instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
751+ parseJSON = withArray "(a,b,c)" $ \abc ->
752+ let n = V.length abc
753+ in if n == 3
754+ then (,,) <$> parseJSON (V.unsafeIndex abc 0)
755+ <*> parseJSON (V.unsafeIndex abc 1)
756+ <*> parseJSON (V.unsafeIndex abc 2)
757+ else fail $ "cannot unpack array of length " ++
758+ show n ++ " into a 3-tuple"
759+ {-# INLINE parseJSON #-}
760+
761+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where
762+ toJSON (a,b,c,d) = Array $ V.create $ do
763+ mv <- VM.unsafeNew 4
764+ VM.unsafeWrite mv 0 (toJSON a)
765+ VM.unsafeWrite mv 1 (toJSON b)
766+ VM.unsafeWrite mv 2 (toJSON c)
767+ VM.unsafeWrite mv 3 (toJSON d)
768+ return mv
769+ {-# INLINE toJSON #-}
770+
771+ toEncoding (a,b,c,d) = B.char7 '[' <>
772+ toEncoding a <> B.char7 ',' <>
773+ toEncoding b <> B.char7 ',' <>
774+ toEncoding c <> B.char7 ',' <>
775+ toEncoding d <> B.char7 ']'
776+
777+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>
778+ FromJSON (a,b,c,d) where
779+ parseJSON = withArray "(a,b,c,d)" $ \abcd ->
780+ let n = V.length abcd
781+ in if n == 4
782+ then (,,,) <$> parseJSON (V.unsafeIndex abcd 0)
783+ <*> parseJSON (V.unsafeIndex abcd 1)
784+ <*> parseJSON (V.unsafeIndex abcd 2)
785+ <*> parseJSON (V.unsafeIndex abcd 3)
786+ else fail $ "cannot unpack array of length " ++
787+ show n ++ " into a 4-tuple"
788+ {-# INLINE parseJSON #-}
789+
790+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) =>
791+ ToJSON (a,b,c,d,e) where
792+ toJSON (a,b,c,d,e) = Array $ V.create $ do
793+ mv <- VM.unsafeNew 5
794+ VM.unsafeWrite mv 0 (toJSON a)
795+ VM.unsafeWrite mv 1 (toJSON b)
796+ VM.unsafeWrite mv 2 (toJSON c)
797+ VM.unsafeWrite mv 3 (toJSON d)
798+ VM.unsafeWrite mv 4 (toJSON e)
799+ return mv
800+ {-# INLINE toJSON #-}
801+
802+ toEncoding (a,b,c,d,e) = B.char7 '[' <>
803+ toEncoding a <> B.char7 ',' <>
804+ toEncoding b <> B.char7 ',' <>
805+ toEncoding c <> B.char7 ',' <>
806+ toEncoding d <> B.char7 ',' <>
807+ toEncoding e <> B.char7 ']'
808+
809+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) =>
810+ FromJSON (a,b,c,d,e) where
811+ parseJSON = withArray "(a,b,c,d,e)" $ \abcde ->
812+ let n = V.length abcde
813+ in if n == 5
814+ then (,,,,) <$> parseJSON (V.unsafeIndex abcde 0)
815+ <*> parseJSON (V.unsafeIndex abcde 1)
816+ <*> parseJSON (V.unsafeIndex abcde 2)
817+ <*> parseJSON (V.unsafeIndex abcde 3)
818+ <*> parseJSON (V.unsafeIndex abcde 4)
819+ else fail $ "cannot unpack array of length " ++
820+ show n ++ " into a 5-tuple"
821+ {-# INLINE parseJSON #-}
822+
823+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) =>
824+ ToJSON (a,b,c,d,e,f) where
825+ toJSON (a,b,c,d,e,f) = Array $ V.create $ do
826+ mv <- VM.unsafeNew 6
827+ VM.unsafeWrite mv 0 (toJSON a)
828+ VM.unsafeWrite mv 1 (toJSON b)
829+ VM.unsafeWrite mv 2 (toJSON c)
830+ VM.unsafeWrite mv 3 (toJSON d)
831+ VM.unsafeWrite mv 4 (toJSON e)
832+ VM.unsafeWrite mv 5 (toJSON f)
833+ return mv
834+ {-# INLINE toJSON #-}
835+
836+ toEncoding (a,b,c,d,e,f) = B.char7 '[' <>
837+ toEncoding a <> B.char7 ',' <>
838+ toEncoding b <> B.char7 ',' <>
839+ toEncoding c <> B.char7 ',' <>
840+ toEncoding d <> B.char7 ',' <>
841+ toEncoding e <> B.char7 ',' <>
842+ toEncoding f <> B.char7 ']'
843+
844+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
845+ FromJSON f) => FromJSON (a,b,c,d,e,f) where
846+ parseJSON = withArray "(a,b,c,d,e,f)" $ \abcdef ->
847+ let n = V.length abcdef
848+ in if n == 6
849+ then (,,,,,) <$> parseJSON (V.unsafeIndex abcdef 0)
850+ <*> parseJSON (V.unsafeIndex abcdef 1)
851+ <*> parseJSON (V.unsafeIndex abcdef 2)
852+ <*> parseJSON (V.unsafeIndex abcdef 3)
853+ <*> parseJSON (V.unsafeIndex abcdef 4)
854+ <*> parseJSON (V.unsafeIndex abcdef 5)
855+ else fail $ "cannot unpack array of length " ++
856+ show n ++ " into a 6-tuple"
857+ {-# INLINE parseJSON #-}
858+
859+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
860+ ToJSON g) => ToJSON (a,b,c,d,e,f,g) where
861+ toJSON (a,b,c,d,e,f,g) = Array $ V.create $ do
862+ mv <- VM.unsafeNew 7
863+ VM.unsafeWrite mv 0 (toJSON a)
864+ VM.unsafeWrite mv 1 (toJSON b)
865+ VM.unsafeWrite mv 2 (toJSON c)
866+ VM.unsafeWrite mv 3 (toJSON d)
867+ VM.unsafeWrite mv 4 (toJSON e)
868+ VM.unsafeWrite mv 5 (toJSON f)
869+ VM.unsafeWrite mv 6 (toJSON g)
870+ return mv
871+ {-# INLINE toJSON #-}
872+
873+ toEncoding (a,b,c,d,e,f,g) = B.char7 '[' <>
874+ toEncoding a <> B.char7 ',' <>
875+ toEncoding b <> B.char7 ',' <>
876+ toEncoding c <> B.char7 ',' <>
877+ toEncoding d <> B.char7 ',' <>
878+ toEncoding e <> B.char7 ',' <>
879+ toEncoding f <> B.char7 ',' <>
880+ toEncoding g <> B.char7 ']'
881+
882+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
883+ FromJSON f, FromJSON g) => FromJSON (a,b,c,d,e,f,g) where
884+ parseJSON = withArray "(a,b,c,d,e,f,g)" $ \abcdefg ->
885+ let n = V.length abcdefg
886+ in if n == 7
887+ then (,,,,,,) <$> parseJSON (V.unsafeIndex abcdefg 0)
888+ <*> parseJSON (V.unsafeIndex abcdefg 1)
889+ <*> parseJSON (V.unsafeIndex abcdefg 2)
890+ <*> parseJSON (V.unsafeIndex abcdefg 3)
891+ <*> parseJSON (V.unsafeIndex abcdefg 4)
892+ <*> parseJSON (V.unsafeIndex abcdefg 5)
893+ <*> parseJSON (V.unsafeIndex abcdefg 6)
894+ else fail $ "cannot unpack array of length " ++
895+ show n ++ " into a 7-tuple"
896+ {-# INLINE parseJSON #-}
897+
898+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
899+ ToJSON g, ToJSON h) => ToJSON (a,b,c,d,e,f,g,h) where
900+ toJSON (a,b,c,d,e,f,g,h) = Array $ V.create $ do
901+ mv <- VM.unsafeNew 8
902+ VM.unsafeWrite mv 0 (toJSON a)
903+ VM.unsafeWrite mv 1 (toJSON b)
904+ VM.unsafeWrite mv 2 (toJSON c)
905+ VM.unsafeWrite mv 3 (toJSON d)
906+ VM.unsafeWrite mv 4 (toJSON e)
907+ VM.unsafeWrite mv 5 (toJSON f)
908+ VM.unsafeWrite mv 6 (toJSON g)
909+ VM.unsafeWrite mv 7 (toJSON h)
910+ return mv
911+ {-# INLINE toJSON #-}
912+
913+ toEncoding (a,b,c,d,e,f,g,h) = B.char7 '[' <>
914+ toEncoding a <> B.char7 ',' <>
915+ toEncoding b <> B.char7 ',' <>
916+ toEncoding c <> B.char7 ',' <>
917+ toEncoding d <> B.char7 ',' <>
918+ toEncoding e <> B.char7 ',' <>
919+ toEncoding f <> B.char7 ',' <>
920+ toEncoding g <> B.char7 ',' <>
921+ toEncoding h <> B.char7 ']'
922+
923+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
924+ FromJSON f, FromJSON g, FromJSON h) =>
925+ FromJSON (a,b,c,d,e,f,g,h) where
926+ parseJSON = withArray "(a,b,c,d,e,f,g,h)" $ \ary ->
927+ let n = V.length ary
928+ in if n /= 8
929+ then fail $ "cannot unpack array of length " ++
930+ show n ++ " into an 8-tuple"
931+ else (,,,,,,,)
932+ <$> parseJSON (V.unsafeIndex ary 0)
933+ <*> parseJSON (V.unsafeIndex ary 1)
934+ <*> parseJSON (V.unsafeIndex ary 2)
935+ <*> parseJSON (V.unsafeIndex ary 3)
936+ <*> parseJSON (V.unsafeIndex ary 4)
937+ <*> parseJSON (V.unsafeIndex ary 5)
938+ <*> parseJSON (V.unsafeIndex ary 6)
939+ <*> parseJSON (V.unsafeIndex ary 7)
940+ {-# INLINE parseJSON #-}
941+
942+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
943+ ToJSON g, ToJSON h, ToJSON i) => ToJSON (a,b,c,d,e,f,g,h,i) where
944+ toJSON (a,b,c,d,e,f,g,h,i) = Array $ V.create $ do
945+ mv <- VM.unsafeNew 9
946+ VM.unsafeWrite mv 0 (toJSON a)
947+ VM.unsafeWrite mv 1 (toJSON b)
948+ VM.unsafeWrite mv 2 (toJSON c)
949+ VM.unsafeWrite mv 3 (toJSON d)
950+ VM.unsafeWrite mv 4 (toJSON e)
951+ VM.unsafeWrite mv 5 (toJSON f)
952+ VM.unsafeWrite mv 6 (toJSON g)
953+ VM.unsafeWrite mv 7 (toJSON h)
954+ VM.unsafeWrite mv 8 (toJSON i)
955+ return mv
956+ {-# INLINE toJSON #-}
957+
958+ toEncoding (a,b,c,d,e,f,g,h,i) = B.char7 '[' <>
959+ toEncoding a <> B.char7 ',' <>
960+ toEncoding b <> B.char7 ',' <>
961+ toEncoding c <> B.char7 ',' <>
962+ toEncoding d <> B.char7 ',' <>
963+ toEncoding e <> B.char7 ',' <>
964+ toEncoding f <> B.char7 ',' <>
965+ toEncoding g <> B.char7 ',' <>
966+ toEncoding h <> B.char7 ',' <>
967+ toEncoding i <> B.char7 ']'
968+
969+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
970+ FromJSON f, FromJSON g, FromJSON h, FromJSON i) =>
971+ FromJSON (a,b,c,d,e,f,g,h,i) where
972+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i)" $ \ary ->
973+ let n = V.length ary
974+ in if n /= 9
975+ then fail $ "cannot unpack array of length " ++
976+ show n ++ " into a 9-tuple"
977+ else (,,,,,,,,)
978+ <$> parseJSON (V.unsafeIndex ary 0)
979+ <*> parseJSON (V.unsafeIndex ary 1)
980+ <*> parseJSON (V.unsafeIndex ary 2)
981+ <*> parseJSON (V.unsafeIndex ary 3)
982+ <*> parseJSON (V.unsafeIndex ary 4)
983+ <*> parseJSON (V.unsafeIndex ary 5)
984+ <*> parseJSON (V.unsafeIndex ary 6)
985+ <*> parseJSON (V.unsafeIndex ary 7)
986+ <*> parseJSON (V.unsafeIndex ary 8)
987+ {-# INLINE parseJSON #-}
988+
989+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
990+ ToJSON g, ToJSON h, ToJSON i, ToJSON j) =>
991+ ToJSON (a,b,c,d,e,f,g,h,i,j) where
992+ toJSON (a,b,c,d,e,f,g,h,i,j) = Array $ V.create $ do
993+ mv <- VM.unsafeNew 10
994+ VM.unsafeWrite mv 0 (toJSON a)
995+ VM.unsafeWrite mv 1 (toJSON b)
996+ VM.unsafeWrite mv 2 (toJSON c)
997+ VM.unsafeWrite mv 3 (toJSON d)
998+ VM.unsafeWrite mv 4 (toJSON e)
999+ VM.unsafeWrite mv 5 (toJSON f)
1000+ VM.unsafeWrite mv 6 (toJSON g)
1001+ VM.unsafeWrite mv 7 (toJSON h)
1002+ VM.unsafeWrite mv 8 (toJSON i)
1003+ VM.unsafeWrite mv 9 (toJSON j)
1004+ return mv
1005+ {-# INLINE toJSON #-}
1006+
1007+ toEncoding (a,b,c,d,e,f,g,h,i,j) = B.char7 '[' <>
1008+ toEncoding a <> B.char7 ',' <>
1009+ toEncoding b <> B.char7 ',' <>
1010+ toEncoding c <> B.char7 ',' <>
1011+ toEncoding d <> B.char7 ',' <>
1012+ toEncoding e <> B.char7 ',' <>
1013+ toEncoding f <> B.char7 ',' <>
1014+ toEncoding g <> B.char7 ',' <>
1015+ toEncoding h <> B.char7 ',' <>
1016+ toEncoding i <> B.char7 ',' <>
1017+ toEncoding j <> B.char7 ']'
1018+
1019+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1020+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) =>
1021+ FromJSON (a,b,c,d,e,f,g,h,i,j) where
1022+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j)" $ \ary ->
1023+ let n = V.length ary
1024+ in if n /= 10
1025+ then fail $ "cannot unpack array of length " ++
1026+ show n ++ " into a 10-tuple"
1027+ else (,,,,,,,,,)
1028+ <$> parseJSON (V.unsafeIndex ary 0)
1029+ <*> parseJSON (V.unsafeIndex ary 1)
1030+ <*> parseJSON (V.unsafeIndex ary 2)
1031+ <*> parseJSON (V.unsafeIndex ary 3)
1032+ <*> parseJSON (V.unsafeIndex ary 4)
1033+ <*> parseJSON (V.unsafeIndex ary 5)
1034+ <*> parseJSON (V.unsafeIndex ary 6)
1035+ <*> parseJSON (V.unsafeIndex ary 7)
1036+ <*> parseJSON (V.unsafeIndex ary 8)
1037+ <*> parseJSON (V.unsafeIndex ary 9)
1038+ {-# INLINE parseJSON #-}
1039+
1040+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1041+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) =>
1042+ ToJSON (a,b,c,d,e,f,g,h,i,j,k) where
1043+ toJSON (a,b,c,d,e,f,g,h,i,j,k) = Array $ V.create $ do
1044+ mv <- VM.unsafeNew 11
1045+ VM.unsafeWrite mv 0 (toJSON a)
1046+ VM.unsafeWrite mv 1 (toJSON b)
1047+ VM.unsafeWrite mv 2 (toJSON c)
1048+ VM.unsafeWrite mv 3 (toJSON d)
1049+ VM.unsafeWrite mv 4 (toJSON e)
1050+ VM.unsafeWrite mv 5 (toJSON f)
1051+ VM.unsafeWrite mv 6 (toJSON g)
1052+ VM.unsafeWrite mv 7 (toJSON h)
1053+ VM.unsafeWrite mv 8 (toJSON i)
1054+ VM.unsafeWrite mv 9 (toJSON j)
1055+ VM.unsafeWrite mv 10 (toJSON k)
1056+ return mv
1057+ {-# INLINE toJSON #-}
1058+
1059+ toEncoding (a,b,c,d,e,f,g,h,i,j,k) = B.char7 '[' <>
1060+ toEncoding a <> B.char7 ',' <>
1061+ toEncoding b <> B.char7 ',' <>
1062+ toEncoding c <> B.char7 ',' <>
1063+ toEncoding d <> B.char7 ',' <>
1064+ toEncoding e <> B.char7 ',' <>
1065+ toEncoding f <> B.char7 ',' <>
1066+ toEncoding g <> B.char7 ',' <>
1067+ toEncoding h <> B.char7 ',' <>
1068+ toEncoding i <> B.char7 ',' <>
1069+ toEncoding j <> B.char7 ',' <>
1070+ toEncoding k <> B.char7 ']'
1071+
1072+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1073+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1074+ FromJSON k) =>
1075+ FromJSON (a,b,c,d,e,f,g,h,i,j,k) where
1076+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k)" $ \ary ->
1077+ let n = V.length ary
1078+ in if n /= 11
1079+ then fail $ "cannot unpack array of length " ++
1080+ show n ++ " into an 11-tuple"
1081+ else (,,,,,,,,,,)
1082+ <$> parseJSON (V.unsafeIndex ary 0)
1083+ <*> parseJSON (V.unsafeIndex ary 1)
1084+ <*> parseJSON (V.unsafeIndex ary 2)
1085+ <*> parseJSON (V.unsafeIndex ary 3)
1086+ <*> parseJSON (V.unsafeIndex ary 4)
1087+ <*> parseJSON (V.unsafeIndex ary 5)
1088+ <*> parseJSON (V.unsafeIndex ary 6)
1089+ <*> parseJSON (V.unsafeIndex ary 7)
1090+ <*> parseJSON (V.unsafeIndex ary 8)
1091+ <*> parseJSON (V.unsafeIndex ary 9)
1092+ <*> parseJSON (V.unsafeIndex ary 10)
1093+ {-# INLINE parseJSON #-}
1094+
1095+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1096+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) =>
1097+ ToJSON (a,b,c,d,e,f,g,h,i,j,k,l) where
1098+ toJSON (a,b,c,d,e,f,g,h,i,j,k,l) = Array $ V.create $ do
1099+ mv <- VM.unsafeNew 12
1100+ VM.unsafeWrite mv 0 (toJSON a)
1101+ VM.unsafeWrite mv 1 (toJSON b)
1102+ VM.unsafeWrite mv 2 (toJSON c)
1103+ VM.unsafeWrite mv 3 (toJSON d)
1104+ VM.unsafeWrite mv 4 (toJSON e)
1105+ VM.unsafeWrite mv 5 (toJSON f)
1106+ VM.unsafeWrite mv 6 (toJSON g)
1107+ VM.unsafeWrite mv 7 (toJSON h)
1108+ VM.unsafeWrite mv 8 (toJSON i)
1109+ VM.unsafeWrite mv 9 (toJSON j)
1110+ VM.unsafeWrite mv 10 (toJSON k)
1111+ VM.unsafeWrite mv 11 (toJSON l)
1112+ return mv
1113+ {-# INLINE toJSON #-}
1114+
1115+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l) = B.char7 '[' <>
1116+ toEncoding a <> B.char7 ',' <>
1117+ toEncoding b <> B.char7 ',' <>
1118+ toEncoding c <> B.char7 ',' <>
1119+ toEncoding d <> B.char7 ',' <>
1120+ toEncoding e <> B.char7 ',' <>
1121+ toEncoding f <> B.char7 ',' <>
1122+ toEncoding g <> B.char7 ',' <>
1123+ toEncoding h <> B.char7 ',' <>
1124+ toEncoding i <> B.char7 ',' <>
1125+ toEncoding j <> B.char7 ',' <>
1126+ toEncoding k <> B.char7 ',' <>
1127+ toEncoding l <> B.char7 ']'
1128+
1129+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1130+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1131+ FromJSON k, FromJSON l) =>
1132+ FromJSON (a,b,c,d,e,f,g,h,i,j,k,l) where
1133+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l)" $ \ary ->
1134+ let n = V.length ary
1135+ in if n /= 12
1136+ then fail $ "cannot unpack array of length " ++
1137+ show n ++ " into a 12-tuple"
1138+ else (,,,,,,,,,,,)
1139+ <$> parseJSON (V.unsafeIndex ary 0)
1140+ <*> parseJSON (V.unsafeIndex ary 1)
1141+ <*> parseJSON (V.unsafeIndex ary 2)
1142+ <*> parseJSON (V.unsafeIndex ary 3)
1143+ <*> parseJSON (V.unsafeIndex ary 4)
1144+ <*> parseJSON (V.unsafeIndex ary 5)
1145+ <*> parseJSON (V.unsafeIndex ary 6)
1146+ <*> parseJSON (V.unsafeIndex ary 7)
1147+ <*> parseJSON (V.unsafeIndex ary 8)
1148+ <*> parseJSON (V.unsafeIndex ary 9)
1149+ <*> parseJSON (V.unsafeIndex ary 10)
1150+ <*> parseJSON (V.unsafeIndex ary 11)
1151+ {-# INLINE parseJSON #-}
1152+
1153+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1154+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1155+ ToJSON m) =>
1156+ ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) where
1157+ toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) = Array $ V.create $ do
1158+ mv <- VM.unsafeNew 13
1159+ VM.unsafeWrite mv 0 (toJSON a)
1160+ VM.unsafeWrite mv 1 (toJSON b)
1161+ VM.unsafeWrite mv 2 (toJSON c)
1162+ VM.unsafeWrite mv 3 (toJSON d)
1163+ VM.unsafeWrite mv 4 (toJSON e)
1164+ VM.unsafeWrite mv 5 (toJSON f)
1165+ VM.unsafeWrite mv 6 (toJSON g)
1166+ VM.unsafeWrite mv 7 (toJSON h)
1167+ VM.unsafeWrite mv 8 (toJSON i)
1168+ VM.unsafeWrite mv 9 (toJSON j)
1169+ VM.unsafeWrite mv 10 (toJSON k)
1170+ VM.unsafeWrite mv 11 (toJSON l)
1171+ VM.unsafeWrite mv 12 (toJSON m)
1172+ return mv
1173+ {-# INLINE toJSON #-}
1174+
1175+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m) = B.char7 '[' <>
1176+ toEncoding a <> B.char7 ',' <>
1177+ toEncoding b <> B.char7 ',' <>
1178+ toEncoding c <> B.char7 ',' <>
1179+ toEncoding d <> B.char7 ',' <>
1180+ toEncoding e <> B.char7 ',' <>
1181+ toEncoding f <> B.char7 ',' <>
1182+ toEncoding g <> B.char7 ',' <>
1183+ toEncoding h <> B.char7 ',' <>
1184+ toEncoding i <> B.char7 ',' <>
1185+ toEncoding j <> B.char7 ',' <>
1186+ toEncoding k <> B.char7 ',' <>
1187+ toEncoding l <> B.char7 ',' <>
1188+ toEncoding m <> B.char7 ']'
1189+
1190+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1191+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1192+ FromJSON k, FromJSON l, FromJSON m) =>
1193+ FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) where
1194+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m)" $ \ary ->
1195+ let n = V.length ary
1196+ in if n /= 13
1197+ then fail $ "cannot unpack array of length " ++
1198+ show n ++ " into a 13-tuple"
1199+ else (,,,,,,,,,,,,)
1200+ <$> parseJSON (V.unsafeIndex ary 0)
1201+ <*> parseJSON (V.unsafeIndex ary 1)
1202+ <*> parseJSON (V.unsafeIndex ary 2)
1203+ <*> parseJSON (V.unsafeIndex ary 3)
1204+ <*> parseJSON (V.unsafeIndex ary 4)
1205+ <*> parseJSON (V.unsafeIndex ary 5)
1206+ <*> parseJSON (V.unsafeIndex ary 6)
1207+ <*> parseJSON (V.unsafeIndex ary 7)
1208+ <*> parseJSON (V.unsafeIndex ary 8)
1209+ <*> parseJSON (V.unsafeIndex ary 9)
1210+ <*> parseJSON (V.unsafeIndex ary 10)
1211+ <*> parseJSON (V.unsafeIndex ary 11)
1212+ <*> parseJSON (V.unsafeIndex ary 12)
1213+ {-# INLINE parseJSON #-}
1214+
1215+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1216+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1217+ ToJSON m, ToJSON n) =>
1218+ ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
1219+ toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = Array $ V.create $ do
1220+ mv <- VM.unsafeNew 14
1221+ VM.unsafeWrite mv 0 (toJSON a)
1222+ VM.unsafeWrite mv 1 (toJSON b)
1223+ VM.unsafeWrite mv 2 (toJSON c)
1224+ VM.unsafeWrite mv 3 (toJSON d)
1225+ VM.unsafeWrite mv 4 (toJSON e)
1226+ VM.unsafeWrite mv 5 (toJSON f)
1227+ VM.unsafeWrite mv 6 (toJSON g)
1228+ VM.unsafeWrite mv 7 (toJSON h)
1229+ VM.unsafeWrite mv 8 (toJSON i)
1230+ VM.unsafeWrite mv 9 (toJSON j)
1231+ VM.unsafeWrite mv 10 (toJSON k)
1232+ VM.unsafeWrite mv 11 (toJSON l)
1233+ VM.unsafeWrite mv 12 (toJSON m)
1234+ VM.unsafeWrite mv 13 (toJSON n)
1235+ return mv
1236+ {-# INLINE toJSON #-}
1237+
1238+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = B.char7 '[' <>
1239+ toEncoding a <> B.char7 ',' <>
1240+ toEncoding b <> B.char7 ',' <>
1241+ toEncoding c <> B.char7 ',' <>
1242+ toEncoding d <> B.char7 ',' <>
1243+ toEncoding e <> B.char7 ',' <>
1244+ toEncoding f <> B.char7 ',' <>
1245+ toEncoding g <> B.char7 ',' <>
1246+ toEncoding h <> B.char7 ',' <>
1247+ toEncoding i <> B.char7 ',' <>
1248+ toEncoding j <> B.char7 ',' <>
1249+ toEncoding k <> B.char7 ',' <>
1250+ toEncoding l <> B.char7 ',' <>
1251+ toEncoding m <> B.char7 ',' <>
1252+ toEncoding n <> B.char7 ']'
1253+
1254+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1255+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1256+ FromJSON k, FromJSON l, FromJSON m, FromJSON n) =>
1257+ FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
1258+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m,n)" $ \ary ->
1259+ let n = V.length ary
1260+ in if n /= 14
1261+ then fail $ "cannot unpack array of length " ++
1262+ show n ++ " into a 14-tuple"
1263+ else (,,,,,,,,,,,,,)
1264+ <$> parseJSON (V.unsafeIndex ary 0)
1265+ <*> parseJSON (V.unsafeIndex ary 1)
1266+ <*> parseJSON (V.unsafeIndex ary 2)
1267+ <*> parseJSON (V.unsafeIndex ary 3)
1268+ <*> parseJSON (V.unsafeIndex ary 4)
1269+ <*> parseJSON (V.unsafeIndex ary 5)
1270+ <*> parseJSON (V.unsafeIndex ary 6)
1271+ <*> parseJSON (V.unsafeIndex ary 7)
1272+ <*> parseJSON (V.unsafeIndex ary 8)
1273+ <*> parseJSON (V.unsafeIndex ary 9)
1274+ <*> parseJSON (V.unsafeIndex ary 10)
1275+ <*> parseJSON (V.unsafeIndex ary 11)
1276+ <*> parseJSON (V.unsafeIndex ary 12)
1277+ <*> parseJSON (V.unsafeIndex ary 13)
1278+ {-# INLINE parseJSON #-}
1279+
1280+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1281+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1282+ ToJSON m, ToJSON n, ToJSON o) =>
1283+ ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
1284+ toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = Array $ V.create $ do
1285+ mv <- VM.unsafeNew 15
1286+ VM.unsafeWrite mv 0 (toJSON a)
1287+ VM.unsafeWrite mv 1 (toJSON b)
1288+ VM.unsafeWrite mv 2 (toJSON c)
1289+ VM.unsafeWrite mv 3 (toJSON d)
1290+ VM.unsafeWrite mv 4 (toJSON e)
1291+ VM.unsafeWrite mv 5 (toJSON f)
1292+ VM.unsafeWrite mv 6 (toJSON g)
1293+ VM.unsafeWrite mv 7 (toJSON h)
1294+ VM.unsafeWrite mv 8 (toJSON i)
1295+ VM.unsafeWrite mv 9 (toJSON j)
1296+ VM.unsafeWrite mv 10 (toJSON k)
1297+ VM.unsafeWrite mv 11 (toJSON l)
1298+ VM.unsafeWrite mv 12 (toJSON m)
1299+ VM.unsafeWrite mv 13 (toJSON n)
1300+ VM.unsafeWrite mv 14 (toJSON o)
1301+ return mv
1302+ {-# INLINE toJSON #-}
1303+
1304+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = B.char7 '[' <>
1305+ toEncoding a <> B.char7 ',' <>
1306+ toEncoding b <> B.char7 ',' <>
1307+ toEncoding c <> B.char7 ',' <>
1308+ toEncoding d <> B.char7 ',' <>
1309+ toEncoding e <> B.char7 ',' <>
1310+ toEncoding f <> B.char7 ',' <>
1311+ toEncoding g <> B.char7 ',' <>
1312+ toEncoding h <> B.char7 ',' <>
1313+ toEncoding i <> B.char7 ',' <>
1314+ toEncoding j <> B.char7 ',' <>
1315+ toEncoding k <> B.char7 ',' <>
1316+ toEncoding l <> B.char7 ',' <>
1317+ toEncoding m <> B.char7 ',' <>
1318+ toEncoding n <> B.char7 ',' <>
1319+ toEncoding o <> B.char7 ']'
1320+
1321+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1322+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1323+ FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) =>
1324+ FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
1325+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)" $ \ary ->
1326+ let n = V.length ary
1327+ in if n /= 15
1328+ then fail $ "cannot unpack array of length " ++
1329+ show n ++ " into a 15-tuple"
1330+ else (,,,,,,,,,,,,,,)
1331+ <$> parseJSON (V.unsafeIndex ary 0)
1332+ <*> parseJSON (V.unsafeIndex ary 1)
1333+ <*> parseJSON (V.unsafeIndex ary 2)
1334+ <*> parseJSON (V.unsafeIndex ary 3)
1335+ <*> parseJSON (V.unsafeIndex ary 4)
1336+ <*> parseJSON (V.unsafeIndex ary 5)
1337+ <*> parseJSON (V.unsafeIndex ary 6)
1338+ <*> parseJSON (V.unsafeIndex ary 7)
1339+ <*> parseJSON (V.unsafeIndex ary 8)
1340+ <*> parseJSON (V.unsafeIndex ary 9)
1341+ <*> parseJSON (V.unsafeIndex ary 10)
1342+ <*> parseJSON (V.unsafeIndex ary 11)
1343+ <*> parseJSON (V.unsafeIndex ary 12)
1344+ <*> parseJSON (V.unsafeIndex ary 13)
1345+ <*> parseJSON (V.unsafeIndex ary 14)
1346+ {-# INLINE parseJSON #-}
1347+
1348+instance ToJSON a => ToJSON (Dual a) where
1349+ toJSON = toJSON . getDual
1350+ {-# INLINE toJSON #-}
1351+
1352+ toEncoding = toEncoding . getDual
1353+
1354+instance FromJSON a => FromJSON (Dual a) where
1355+ parseJSON = fmap Dual . parseJSON
1356+ {-# INLINE parseJSON #-}
1357+
1358+instance ToJSON a => ToJSON (First a) where
1359+ toJSON = toJSON . getFirst
1360+ {-# INLINE toJSON #-}
1361+
1362+ toEncoding = toEncoding . getFirst
1363+
1364+instance FromJSON a => FromJSON (First a) where
1365+ parseJSON = fmap First . parseJSON
1366+ {-# INLINE parseJSON #-}
1367+
1368+instance ToJSON a => ToJSON (Last a) where
1369+ toJSON = toJSON . getLast
1370+ {-# INLINE toJSON #-}
1371+
1372+ toEncoding = toEncoding . getLast
1373+
1374+instance FromJSON a => FromJSON (Last a) where
1375+ parseJSON = fmap Last . parseJSON
1376+ {-# INLINE parseJSON #-}
1377+
1378+-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@
1379+-- and fails using @'typeMismatch' expected@ otherwise.
1380+withObject :: String -> (Object -> Parser a) -> Value -> Parser a
1381+withObject _ f (Object obj) = f obj
1382+withObject expected _ v = typeMismatch expected v
1383+{-# INLINE withObject #-}
1384+
1385+-- | @withText expected f value@ applies @f@ to the 'Text' when @value@ is a @String@
1386+-- and fails using @'typeMismatch' expected@ otherwise.
1387+withText :: String -> (Text -> Parser a) -> Value -> Parser a
1388+withText _ f (String txt) = f txt
1389+withText expected _ v = typeMismatch expected v
1390+{-# INLINE withText #-}
1391+
1392+-- | @withArray expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@
1393+-- and fails using @'typeMismatch' expected@ otherwise.
1394+withArray :: String -> (Array -> Parser a) -> Value -> Parser a
1395+withArray _ f (Array arr) = f arr
1396+withArray expected _ v = typeMismatch expected v
1397+{-# INLINE withArray #-}
1398+
1399+-- | @withNumber expected f value@ applies @f@ to the 'Number' when @value@ is a 'Number'.
1400+-- and fails using @'typeMismatch' expected@ otherwise.
1401+withNumber :: String -> (Number -> Parser a) -> Value -> Parser a
1402+withNumber expected f = withScientific expected (f . scientificToNumber)
1403+{-# INLINE withNumber #-}
1404+{-# DEPRECATED withNumber "Use withScientific instead" #-}
1405+
1406+-- | @withScientific expected f value@ applies @f@ to the 'Scientific' number when @value@ is a 'Number'.
1407+-- and fails using @'typeMismatch' expected@ otherwise.
1408+withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
1409+withScientific _ f (Number scientific) = f scientific
1410+withScientific expected _ v = typeMismatch expected v
1411+{-# INLINE withScientific #-}
1412+
1413+-- | @withBool expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@
1414+-- and fails using @'typeMismatch' expected@ otherwise.
1415+withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
1416+withBool _ f (Bool arr) = f arr
1417+withBool expected _ v = typeMismatch expected v
1418+{-# INLINE withBool #-}
1419+
1420+-- | Construct a 'Pair' from a key and a value.
1421+(.=) :: ToJSON a => Text -> a -> Pair
1422+name .= value = (name, toJSON value)
1423+{-# INLINE (.=) #-}
1424+
1425+-- | Convert a value from JSON, failing if the types do not match.
1426+fromJSON :: (FromJSON a) => Value -> Result a
1427+fromJSON = parse parseJSON
1428+{-# INLINE fromJSON #-}
1429+
1430+-- | Retrieve the value associated with the given key of an 'Object'.
1431+-- The result is 'empty' if the key is not present or the value cannot
1432+-- be converted to the desired type.
1433+--
1434+-- This accessor is appropriate if the key and value /must/ be present
1435+-- in an object for it to be valid. If the key and value are
1436+-- optional, use '(.:?)' instead.
1437+(.:) :: (FromJSON a) => Object -> Text -> Parser a
1438+obj .: key = case H.lookup key obj of
1439+ Nothing -> fail $ "key " ++ show key ++ " not present"
1440+ Just v -> parseJSON v
1441+{-# INLINE (.:) #-}
1442+
1443+-- | Retrieve the value associated with the given key of an 'Object'.
1444+-- The result is 'Nothing' if the key is not present, or 'empty' if
1445+-- the value cannot be converted to the desired type.
1446+--
1447+-- This accessor is most useful if the key and value can be absent
1448+-- from an object without affecting its validity. If the key and
1449+-- value are mandatory, use '(.:)' instead.
1450+(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
1451+obj .:? key = case H.lookup key obj of
1452+ Nothing -> pure Nothing
1453+ Just v -> parseJSON v
1454+{-# INLINE (.:?) #-}
1455+
1456+-- | Helper for use in combination with '.:?' to provide default
1457+-- values for optional JSON object fields.
1458+--
1459+-- This combinator is most useful if the key and value can be absent
1460+-- from an object without affecting its validity and we know a default
1461+-- value to assign in that case. If the key and value are mandatory,
1462+-- use '(.:)' instead.
1463+--
1464+-- Example usage:
1465+--
1466+-- @ v1 <- o '.:?' \"opt_field_with_dfl\" .!= \"default_val\"
1467+-- v2 <- o '.:' \"mandatory_field\"
1468+-- v3 <- o '.:?' \"opt_field2\"
1469+-- @
1470+(.!=) :: Parser (Maybe a) -> a -> Parser a
1471+pmval .!= val = fromMaybe val <$> pmval
1472+{-# INLINE (.!=) #-}
1473+
1474+-- | Fail parsing due to a type mismatch, with a descriptive message.
1475+typeMismatch :: String -- ^ The name of the type you are trying to parse.
1476+ -> Value -- ^ The actual value encountered.
1477+ -> Parser a
1478+typeMismatch expected actual =
1479+ fail $ "when expecting a " ++ expected ++ ", encountered " ++ name ++
1480+ " instead"
1481+ where
1482+ name = case actual of
1483+ Object _ -> "Object"
1484+ Array _ -> "Array"
1485+ String _ -> "String"
1486+ Number _ -> "Number"
1487+ Bool _ -> "Boolean"
1488+ Null -> "Null"
1489+
1490+realFloatToJSON :: RealFloat a => a -> Value
1491+realFloatToJSON d
1492+ | isNaN d || isInfinite d = Null
1493+ | otherwise = Number $ Scientific.fromFloatDigits d
1494+{-# INLINE realFloatToJSON #-}
1495+
1496+realFloatToEncoding :: RealFloat a => a -> Encoding
1497+realFloatToEncoding d
1498+ | isNaN d || isInfinite d = E.null_
1499+ | otherwise = toEncoding (Scientific.fromFloatDigits d)
1500+{-# INLINE realFloatToEncoding #-}
1501+
1502+scientificToNumber :: Scientific -> Number
1503+scientificToNumber s
1504+ | e < 0 = D $ Scientific.toRealFloat s
1505+ | otherwise = I $ c * 10 ^ e
1506+ where
1507+ e = Scientific.base10Exponent s
1508+ c = Scientific.coefficient s
1509+{-# INLINE scientificToNumber #-}
1510+
1511+parseRealFloat :: RealFloat a => String -> Value -> Parser a
1512+parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
1513+parseRealFloat _ Null = pure (0/0)
1514+parseRealFloat expected v = typeMismatch expected v
1515+{-# INLINE parseRealFloat #-}
1516+
1517+parseIntegral :: Integral a => String -> Value -> Parser a
1518+parseIntegral expected = withScientific expected $ pure . floor
1519+{-# INLINE parseIntegral #-}
Data/Aeson/Types/Internal.hs+61−468
@@ -1,23 +1,10 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, Rank2Types #-}
5−{-# LANGUAGE NoImplicitPrelude #-}
6−{-# LANGUAGE Rank2Types #-}
7−#if __GLASGOW_HASKELL__ >= 800
8−-- a) THQ works on cross-compilers and unregisterised GHCs
9−-- b) may make compilation faster as no dynamic loading is ever needed (not sure about this)
10−-- c) removes one hindrance to have code inferred as SafeHaskell safe
11−{-# LANGUAGE TemplateHaskellQuotes #-}
12−#else
13−{-# LANGUAGE TemplateHaskell #-}
14−#endif
15
2
16-- |
3-- |
17-- Module: Data.Aeson.Types.Internal
4-- Module: Data.Aeson.Types.Internal
18−-- Copyright: (c) 2011-2016 Bryan O'Sullivan
5+-- Copyright: (c) 2011, 2012 Bryan O'Sullivan
19-- (c) 2011 MailRank, Inc.
6-- (c) 2011 MailRank, Inc.
20−-- License: BSD3
7+-- License: Apache
21-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
22-- Stability: experimental
9-- Stability: experimental
23-- Portability: portable
10-- Portability: portable
@@ -28,187 +15,82 @@ module Data.Aeson.Types.Internal
28 (
15 (
29 -- * Core JSON types
16 -- * Core JSON types
30 Value(..)
17 Value(..)
18+ , Encoding
19+ , Series(..)
31 , Array
20 , Array
32 , emptyArray, isEmptyArray
21 , emptyArray, isEmptyArray
33 , Pair
22 , Pair
34 , Object
23 , Object
35 , emptyObject
24 , emptyObject
36−
37 -- * Type conversion
25 -- * Type conversion
38 , Parser
26 , Parser
39 , Result(..)
27 , Result(..)
40− , IResult(..)
41− , JSONPathElement(..)
42− , JSONPath
43− , iparse
44 , parse
28 , parse
45 , parseEither
29 , parseEither
46 , parseMaybe
30 , parseMaybe
47 , modifyFailure
31 , modifyFailure
48− , prependFailure
49− , parserThrowError
50− , parserCatchError
51− , formatError
52− , formatPath
53− , formatRelativePath
54− , (<?>)
55 -- * Constructors and accessors
32 -- * Constructors and accessors
56 , object
33 , object
57
34
58 -- * Generic and TH encoding configuration
35 -- * Generic and TH encoding configuration
59− , Options(
36+ , Options(..)
60− fieldLabelModifier
61− , constructorTagModifier
62− , allNullaryToStringTag
63− , omitNothingFields
64− , sumEncoding
65− , unwrapUnaryRecords
66− , tagSingleConstructors
67− , rejectUnknownFields
68− )
69−
70 , SumEncoding(..)
37 , SumEncoding(..)
71− , JSONKeyOptions(keyModifier)
72 , defaultOptions
38 , defaultOptions
73 , defaultTaggedObject
39 , defaultTaggedObject
74− , defaultJSONKeyOptions
75
40
76 -- * Used for changing CamelCase names into something else.
41 -- * Used for changing CamelCase names into something else.
77 , camelTo
42 , camelTo
78− , camelTo2
79
43
80 -- * Other types
44 -- * Other types
81 , DotNetTime(..)
45 , DotNetTime(..)
82 ) where
46 ) where
83
47
84−import Prelude.Compat
85−
86−import Control.Applicative (Alternative(..))
48+import Control.Applicative
87−import Control.Arrow (first)
49+import Control.Monad
88import Control.DeepSeq (NFData(..))
50import Control.DeepSeq (NFData(..))
89−import Control.Monad (MonadPlus(..), ap)
51+import Data.ByteString.Builder (Builder, char7)
90−import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
52+import Data.Char (toLower, isUpper)
53+import Data.Scientific (Scientific)
54+import Data.Hashable (Hashable(..))
91import Data.Data (Data)
55import Data.Data (Data)
92−import Data.Foldable (foldl')
93import Data.HashMap.Strict (HashMap)
56import Data.HashMap.Strict (HashMap)
94−import Data.Hashable (Hashable(..))
57+import Data.Monoid (Monoid(..), (<>))
95−import Data.List (intercalate)
96−import Data.Scientific (Scientific)
97−import Data.Semigroup (Semigroup((<>)))
98import Data.String (IsString(..))
58import Data.String (IsString(..))
99−import Data.Text (Text, pack, unpack)
59+import Data.Text (Text, pack)
100import Data.Time (UTCTime)
60import Data.Time (UTCTime)
101import Data.Time.Format (FormatTime)
61import Data.Time.Format (FormatTime)
102import Data.Typeable (Typeable)
62import Data.Typeable (Typeable)
103import Data.Vector (Vector)
63import Data.Vector (Vector)
104−import GHC.Generics (Generic)
105−import qualified Control.Monad as Monad
106−import qualified Control.Monad.Fail as Fail
107import qualified Data.HashMap.Strict as H
64import qualified Data.HashMap.Strict as H
108−import qualified Data.Scientific as S
109import qualified Data.Vector as V
65import qualified Data.Vector as V
110−import qualified Language.Haskell.TH.Syntax as TH
111−
112−#if !MIN_VERSION_unordered_containers(0,2,6)
113−import Data.List (sort)
114−#endif
115−
116−-- | Elements of a JSON path used to describe the location of an
117−-- error.
118−data JSONPathElement = Key Text
119− -- ^ JSON path element of a key into an object,
120− -- \"object.key\".
121− | Index {-# UNPACK #-} !Int
122− -- ^ JSON path element of an index into an
123− -- array, \"array[index]\".
124− deriving (Eq, Show, Typeable, Ord)
125−type JSONPath = [JSONPathElement]
126−
127−-- | The internal result of running a 'Parser'.
128−data IResult a = IError JSONPath String
129− | ISuccess a
130− deriving (Eq, Show, Typeable)
131
66
132-- | The result of running a 'Parser'.
67-- | The result of running a 'Parser'.
133data Result a = Error String
68data Result a = Error String
134 | Success a
69 | Success a
135 deriving (Eq, Show, Typeable)
70 deriving (Eq, Show, Typeable)
136
71
137−instance NFData JSONPathElement where
138− rnf (Key t) = rnf t
139− rnf (Index i) = rnf i
140−
141−instance (NFData a) => NFData (IResult a) where
142− rnf (ISuccess a) = rnf a
143− rnf (IError path err) = rnf path `seq` rnf err
144−
145instance (NFData a) => NFData (Result a) where
72instance (NFData a) => NFData (Result a) where
146 rnf (Success a) = rnf a
73 rnf (Success a) = rnf a
147 rnf (Error err) = rnf err
74 rnf (Error err) = rnf err
148
75
149−instance Functor IResult where
150− fmap f (ISuccess a) = ISuccess (f a)
151− fmap _ (IError path err) = IError path err
152− {-# INLINE fmap #-}
153−
154instance Functor Result where
76instance Functor Result where
155 fmap f (Success a) = Success (f a)
77 fmap f (Success a) = Success (f a)
156 fmap _ (Error err) = Error err
78 fmap _ (Error err) = Error err
157 {-# INLINE fmap #-}
79 {-# INLINE fmap #-}
158
80
159−instance Monad.Monad IResult where
81+instance Monad Result where
160− return = pure
82+ return = Success
161 {-# INLINE return #-}
83 {-# INLINE return #-}
162−
163− ISuccess a >>= k = k a
164− IError path err >>= _ = IError path err
165− {-# INLINE (>>=) #-}
166−
167−#if !(MIN_VERSION_base(4,13,0))
168− fail = Fail.fail
169− {-# INLINE fail #-}
170−#endif
171−
172−instance Fail.MonadFail IResult where
173− fail err = IError [] err
174− {-# INLINE fail #-}
175−
176−instance Monad.Monad Result where
177− return = pure
178− {-# INLINE return #-}
179−
180 Success a >>= k = k a
84 Success a >>= k = k a
181 Error err >>= _ = Error err
85 Error err >>= _ = Error err
182 {-# INLINE (>>=) #-}
86 {-# INLINE (>>=) #-}
183
87
184−#if !(MIN_VERSION_base(4,13,0))
185− fail = Fail.fail
186− {-# INLINE fail #-}
187−#endif
188−
189−instance Fail.MonadFail Result where
190− fail err = Error err
191− {-# INLINE fail #-}
192−
193−instance Applicative IResult where
194− pure = ISuccess
195− {-# INLINE pure #-}
196− (<*>) = ap
197− {-# INLINE (<*>) #-}
198−
199instance Applicative Result where
88instance Applicative Result where
200− pure = Success
89+ pure = return
201 {-# INLINE pure #-}
90 {-# INLINE pure #-}
202 (<*>) = ap
91 (<*>) = ap
203 {-# INLINE (<*>) #-}
92 {-# INLINE (<*>) #-}
204
93
205−instance MonadPlus IResult where
206− mzero = fail "mzero"
207− {-# INLINE mzero #-}
208− mplus a@(ISuccess _) _ = a
209− mplus _ b = b
210− {-# INLINE mplus #-}
211−
212instance MonadPlus Result where
94instance MonadPlus Result where
213 mzero = fail "mzero"
95 mzero = fail "mzero"
214 {-# INLINE mzero #-}
96 {-# INLINE mzero #-}
@@ -216,105 +98,47 @@ instance MonadPlus Result where
216 mplus _ b = b
98 mplus _ b = b
217 {-# INLINE mplus #-}
99 {-# INLINE mplus #-}
218
100
219−instance Alternative IResult where
220− empty = mzero
221− {-# INLINE empty #-}
222− (<|>) = mplus
223− {-# INLINE (<|>) #-}
224−
225instance Alternative Result where
101instance Alternative Result where
226 empty = mzero
102 empty = mzero
227 {-# INLINE empty #-}
103 {-# INLINE empty #-}
228 (<|>) = mplus
104 (<|>) = mplus
229 {-# INLINE (<|>) #-}
105 {-# INLINE (<|>) #-}
230
106
231−instance Semigroup (IResult a) where
232− (<>) = mplus
233− {-# INLINE (<>) #-}
234−
235−instance Monoid (IResult a) where
236− mempty = fail "mempty"
237− {-# INLINE mempty #-}
238− mappend = (<>)
239− {-# INLINE mappend #-}
240−
241−instance Semigroup (Result a) where
242− (<>) = mplus
243− {-# INLINE (<>) #-}
244−
245instance Monoid (Result a) where
107instance Monoid (Result a) where
246 mempty = fail "mempty"
108 mempty = fail "mempty"
247 {-# INLINE mempty #-}
109 {-# INLINE mempty #-}
248− mappend = (<>)
110+ mappend = mplus
249 {-# INLINE mappend #-}
111 {-# INLINE mappend #-}
250
112
251−instance Foldable IResult where
252− foldMap _ (IError _ _) = mempty
253− foldMap f (ISuccess y) = f y
254− {-# INLINE foldMap #-}
255−
256− foldr _ z (IError _ _) = z
257− foldr f z (ISuccess y) = f y z
258− {-# INLINE foldr #-}
259−
260−instance Foldable Result where
261− foldMap _ (Error _) = mempty
262− foldMap f (Success y) = f y
263− {-# INLINE foldMap #-}
264−
265− foldr _ z (Error _) = z
266− foldr f z (Success y) = f y z
267− {-# INLINE foldr #-}
268−
269−instance Traversable IResult where
270− traverse _ (IError path err) = pure (IError path err)
271− traverse f (ISuccess a) = ISuccess <$> f a
272− {-# INLINE traverse #-}
273−
274−instance Traversable Result where
275− traverse _ (Error err) = pure (Error err)
276− traverse f (Success a) = Success <$> f a
277− {-# INLINE traverse #-}
278−
279-- | Failure continuation.
113-- | Failure continuation.
280−type Failure f r = JSONPath -> String -> f r
114+type Failure f r = String -> f r
281-- | Success continuation.
115-- | Success continuation.
282type Success a f r = a -> f r
116type Success a f r = a -> f r
283
117
284−-- | A JSON parser. N.B. This might not fit your usual understanding of
118+-- | A continuation-based parser type.
285−-- "parser". Instead you might like to think of 'Parser' as a "parse result",
286−-- i.e. a parser to which the input has already been applied.
287newtype Parser a = Parser {
119newtype Parser a = Parser {
288 runParser :: forall f r.
120 runParser :: forall f r.
289− JSONPath
290− -> Failure f r
121+ Failure f r
291 -> Success a f r
122 -> Success a f r
292 -> f r
123 -> f r
293 }
124 }
294
125
295−instance Monad.Monad Parser where
126+instance Monad Parser where
296− m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks
127+ m >>= g = Parser $ \kf ks -> let ks' a = runParser (g a) kf ks
297− in runParser m path kf ks'
128+ in runParser m kf ks'
298 {-# INLINE (>>=) #-}
129 {-# INLINE (>>=) #-}
299− return = pure
130+ return a = Parser $ \_kf ks -> ks a
300 {-# INLINE return #-}
131 {-# INLINE return #-}
301−
302−#if !(MIN_VERSION_base(4,13,0))
303− fail = Fail.fail
304− {-# INLINE fail #-}
305−#endif
306−
307−instance Fail.MonadFail Parser where
308− fail msg = Parser $ \path kf _ks -> kf (reverse path) msg
132+ fail msg = Parser $ \kf _ks -> kf msg
309 {-# INLINE fail #-}
133 {-# INLINE fail #-}
310
134
311instance Functor Parser where
135instance Functor Parser where
312− fmap f m = Parser $ \path kf ks -> let ks' a = ks (f a)
136+ fmap f m = Parser $ \kf ks -> let ks' a = ks (f a)
313− in runParser m path kf ks'
137+ in runParser m kf ks'
314 {-# INLINE fmap #-}
138 {-# INLINE fmap #-}
315
139
316instance Applicative Parser where
140instance Applicative Parser where
317− pure a = Parser $ \_path _kf ks -> ks a
141+ pure = return
318 {-# INLINE pure #-}
142 {-# INLINE pure #-}
319 (<*>) = apP
143 (<*>) = apP
320 {-# INLINE (<*>) #-}
144 {-# INLINE (<*>) #-}
@@ -328,24 +152,21 @@ instance Alternative Parser where
328instance MonadPlus Parser where
152instance MonadPlus Parser where
329 mzero = fail "mzero"
153 mzero = fail "mzero"
330 {-# INLINE mzero #-}
154 {-# INLINE mzero #-}
331− mplus a b = Parser $ \path kf ks -> let kf' _ _ = runParser b path kf ks
155+ mplus a b = Parser $ \kf ks -> let kf' _ = runParser b kf ks
332− in runParser a path kf' ks
156+ in runParser a kf' ks
333 {-# INLINE mplus #-}
157 {-# INLINE mplus #-}
334
158
335−instance Semigroup (Parser a) where
336− (<>) = mplus
337− {-# INLINE (<>) #-}
338−
339instance Monoid (Parser a) where
159instance Monoid (Parser a) where
340 mempty = fail "mempty"
160 mempty = fail "mempty"
341 {-# INLINE mempty #-}
161 {-# INLINE mempty #-}
342− mappend = (<>)
162+ mappend = mplus
343 {-# INLINE mappend #-}
163 {-# INLINE mappend #-}
344
164
345apP :: Parser (a -> b) -> Parser a -> Parser b
165apP :: Parser (a -> b) -> Parser a -> Parser b
346apP d e = do
166apP d e = do
347 b <- d
167 b <- d
348− b <$> e
168+ a <- e
169+ return (b a)
349{-# INLINE apP #-}
170{-# INLINE apP #-}
350
171
351-- | A JSON \"object\" (key\/value map).
172-- | A JSON \"object\" (key\/value map).
@@ -361,11 +182,26 @@ data Value = Object !Object
361 | Number !Scientific
182 | Number !Scientific
362 | Bool !Bool
183 | Bool !Bool
363 | Null
184 | Null
364− deriving (Eq, Read, Show, Typeable, Data, Generic)
185+ deriving (Eq, Read, Show, Typeable, Data)
186+
187+-- | An encoding of a JSON value.
188+type Encoding = Builder
189+
190+data Series = Empty
191+ | Value Builder
192+ deriving (Typeable)
193+
194+instance Monoid Series where
195+ mempty = Empty
196+ mappend Empty a = a
197+ mappend (Value a) b =
198+ Value $
199+ a <> case b of
200+ Empty -> mempty
201+ Value c -> char7 ',' <> c
365
202
366-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
203-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
367−-- serialization format as Microsoft .NET, whose
204+-- serialization format as Microsoft .NET, whose @System.DateTime@
368−-- <https://msdn.microsoft.com/en-us/library/system.datetime(v=vs.110).aspx System.DateTime>
369-- type is by default serialized to JSON as in the following example:
205-- type is by default serialized to JSON as in the following example:
370--
206--
371-- > /Date(1302547608878)/
207-- > /Date(1302547608878)/
@@ -373,12 +209,11 @@ data Value = Object !Object
373-- The number represents milliseconds since the Unix epoch.
209-- The number represents milliseconds since the Unix epoch.
374newtype DotNetTime = DotNetTime {
210newtype DotNetTime = DotNetTime {
375 fromDotNetTime :: UTCTime
211 fromDotNetTime :: UTCTime
376− -- ^ Acquire the underlying value.
377 } deriving (Eq, Ord, Read, Show, Typeable, FormatTime)
212 } deriving (Eq, Ord, Read, Show, Typeable, FormatTime)
378
213
379instance NFData Value where
214instance NFData Value where
380 rnf (Object o) = rnf o
215 rnf (Object o) = rnf o
381− rnf (Array a) = foldl' (\x y -> rnf y `seq` x) () a
216+ rnf (Array a) = V.foldl' (\x y -> rnf y `seq` x) () a
382 rnf (String s) = rnf s
217 rnf (String s) = rnf s
383 rnf (Number n) = rnf n
218 rnf (Number n) = rnf n
384 rnf (Bool b) = rnf b
219 rnf (Bool b) = rnf b
@@ -389,15 +224,9 @@ instance IsString Value where
389 {-# INLINE fromString #-}
224 {-# INLINE fromString #-}
390
225
391hashValue :: Int -> Value -> Int
226hashValue :: Int -> Value -> Int
392−#if MIN_VERSION_unordered_containers(0,2,6)
393−hashValue s (Object o) = s `hashWithSalt` (0::Int) `hashWithSalt` o
394−#else
395−hashValue s (Object o) = foldl' hashWithSalt
227+hashValue s (Object o) = H.foldl' hashWithSalt
396− (s `hashWithSalt` (0::Int)) assocHashesSorted
228+ (s `hashWithSalt` (0::Int)) o
397− where
398− assocHashesSorted = sort [hash k `hashWithSalt` v | (k, v) <- H.toList o]
399−#endif
400−hashValue s (Array a) = foldl' hashWithSalt
229+hashValue s (Array a) = V.foldl' hashWithSalt
401 (s `hashWithSalt` (1::Int)) a
230 (s `hashWithSalt` (1::Int)) a
402hashValue s (String str) = s `hashWithSalt` (2::Int) `hashWithSalt` str
231hashValue s (String str) = s `hashWithSalt` (2::Int) `hashWithSalt` str
403hashValue s (Number n) = s `hashWithSalt` (3::Int) `hashWithSalt` n
232hashValue s (Number n) = s `hashWithSalt` (3::Int) `hashWithSalt` n
@@ -407,21 +236,6 @@ hashValue s Null = s `hashWithSalt` (5::Int)
407instance Hashable Value where
236instance Hashable Value where
408 hashWithSalt = hashValue
237 hashWithSalt = hashValue
409
238
410−-- @since 0.11.0.0
411−instance TH.Lift Value where
412− lift Null = [| Null |]
413− lift (Bool b) = [| Bool b |]
414− lift (Number n) = [| Number (S.scientific c e) |]
415− where
416− c = S.coefficient n
417− e = S.base10Exponent n
418− lift (String t) = [| String (pack s) |]
419− where s = unpack t
420− lift (Array a) = [| Array (V.fromList a') |]
421− where a' = V.toList a
422− lift (Object o) = [| Object (H.fromList . map (first pack) $ o') |]
423− where o' = map (first unpack) . H.toList $ o
424−
425-- | The empty array.
239-- | The empty array.
426emptyArray :: Value
240emptyArray :: Value
427emptyArray = Array V.empty
241emptyArray = Array V.empty
@@ -438,64 +252,19 @@ emptyObject = Object H.empty
438
252
439-- | Run a 'Parser'.
253-- | Run a 'Parser'.
440parse :: (a -> Parser b) -> a -> Result b
254parse :: (a -> Parser b) -> a -> Result b
441−parse m v = runParser (m v) [] (const Error) Success
255+parse m v = runParser (m v) Error Success
442{-# INLINE parse #-}
256{-# INLINE parse #-}
443
257
444−-- | Run a 'Parser'.
445−iparse :: (a -> Parser b) -> a -> IResult b
446−iparse m v = runParser (m v) [] IError ISuccess
447−{-# INLINE iparse #-}
448−
449-- | Run a 'Parser' with a 'Maybe' result type.
258-- | Run a 'Parser' with a 'Maybe' result type.
450parseMaybe :: (a -> Parser b) -> a -> Maybe b
259parseMaybe :: (a -> Parser b) -> a -> Maybe b
451−parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just
260+parseMaybe m v = runParser (m v) (const Nothing) Just
452{-# INLINE parseMaybe #-}
261{-# INLINE parseMaybe #-}
453
262
454−-- | Run a 'Parser' with an 'Either' result type. If the parse fails,
263+-- | Run a 'Parser' with an 'Either' result type.
455−-- the 'Left' payload will contain an error message.
456parseEither :: (a -> Parser b) -> a -> Either String b
264parseEither :: (a -> Parser b) -> a -> Either String b
457−parseEither m v = runParser (m v) [] onError Right
265+parseEither m v = runParser (m v) Left Right
458− where onError path msg = Left (formatError path msg)
459{-# INLINE parseEither #-}
266{-# INLINE parseEither #-}
460
267
461−-- | Annotate an error message with a
462−-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.
463−formatError :: JSONPath -> String -> String
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
475− where
476− format :: String -> JSONPath -> String
477− format pfx [] = pfx
478− format pfx (Index idx:parts) = format (pfx ++ "[" ++ show idx ++ "]") parts
479− format pfx (Key key:parts) = format (pfx ++ formatKey key) parts
480−
481− formatKey :: Text -> String
482− formatKey key
483− | isIdentifierKey strKey = "." ++ strKey
484− | otherwise = "['" ++ escapeKey strKey ++ "']"
485− where strKey = unpack key
486−
487− isIdentifierKey :: String -> Bool
488− isIdentifierKey [] = False
489− isIdentifierKey (x:xs) = isAlpha x && all isAlphaNum xs
490−
491− escapeKey :: String -> String
492− escapeKey = concatMap escapeChar
493−
494− escapeChar :: Char -> String
495− escapeChar '\'' = "\\'"
496− escapeChar '\\' = "\\\\"
497− escapeChar c = [c]
498−
499-- | A key\/value pair for an 'Object'.
268-- | A key\/value pair for an 'Object'.
500type Pair = (Text, Value)
269type Pair = (Text, Value)
501
270
@@ -505,25 +274,6 @@ object :: [Pair] -> Value
505object = Object . H.fromList
274object = Object . H.fromList
506{-# INLINE object #-}
275{-# INLINE object #-}
507
276
508−-- | Add JSON Path context to a parser
509−--
510−-- When parsing a complex structure, it helps to annotate (sub)parsers
511−-- with context, so that if an error occurs, you can find its location.
512−--
513−-- > withObject "Person" $ \o ->
514−-- > Person
515−-- > <$> o .: "name" <?> Key "name"
516−-- > <*> o .: "age" <?> Key "age"
517−--
518−-- (Standard methods like '(.:)' already do this.)
519−--
520−-- With such annotations, if an error occurs, you will get a JSON Path
521−-- location of that error.
522−--
523−-- Since 0.10
524−(<?>) :: Parser a -> JSONPathElement -> Parser a
525−p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks
526−
527-- | If the inner @Parser@ failed, modify the failure message using the
277-- | If the inner @Parser@ failed, modify the failure message using the
528-- provided function. This allows you to create more descriptive error messages.
278-- provided function. This allows you to create more descriptive error messages.
529-- For example:
279-- For example:
@@ -534,40 +284,13 @@ p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks
534--
284--
535-- Since 0.6.2.0
285-- Since 0.6.2.0
536modifyFailure :: (String -> String) -> Parser a -> Parser a
286modifyFailure :: (String -> String) -> Parser a -> Parser a
537−modifyFailure f (Parser p) = Parser $ \path kf ks ->
287+modifyFailure f (Parser p) = Parser $ \kf -> p (kf . f)
538− p path (\p' m -> kf p' (f m)) ks
539−
540−-- | If the inner 'Parser' failed, prepend the given string to the failure
541−-- message.
542−--
543−-- @
544−-- 'prependFailure' s = 'modifyFailure' (s '++')
545−-- @
546−prependFailure :: String -> Parser a -> Parser a
547−prependFailure = modifyFailure . (++)
548−
549−-- | Throw a parser error with an additional path.
550−--
551−-- @since 1.2.1.0
552−parserThrowError :: JSONPath -> String -> Parser a
553−parserThrowError path' msg = Parser $ \path kf _ks ->
554− kf (reverse path ++ path') msg
555−
556−-- | A handler function to handle previous errors and return to normal execution.
557−--
558−-- @since 1.2.1.0
559−parserCatchError :: Parser a -> (JSONPath -> String -> Parser a) -> Parser a
560−parserCatchError (Parser p) handler = Parser $ \path kf ks ->
561− p path (\e msg -> runParser (handler e msg) path kf ks) ks
562
288
563--------------------------------------------------------------------------------
289--------------------------------------------------------------------------------
564-- Generic and TH encoding configuration
290-- Generic and TH encoding configuration
565--------------------------------------------------------------------------------
291--------------------------------------------------------------------------------
566
292
567-- | Options that specify how to encode\/decode your datatype to\/from JSON.
293-- | Options that specify how to encode\/decode your datatype to\/from JSON.
568−--
569−-- Options can be set using record syntax on 'defaultOptions' with the fields
570−-- below.
571data Options = Options
294data Options = Options
572 { fieldLabelModifier :: String -> String
295 { fieldLabelModifier :: String -> String
573 -- ^ Function applied to field labels.
296 -- ^ Function applied to field labels.
@@ -584,68 +307,10 @@ data Options = Options
584 -- ^ If 'True' record fields with a 'Nothing' value will be
307 -- ^ If 'True' record fields with a 'Nothing' value will be
585 -- omitted from the resulting object. If 'False' the resulting
308 -- omitted from the resulting object. If 'False' the resulting
586 -- object will include those fields mapping to @null@.
309 -- 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− -- @
620 , sumEncoding :: SumEncoding
310 , sumEncoding :: SumEncoding
621 -- ^ Specifies how to encode constructors of a sum datatype.
311 -- ^ Specifies how to encode constructors of a sum datatype.
622− , unwrapUnaryRecords :: Bool
623− -- ^ Hide the field name when a record constructor has only one
624− -- field, like a newtype.
625− , tagSingleConstructors :: Bool
626− -- ^ Encode types with a single constructor as sums,
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.
632 }
312 }
633
313
634−instance Show Options where
635− show (Options f c a o s u t r) =
636− "Options {"
637− ++ intercalate ", "
638− [ "fieldLabelModifier =~ " ++ show (f "exampleField")
639− , "constructorTagModifier =~ " ++ show (c "ExampleConstructor")
640− , "allNullaryToStringTag = " ++ show a
641− , "omitNothingFields = " ++ show o
642− , "sumEncoding = " ++ show s
643− , "unwrapUnaryRecords = " ++ show u
644− , "tagSingleConstructors = " ++ show t
645− , "rejectUnknownFields = " ++ show r
646− ]
647− ++ "}"
648−
649-- | Specifies how to encode constructors of a sum datatype.
314-- | Specifies how to encode constructors of a sum datatype.
650data SumEncoding =
315data SumEncoding =
651 TaggedObject { tagFieldName :: String
316 TaggedObject { tagFieldName :: String
@@ -660,20 +325,6 @@ data SumEncoding =
660 -- by the encoded value of that field! If the constructor is not a
325 -- by the encoded value of that field! If the constructor is not a
661 -- record the encoded constructor contents will be stored under
326 -- record the encoded constructor contents will be stored under
662 -- the 'contentsFieldName' field.
327 -- the 'contentsFieldName' field.
663− | UntaggedValue
664− -- ^ Constructor names won't be encoded. Instead only the contents of the
665− -- constructor will be encoded as if the type had a single constructor. JSON
666− -- encodings have to be disjoint for decoding to work properly.
667− --
668− -- When decoding, constructors are tried in the order of definition. If some
669− -- encodings overlap, the first one defined will succeed.
670− --
671− -- /Note:/ Nullary constructors are encoded as strings (using
672− -- 'constructorTagModifier'). Having a nullary constructor alongside a
673− -- single field constructor that encodes to a string leads to ambiguity.
674− --
675− -- /Note:/ Only the last error is kept when decoding, so in the case of
676− -- malformed JSON, only an error for the last constructor will be reported.
677 | ObjectWithSingleField
328 | ObjectWithSingleField
678 -- ^ A constructor will be encoded to an object with a single
329 -- ^ A constructor will be encoded to an object with a single
679 -- field named after the constructor tag (modified by the
330 -- field named after the constructor tag (modified by the
@@ -684,34 +335,6 @@ data SumEncoding =
684 -- first element is the tag of the constructor (modified by the
335 -- first element is the tag of the constructor (modified by the
685 -- 'constructorTagModifier') and the second element the encoded
336 -- 'constructorTagModifier') and the second element the encoded
686 -- contents of the constructor.
337 -- contents of the constructor.
687− deriving (Eq, Show)
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
338
716-- | Default encoding 'Options':
339-- | Default encoding 'Options':
717--
340--
@@ -722,9 +345,6 @@ data JSONKeyOptions = JSONKeyOptions
722-- , 'allNullaryToStringTag' = True
345-- , 'allNullaryToStringTag' = True
723-- , 'omitNothingFields' = False
346-- , 'omitNothingFields' = False
724-- , 'sumEncoding' = 'defaultTaggedObject'
347-- , 'sumEncoding' = 'defaultTaggedObject'
725−-- , 'unwrapUnaryRecords' = False
726−-- , 'tagSingleConstructors' = False
727−-- , 'rejectUnknownFields' = False
728-- }
348-- }
729-- @
349-- @
730defaultOptions :: Options
350defaultOptions :: Options
@@ -734,9 +354,6 @@ defaultOptions = Options
734 , allNullaryToStringTag = True
354 , allNullaryToStringTag = True
735 , omitNothingFields = False
355 , omitNothingFields = False
736 , sumEncoding = defaultTaggedObject
356 , sumEncoding = defaultTaggedObject
737− , unwrapUnaryRecords = False
738− , tagSingleConstructors = False
739− , rejectUnknownFields = False
740 }
357 }
741
358
742-- | Default 'TaggedObject' 'SumEncoding' options:
359-- | Default 'TaggedObject' 'SumEncoding' options:
@@ -753,16 +370,6 @@ defaultTaggedObject = TaggedObject
753 , contentsFieldName = "contents"
370 , contentsFieldName = "contents"
754 }
371 }
755
372
756−-- | Default 'JSONKeyOptions':
757−--
758−-- @
759−-- defaultJSONKeyOptions = 'JSONKeyOptions'
760−-- { 'keyModifier' = 'id'
761−-- }
762−-- @
763−defaultJSONKeyOptions :: JSONKeyOptions
764−defaultJSONKeyOptions = JSONKeyOptions id
765−
766-- | Converts from CamelCase to another lower case, interspersing
373-- | Converts from CamelCase to another lower case, interspersing
767-- the character between all capital letters and their previous
374-- the character between all capital letters and their previous
768-- entries, except those capital letters that appear together,
375-- entries, except those capital letters that appear together,
@@ -772,7 +379,6 @@ defaultJSONKeyOptions = JSONKeyOptions id
772--
379--
773-- > camelTo '_' 'CamelCaseAPI' == "camel_case_api"
380-- > camelTo '_' 'CamelCaseAPI' == "camel_case_api"
774camelTo :: Char -> String -> String
381camelTo :: Char -> String -> String
775−{-# DEPRECATED camelTo "Use camelTo2 for better results" #-}
776camelTo c = lastWasCap True
382camelTo c = lastWasCap True
777 where
383 where
778 lastWasCap :: Bool -- ^ Previous was a capital letter
384 lastWasCap :: Bool -- ^ Previous was a capital letter
@@ -784,16 +390,3 @@ camelTo c = lastWasCap True
784 then toLower x : lastWasCap True xs
390 then toLower x : lastWasCap True xs
785 else c : toLower x : lastWasCap True xs
391 else c : toLower x : lastWasCap True xs
786 else x : lastWasCap False xs
392 else x : lastWasCap False xs
787−
788−-- | Better version of 'camelTo'. Example where it works better:
789−--
790−-- > camelTo '_' 'CamelAPICase' == "camel_apicase"
791−-- > camelTo2 '_' 'CamelAPICase' == "camel_api_case"
792−camelTo2 :: Char -> String -> String
793−camelTo2 c = map toLower . go2 . go1
794− where go1 "" = ""
795− go1 (x:u:l:xs) | isUpper u && isLower l = x : c : u : l : go1 xs
796− go1 (x:xs) = x : go1 xs
797− go2 "" = ""
798− go2 (l:u:xs) | isLower l && isUpper u = l : c : u : go2 xs
799− go2 (x:xs) = x : go2 xs
Data/Aeson/Types/ToJSON.hsdeleted−2872
@@ -1,2872 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE EmptyDataDecls #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE FunctionalDependencies #-}
7−{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE NoImplicitPrelude #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PatternGuards #-}
11−{-# LANGUAGE PolyKinds #-}
12−{-# LANGUAGE RecordWildCards #-}
13−{-# LANGUAGE ScopedTypeVariables #-}
14−{-# LANGUAGE TypeOperators #-}
15−{-# LANGUAGE UndecidableInstances #-}
16−
17−#include "overlapping-compat.h"
18−#include "incoherent-compat.h"
19−
20−-- TODO: Drop this when we remove support for Data.Attoparsec.Number
21−{-# OPTIONS_GHC -fno-warn-deprecations #-}
22−
23−module Data.Aeson.Types.ToJSON
24− (
25− -- * Core JSON classes
26− ToJSON(..)
27− -- * Liftings to unary and binary type constructors
28− , ToJSON1(..)
29− , toJSON1
30− , toEncoding1
31− , ToJSON2(..)
32− , toJSON2
33− , toEncoding2
34− -- * Generic JSON classes
35− , GToJSON(..)
36− , ToArgs(..)
37− , genericToJSON
38− , genericToEncoding
39− , genericLiftToJSON
40− , genericLiftToEncoding
41− -- * Classes and types for map keys
42− , ToJSONKey(..)
43− , ToJSONKeyFunction(..)
44− , toJSONKeyText
45− , contramapToJSONKeyFunction
46−
47− , GToJSONKey()
48− , genericToJSONKey
49−
50− -- * Object key-value pairs
51− , KeyValue(..)
52− , KeyValuePair(..)
53− , FromPairs(..)
54− -- * Functions needed for documentation
55− -- * Encoding functions
56− , listEncoding
57− , listValue
58− ) where
59−
60−import Prelude.Compat
61−
62−import Control.Applicative (Const(..))
63−import Control.Monad.ST (ST)
64−import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
65−import Data.Aeson.Encoding.Internal ((>*<))
66−import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
67−import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
68−import Data.Aeson.Types.Internal
69−import Data.Attoparsec.Number (Number(..))
70−import Data.Bits (unsafeShiftR)
71−import Data.DList (DList)
72−import Data.Fixed (Fixed, HasResolution, Nano)
73−import Data.Foldable (toList)
74−import Data.Functor.Compose (Compose(..))
75−import Data.Functor.Contravariant (Contravariant (..))
76−import Data.Functor.Identity (Identity(..))
77−import Data.Functor.Product (Product(..))
78−import Data.Functor.Sum (Sum(..))
79−import Data.Int (Int16, Int32, Int64, Int8)
80−import Data.List (intersperse)
81−import Data.List.NonEmpty (NonEmpty(..))
82−import Data.Semigroup ((<>))
83−import Data.Proxy (Proxy(..))
84−import Data.Ratio (Ratio, denominator, numerator)
85−import Data.Scientific (Scientific)
86−import Data.Tagged (Tagged(..))
87−import Data.Text (Text, pack)
88−import 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 (..))
92−import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
93−import Data.Vector (Vector)
94−import Data.Version (Version, showVersion)
95−import Data.Void (Void, absurd)
96−import Data.Word (Word16, Word32, Word64, Word8)
97−import Foreign.Storable (Storable)
98−import Foreign.C.Types (CTime (..))
99−import GHC.Generics
100−import Numeric.Natural (Natural)
101−import qualified Data.Aeson.Encoding as E
102−import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
103−import qualified Data.ByteString.Lazy as L
104−import qualified Data.DList as DList
105−import qualified Data.HashMap.Strict as H
106−import qualified Data.HashSet as HashSet
107−import qualified Data.IntMap as IntMap
108−import qualified Data.IntSet as IntSet
109−import qualified Data.List.NonEmpty as NE
110−import qualified Data.Map as M
111−import qualified Data.Monoid as Monoid
112−import qualified Data.Scientific as Scientific
113−import qualified Data.Semigroup as Semigroup
114−import qualified Data.Sequence as Seq
115−import qualified Data.Set as Set
116−import qualified Data.Text as T
117−import qualified Data.Text.Encoding as T
118−import qualified Data.Text.Lazy as LT
119−import qualified Data.Tree as Tree
120−import qualified Data.UUID.Types as UUID
121−import qualified Data.Vector as V
122−import qualified Data.Vector.Generic as VG
123−import qualified Data.Vector.Mutable as VM
124−import qualified Data.Vector.Primitive as VP
125−import qualified Data.Vector.Storable as VS
126−import qualified Data.Vector.Unboxed as VU
127−
128−import qualified Data.Aeson.Encoding.Builder as EB
129−import qualified Data.ByteString.Builder as B
130−
131−import qualified GHC.Exts as Exts
132−import qualified Data.Primitive.Array as PM
133−import qualified Data.Primitive.SmallArray as PM
134−import qualified Data.Primitive.Types as PM
135−
136−#if MIN_VERSION_primitive(0,6,4)
137−#if !MIN_VERSION_primitive(0,7,0)
138−import qualified Data.Primitive.UnliftedArray as PM
139−#endif
140−import qualified Data.Primitive.PrimArray as PM
141−#endif
142−
143−toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
144−toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
145−{-# INLINE toJSONPair #-}
146−
147−realFloatToJSON :: RealFloat a => a -> Value
148−realFloatToJSON d
149− | isNaN d || isInfinite d = Null
150− | otherwise = Number $ Scientific.fromFloatDigits d
151−{-# INLINE realFloatToJSON #-}
152−
153−-------------------------------------------------------------------------------
154−-- Generics
155−-------------------------------------------------------------------------------
156−
157−-- | Class of generic representation types that can be converted to
158−-- JSON.
159−class GToJSON enc arity f where
160− -- | This method (applied to 'defaultOptions') is used as the
161− -- default generic implementation of 'toJSON'
162− -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
163− -- and 'liftToJSON' (if the @arity@ is 'One').
164− --
165− -- It also provides a generic implementation of 'toEncoding'
166− -- (with @enc ~ 'Encoding'@ and @arity ~ 'Zero'@)
167− -- and 'liftToEncoding' (if the @arity@ is 'One').
168− gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
169−
170−-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
171−-- function arguments that encode occurrences of the type parameter (for
172−-- 'ToJSON1').
173−data ToArgs res arity a where
174− NoToArgs :: ToArgs res Zero a
175− To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
176−
177−-- | A configurable generic JSON creator. This function applied to
178−-- 'defaultOptions' is used as the default for 'toJSON' when the type
179−-- is an instance of 'Generic'.
180−genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
181− => Options -> a -> Value
182−genericToJSON opts = gToJSON opts NoToArgs . from
183−
184−-- | A configurable generic JSON creator. This function applied to
185−-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
186−-- is an instance of 'Generic1'.
187−genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
188− => Options -> (a -> Value) -> ([a] -> Value)
189− -> f a -> Value
190−genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
191−
192−-- | A configurable generic JSON encoder. This function applied to
193−-- 'defaultOptions' is used as the default for 'toEncoding' when the type
194−-- is an instance of 'Generic'.
195−genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
196− => Options -> a -> Encoding
197−genericToEncoding opts = gToJSON opts NoToArgs . from
198−
199−-- | A configurable generic JSON encoder. This function applied to
200−-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
201−-- is an instance of 'Generic1'.
202−genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
203− => Options -> (a -> Encoding) -> ([a] -> Encoding)
204− -> f a -> Encoding
205−genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
206−
207−-------------------------------------------------------------------------------
208−-- Class
209−-------------------------------------------------------------------------------
210−
211−-- | A type that can be converted to JSON.
212−--
213−-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214−-- to) specify 'toEncoding'.
215−--
216−-- An example type and instance:
217−--
218−-- @
219−-- \-- Allow ourselves to write 'Text' literals.
220−-- {-\# LANGUAGE OverloadedStrings #-}
221−--
222−-- data Coord = Coord { x :: Double, y :: Double }
223−--
224−-- instance 'ToJSON' Coord where
225−-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
226−--
227−-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
228−-- @
229−--
230−-- Instead of manually writing your 'ToJSON' instance, there are two options
231−-- to do it automatically:
232−--
233−-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
234−-- instance at compile time. The generated instance is optimized for your type
235−-- so it will probably be more efficient than the following option.
236−--
237−-- * The compiler can provide a default generic implementation for
238−-- 'toJSON'.
239−--
240−-- To use the second, simply add a @deriving 'Generic'@ clause to your
241−-- datatype and declare a 'ToJSON' instance. If you require nothing other than
242−-- 'defaultOptions', it is sufficient to write (and this is the only
243−-- alternative where the default 'toJSON' implementation is sufficient):
244−--
245−-- @
246−-- {-\# LANGUAGE DeriveGeneric \#-}
247−--
248−-- import "GHC.Generics"
249−--
250−-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
251−--
252−-- instance 'ToJSON' Coord where
253−-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
254−-- @
255−--
256−-- If on the other hand you wish to customize the generic decoding, you have
257−-- to implement both methods:
258−--
259−-- @
260−-- customOptions = 'defaultOptions'
261−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
262−-- }
263−--
264−-- instance 'ToJSON' Coord where
265−-- 'toJSON' = 'genericToJSON' customOptions
266−-- 'toEncoding' = 'genericToEncoding' customOptions
267−-- @
268−--
269−-- Previous versions of this library only had the 'toJSON' method. Adding
270−-- 'toEncoding' had two reasons:
271−--
272−-- 1. toEncoding is more efficient for the common case that the output of
273−-- 'toJSON' is directly serialized to a @ByteString@.
274−-- Further, expressing either method in terms of the other would be
275−-- non-optimal.
276−--
277−-- 2. The choice of defaults allows a smooth transition for existing users:
278−-- Existing instances that do not define 'toEncoding' still
279−-- compile and have the correct semantics. This is ensured by making
280−-- the default implementation of 'toEncoding' use 'toJSON'. This produces
281−-- correct results, but since it performs an intermediate conversion to a
282−-- 'Value', it will be less efficient than directly emitting an 'Encoding'.
283−-- (this also means that specifying nothing more than
284−-- @instance ToJSON Coord@ would be sufficient as a generically decoding
285−-- instance, but there probably exists no good reason to not specify
286−-- 'toEncoding' in new instances.)
287−class ToJSON a where
288− -- | Convert a Haskell value to a JSON-friendly intermediate type.
289− toJSON :: a -> Value
290−
291− default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
292− toJSON = genericToJSON defaultOptions
293−
294− -- | Encode a Haskell value as JSON.
295− --
296− -- The default implementation of this method creates an
297− -- intermediate 'Value' using 'toJSON'. This provides
298− -- source-level compatibility for people upgrading from older
299− -- versions of this library, but obviously offers no performance
300− -- advantage.
301− --
302− -- To benefit from direct encoding, you /must/ provide an
303− -- implementation for this method. The easiest way to do so is by
304− -- having your types implement 'Generic' using the @DeriveGeneric@
305− -- extension, and then have GHC generate a method body as follows.
306− --
307− -- @
308− -- instance 'ToJSON' Coord where
309− -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
310− -- @
311−
312− toEncoding :: a -> Encoding
313− toEncoding = E.value . toJSON
314− {-# INLINE toEncoding #-}
315−
316− toJSONList :: [a] -> Value
317− toJSONList = listValue toJSON
318− {-# INLINE toJSONList #-}
319−
320− toEncodingList :: [a] -> Encoding
321− toEncodingList = listEncoding toEncoding
322− {-# INLINE toEncodingList #-}
323−
324−-------------------------------------------------------------------------------
325−-- Object key-value pairs
326−-------------------------------------------------------------------------------
327−
328−-- | A key-value pair for encoding a JSON object.
329−class KeyValue kv where
330− (.=) :: ToJSON v => Text -> v -> kv
331− infixr 8 .=
332−
333−instance KeyValue Series where
334− name .= value = E.pair name (toEncoding value)
335− {-# INLINE (.=) #-}
336−
337−instance KeyValue Pair where
338− name .= value = (name, toJSON value)
339− {-# INLINE (.=) #-}
340−
341−-- | Constructs a singleton 'H.HashMap'. For calling functions that
342−-- demand an 'Object' for constructing objects. To be used in
343−-- conjunction with 'mconcat'. Prefer to use 'object' where possible.
344−instance KeyValue Object where
345− name .= value = H.singleton name (toJSON value)
346− {-# INLINE (.=) #-}
347−
348−-------------------------------------------------------------------------------
349−-- Classes and types for map keys
350−-------------------------------------------------------------------------------
351−
352−-- | Typeclass for types that can be used as the key of a map-like container
353−-- (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
354−-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
355−-- type 'Map' 'Text' 'Char':
356−--
357−-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
358−-- {"foo":"a"}
359−--
360−-- Since 'Int' also has a 'ToJSONKey' instance, we can similarly write:
361−--
362−-- >>> LBC8.putStrLn $ encode $ Map.fromList [(5 :: Int, 'a')]
363−-- {"5":"a"}
364−--
365−-- JSON documents only accept strings as object keys. For any type
366−-- from @base@ that has a natural textual representation, it can be
367−-- expected that its 'ToJSONKey' instance will choose that representation.
368−--
369−-- For data types that lack a natural textual representation, an alternative
370−-- is provided. The map-like container is represented as a JSON array
371−-- instead of a JSON object. Each value in the array is an array with
372−-- exactly two values. The first is the key and the second is the value.
373−--
374−-- For example, values of type '[Text]' cannot be encoded to a
375−-- string, so a 'Map' with keys of type '[Text]' is encoded as follows:
376−--
377−-- >>> LBC8.putStrLn $ encode $ Map.fromList [(["foo","bar","baz" :: Text], 'a')]
378−-- [[["foo","bar","baz"],"a"]]
379−--
380−-- The default implementation of 'ToJSONKey' chooses this method of
381−-- encoding a key, using the 'ToJSON' instance of the type.
382−--
383−-- To use your own data type as the key in a map, all that is needed
384−-- is to write a 'ToJSONKey' (and possibly a 'FromJSONKey') instance
385−-- for it. If the type cannot be trivially converted to and from 'Text',
386−-- it is recommended that 'ToJSONKeyValue' is used. Since the default
387−-- implementations of the typeclass methods can build this from a
388−-- 'ToJSON' instance, there is nothing that needs to be written:
389−--
390−-- > data Foo = Foo { fooAge :: Int, fooName :: Text }
391−-- > deriving (Eq,Ord,Generic)
392−-- > instance ToJSON Foo
393−-- > instance ToJSONKey Foo
394−--
395−-- That's it. We can now write:
396−--
397−-- >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
398−-- >>> LBC8.putStrLn $ encode m
399−-- [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
400−--
401−-- The next case to consider is if we have a type that is a
402−-- newtype wrapper around 'Text'. The recommended approach is to use
403−-- generalized newtype deriving:
404−--
405−-- > newtype RecordId = RecordId { getRecordId :: Text }
406−-- > deriving (Eq,Ord,ToJSONKey)
407−--
408−-- Then we may write:
409−--
410−-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
411−-- {"abc":"a"}
412−--
413−-- Simple sum types are a final case worth considering. Suppose we have:
414−--
415−-- > data Color = Red | Green | Blue
416−-- > deriving (Show,Read,Eq,Ord)
417−--
418−-- It is possible to get the 'ToJSONKey' instance for free as we did
419−-- with 'Foo'. However, in this case, we have a natural way to go to
420−-- and from 'Text' that does not require any escape sequences. So
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−--
432−-- The 'Show' instance can be used to help write 'ToJSONKey':
433−--
434−-- > instance ToJSONKey Color where
435−-- > toJSONKey = ToJSONKeyText f g
436−-- > where f = Text.pack . show
437−-- > g = text . Text.pack . show
438−-- > -- text function is from Data.Aeson.Encoding
439−--
440−-- The situation of needing to turning function @a -> Text@ into
441−-- a 'ToJSONKeyFunction' is common enough that a special combinator
442−-- is provided for it. The above instance can be rewritten as:
443−--
444−-- > instance ToJSONKey Color where
445−-- > toJSONKey = toJSONKeyText (Text.pack . show)
446−--
447−-- The performance of the above instance can be improved by
448−-- not using 'String' as an intermediate step when converting to
449−-- 'Text'. One option for improving performance would be to use
450−-- template haskell machinery from the @text-show@ package. However,
451−-- even with the approach, the 'Encoding' (a wrapper around a bytestring
452−-- builder) is generated by encoding the 'Text' to a 'ByteString',
453−-- an intermediate step that could be avoided. The fastest possible
454−-- implementation would be:
455−--
456−-- > -- Assuming that OverloadedStrings is enabled
457−-- > instance ToJSONKey Color where
458−-- > toJSONKey = ToJSONKeyText f g
459−-- > where f x = case x of {Red -> "Red";Green ->"Green";Blue -> "Blue"}
460−-- > g x = case x of {Red -> text "Red";Green -> text "Green";Blue -> text "Blue"}
461−-- > -- text function is from Data.Aeson.Encoding
462−--
463−-- This works because GHC can lift the encoded values out of the case
464−-- statements, which means that they are only evaluated once. This
465−-- approach should only be used when there is a serious need to
466−-- maximize performance.
467−
468−class ToJSONKey a where
469− -- | Strategy for rendering the key for a map-like container.
470− toJSONKey :: ToJSONKeyFunction a
471− default toJSONKey :: ToJSON a => ToJSONKeyFunction a
472− toJSONKey = ToJSONKeyValue toJSON toEncoding
473−
474− -- | This is similar in spirit to the 'showsList' method of 'Show'.
475− -- It makes it possible to give 'String' keys special treatment
476− -- without using @OverlappingInstances@. End users should always
477− -- be able to use the default implementation of this method.
478− toJSONKeyList :: ToJSONKeyFunction [a]
479− default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
480− toJSONKeyList = ToJSONKeyValue toJSON toEncoding
481−
482−data ToJSONKeyFunction a
483− = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)
484− -- ^ key is encoded to string, produces object
485− | ToJSONKeyValue !(a -> Value) !(a -> Encoding)
486− -- ^ key is encoded to value, produces array
487−
488−-- | Helper for creating textual keys.
489−--
490−-- @
491−-- instance 'ToJSONKey' MyKey where
492−-- 'toJSONKey' = 'toJSONKeyText' myKeyToText
493−-- where
494−-- myKeyToText = Text.pack . show -- or showt from text-show
495−-- @
496−toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
497−toJSONKeyText f = ToJSONKeyText f (E.text . f)
498−
499−-- | TODO: should this be exported?
500−toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
501−toJSONKeyTextEnc e = ToJSONKeyText tot e
502− where
503− -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504− tot = T.dropAround (== '"')
505− . T.decodeLatin1
506− . L.toStrict
507− . E.encodingToLazyByteString
508− . e
509−
510−instance Contravariant ToJSONKeyFunction where
511− contramap = contramapToJSONKeyFunction
512−
513−-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
514−contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
515−contramapToJSONKeyFunction h x = case x of
516− ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
517− ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
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−
542−-------------------------------------------------------------------------------
543−-- Lifings of FromJSON and ToJSON to unary and binary type constructors
544−-------------------------------------------------------------------------------
545−
546−
547−-- | Lifting of the 'ToJSON' class to unary type constructors.
548−--
549−-- Instead of manually writing your 'ToJSON1' instance, there are two options
550−-- to do it automatically:
551−--
552−-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
553−-- instance at compile time. The generated instance is optimized for your type
554−-- so it will probably be more efficient than the following option.
555−--
556−-- * The compiler can provide a default generic implementation for
557−-- 'toJSON1'.
558−--
559−-- To use the second, simply add a @deriving 'Generic1'@ clause to your
560−-- datatype and declare a 'ToJSON1' instance for your datatype without giving
561−-- definitions for 'liftToJSON' or 'liftToEncoding'.
562−--
563−-- For example:
564−--
565−-- @
566−-- {-\# LANGUAGE DeriveGeneric \#-}
567−--
568−-- import "GHC.Generics"
569−--
570−-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
571−--
572−-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
573−-- @
574−--
575−-- If the default implementation doesn't give exactly the results you want,
576−-- you can customize the generic encoding with only a tiny amount of
577−-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
578−-- your preferred 'Options':
579−--
580−-- @
581−-- customOptions = 'defaultOptions'
582−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
583−-- }
584−--
585−-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
586−-- 'liftToJSON' = 'genericLiftToJSON' customOptions
587−-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
588−-- @
589−--
590−-- See also 'ToJSON'.
591−class ToJSON1 f where
592− liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
593−
594− default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
595− => (a -> Value) -> ([a] -> Value) -> f a -> Value
596− liftToJSON = genericLiftToJSON defaultOptions
597−
598− liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value
599− liftToJSONList f g = listValue (liftToJSON f g)
600−
601− liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
602−
603− default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
604− => (a -> Encoding) -> ([a] -> Encoding)
605− -> f a -> Encoding
606− liftToEncoding = genericLiftToEncoding defaultOptions
607−
608− liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
609− liftToEncodingList f g = listEncoding (liftToEncoding f g)
610−
611−-- | Lift the standard 'toJSON' function through the type constructor.
612−toJSON1 :: (ToJSON1 f, ToJSON a) => f a -> Value
613−toJSON1 = liftToJSON toJSON toJSONList
614−{-# INLINE toJSON1 #-}
615−
616−-- | Lift the standard 'toEncoding' function through the type constructor.
617−toEncoding1 :: (ToJSON1 f, ToJSON a) => f a -> Encoding
618−toEncoding1 = liftToEncoding toEncoding toEncodingList
619−{-# INLINE toEncoding1 #-}
620−
621−-- | Lifting of the 'ToJSON' class to binary type constructors.
622−--
623−-- Instead of manually writing your 'ToJSON2' instance, "Data.Aeson.TH"
624−-- provides Template Haskell functions which will derive an instance at compile time.
625−--
626−-- The compiler cannot provide a default generic implementation for 'liftToJSON2',
627−-- unlike 'toJSON' and 'liftToJSON'.
628−class ToJSON2 f where
629− liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> f a b -> Value
630− liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [f a b] -> Value
631− liftToJSONList2 fa ga fb gb = listValue (liftToJSON2 fa ga fb gb)
632−
633− liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> f a b -> Encoding
634− liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [f a b] -> Encoding
635− liftToEncodingList2 fa ga fb gb = listEncoding (liftToEncoding2 fa ga fb gb)
636−
637−-- | Lift the standard 'toJSON' function through the type constructor.
638−toJSON2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Value
639−toJSON2 = liftToJSON2 toJSON toJSONList toJSON toJSONList
640−{-# INLINE toJSON2 #-}
641−
642−-- | Lift the standard 'toEncoding' function through the type constructor.
643−toEncoding2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Encoding
644−toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingList
645−{-# INLINE toEncoding2 #-}
646−
647−-------------------------------------------------------------------------------
648−-- Encoding functions
649−-------------------------------------------------------------------------------
650−
651−-- | Helper function to use with 'liftToEncoding'.
652−-- Useful when writing own 'ToJSON1' instances.
653−--
654−-- @
655−-- newtype F a = F [a]
656−--
657−-- -- This instance encodes 'String' as an array of chars
658−-- instance 'ToJSON1' F where
659−-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
660−-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
661−--
662−-- instance 'Data.Aeson.FromJSON.FromJSON1' F where
663−-- 'Data.Aeson.FromJSON.liftParseJSON' p _ v = F \<$\> 'Data.Aeson.FromJSON.liftParseJSON' p ('Data.Aeson.FromJSON.listParser' p) v
664−-- @
665−listEncoding :: (a -> Encoding) -> [a] -> Encoding
666−listEncoding = E.list
667−{-# INLINE listEncoding #-}
668−
669−-- | Helper function to use with 'liftToJSON', see 'listEncoding'.
670−listValue :: (a -> Value) -> [a] -> Value
671−listValue f = Array . V.fromList . map f
672−{-# INLINE listValue #-}
673−
674−-------------------------------------------------------------------------------
675−-- [] instances
676−-------------------------------------------------------------------------------
677−
678−-- These are needed for key-class default definitions
679−
680−instance ToJSON1 [] where
681− liftToJSON _ to' = to'
682− {-# INLINE liftToJSON #-}
683−
684− liftToEncoding _ to' = to'
685− {-# INLINE liftToEncoding #-}
686−
687−instance (ToJSON a) => ToJSON [a] where
688− {-# SPECIALIZE instance ToJSON String #-}
689− {-# SPECIALIZE instance ToJSON [String] #-}
690− {-# SPECIALIZE instance ToJSON [Array] #-}
691− {-# SPECIALIZE instance ToJSON [Object] #-}
692−
693− toJSON = toJSON1
694− {-# INLINE toJSON #-}
695−
696− toEncoding = toEncoding1
697− {-# INLINE toEncoding #-}
698−
699−-------------------------------------------------------------------------------
700−-- Generic toJSON / toEncoding
701−-------------------------------------------------------------------------------
702−
703−instance OVERLAPPABLE_ (GToJSON enc arity a) => GToJSON enc arity (M1 i c a) where
704− -- Meta-information, which is not handled elsewhere, is ignored:
705− gToJSON opts targs = gToJSON opts targs . unM1
706− {-# INLINE gToJSON #-}
707−
708−instance GToJSON enc One Par1 where
709− -- Direct occurrences of the last type parameter are encoded with the
710− -- function passed in as an argument:
711− gToJSON _opts (To1Args tj _) = tj . unPar1
712− {-# INLINE gToJSON #-}
713−
714−instance ( ConsToJSON enc arity a
715− , AllNullary (C1 c a) allNullary
716− , SumToJSON enc arity (C1 c a) allNullary
717− ) => GToJSON enc arity (D1 d (C1 c a)) where
718− -- The option 'tagSingleConstructors' determines whether to wrap
719− -- a single-constructor type.
720− gToJSON opts targs
721− | tagSingleConstructors opts = (unTagged :: Tagged allNullary enc -> enc)
722− . sumToJSON opts targs
723− . unM1
724− | otherwise = consToJSON opts targs . unM1 . unM1
725− {-# INLINE gToJSON #-}
726−
727−instance (ConsToJSON enc arity a) => GToJSON enc arity (C1 c a) where
728− -- Constructors need to be encoded differently depending on whether they're
729− -- a record or not. This distinction is made by 'consToJSON':
730− gToJSON opts targs = consToJSON opts targs . unM1
731− {-# INLINE gToJSON #-}
732−
733−instance ( AllNullary (a :+: b) allNullary
734− , SumToJSON enc arity (a :+: b) allNullary
735− ) => GToJSON enc arity (a :+: b)
736− where
737− -- If all constructors of a sum datatype are nullary and the
738− -- 'allNullaryToStringTag' option is set they are encoded to
739− -- strings. This distinction is made by 'sumToJSON':
740− gToJSON opts targs = (unTagged :: Tagged allNullary enc -> enc)
741− . sumToJSON opts targs
742− {-# INLINE gToJSON #-}
743−
744−--------------------------------------------------------------------------------
745−-- Generic toJSON
746−
747−-- Note: Refactoring 'ToJSON a' to 'ToJSON enc a' (and 'ToJSON1' similarly) is
748−-- possible but makes error messages a bit harder to understand for missing
749−-- instances.
750−
751−instance GToJSON Value arity V1 where
752− -- Empty values do not exist, which makes the job of formatting them
753− -- rather easy:
754− gToJSON _ _ x = x `seq` error "case: V1"
755− {-# INLINE gToJSON #-}
756−
757−instance ToJSON a => GToJSON Value arity (K1 i a) where
758− -- Constant values are encoded using their ToJSON instance:
759− gToJSON _opts _ = toJSON . unK1
760− {-# INLINE gToJSON #-}
761−
762−instance ToJSON1 f => GToJSON Value One (Rec1 f) where
763− -- Recursive occurrences of the last type parameter are encoded using their
764− -- ToJSON1 instance:
765− gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766− {-# INLINE gToJSON #-}
767−
768−instance GToJSON Value arity U1 where
769− -- Empty constructors are encoded to an empty array:
770− gToJSON _opts _ _ = emptyArray
771− {-# INLINE gToJSON #-}
772−
773−instance ( WriteProduct arity a, WriteProduct arity b
774− , ProductSize a, ProductSize b
775− ) => GToJSON Value arity (a :*: b)
776− where
777− -- Products are encoded to an array. Here we allocate a mutable vector of
778− -- the same size as the product and write the product's elements to it using
779− -- 'writeProduct':
780− gToJSON opts targs p =
781− Array $ V.create $ do
782− mv <- VM.unsafeNew lenProduct
783− writeProduct opts targs mv 0 lenProduct p
784− return mv
785− where
786− lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
787− productSize
788− {-# INLINE gToJSON #-}
789−
790−instance ( ToJSON1 f
791− , GToJSON Value One g
792− ) => GToJSON Value One (f :.: g)
793− where
794− -- If an occurrence of the last type parameter is nested inside two
795− -- composed types, it is encoded by using the outermost type's ToJSON1
796− -- instance to generically encode the innermost type:
797− gToJSON opts targs =
798− let gtj = gToJSON opts targs in
799− liftToJSON gtj (listValue gtj) . unComp1
800− {-# INLINE gToJSON #-}
801−
802−--------------------------------------------------------------------------------
803−-- Generic toEncoding
804−
805−instance ToJSON a => GToJSON Encoding arity (K1 i a) where
806− -- Constant values are encoded using their ToJSON instance:
807− gToJSON _opts _ = toEncoding . unK1
808− {-# INLINE gToJSON #-}
809−
810−instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
811− -- Recursive occurrences of the last type parameter are encoded using their
812− -- ToEncoding1 instance:
813− gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814− {-# INLINE gToJSON #-}
815−
816−instance GToJSON Encoding arity U1 where
817− -- Empty constructors are encoded to an empty array:
818− gToJSON _opts _ _ = E.emptyArray_
819− {-# INLINE gToJSON #-}
820−
821−instance ( EncodeProduct arity a
822− , EncodeProduct arity b
823− ) => GToJSON Encoding arity (a :*: b)
824− where
825− -- Products are encoded to an array. Here we allocate a mutable vector of
826− -- the same size as the product and write the product's elements to it using
827− -- 'encodeProduct':
828− gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829− {-# INLINE gToJSON #-}
830−
831−instance ( ToJSON1 f
832− , GToJSON Encoding One g
833− ) => GToJSON Encoding One (f :.: g)
834− where
835− -- If an occurrence of the last type parameter is nested inside two
836− -- composed types, it is encoded by using the outermost type's ToJSON1
837− -- instance to generically encode the innermost type:
838− gToJSON opts targs =
839− let gte = gToJSON opts targs in
840− liftToEncoding gte (listEncoding gte) . unComp1
841− {-# INLINE gToJSON #-}
842−
843−--------------------------------------------------------------------------------
844−
845−class SumToJSON enc arity f allNullary where
846− sumToJSON :: Options -> ToArgs enc arity a
847− -> f a -> Tagged allNullary enc
848−
849−instance ( GetConName f
850− , FromString enc
851− , TaggedObject enc arity f
852− , SumToJSON' ObjectWithSingleField enc arity f
853− , SumToJSON' TwoElemArray enc arity f
854− , SumToJSON' UntaggedValue enc arity f
855− ) => SumToJSON enc arity f True
856− where
857− sumToJSON opts targs
858− | allNullaryToStringTag opts = Tagged . fromString
859− . constructorTagModifier opts . getConName
860− | otherwise = Tagged . nonAllNullarySumToJSON opts targs
861−
862−instance ( TaggedObject enc arity f
863− , SumToJSON' ObjectWithSingleField enc arity f
864− , SumToJSON' TwoElemArray enc arity f
865− , SumToJSON' UntaggedValue enc arity f
866− ) => SumToJSON enc arity f False
867− where
868− sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
869−
870−nonAllNullarySumToJSON :: ( TaggedObject enc arity f
871− , SumToJSON' ObjectWithSingleField enc arity f
872− , SumToJSON' TwoElemArray enc arity f
873− , SumToJSON' UntaggedValue enc arity f
874− ) => Options -> ToArgs enc arity a
875− -> f a -> enc
876−nonAllNullarySumToJSON opts targs =
877− case sumEncoding opts of
878−
879− TaggedObject{..} ->
880− taggedObject opts targs tagFieldName contentsFieldName
881−
882− ObjectWithSingleField ->
883− (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884− . sumToJSON' opts targs
885−
886− TwoElemArray ->
887− (unTagged :: Tagged TwoElemArray enc -> enc)
888− . sumToJSON' opts targs
889−
890− UntaggedValue ->
891− (unTagged :: Tagged UntaggedValue enc -> enc)
892− . sumToJSON' opts targs
893−
894−--------------------------------------------------------------------------------
895−
896−class FromString enc where
897− fromString :: String -> enc
898−
899−instance FromString Encoding where
900− fromString = toEncoding
901−
902−instance FromString Value where
903− fromString = String . pack
904−
905−--------------------------------------------------------------------------------
906−
907−class TaggedObject enc arity f where
908− taggedObject :: Options -> ToArgs enc arity a
909− -> String -> String
910− -> f a -> enc
911−
912−instance ( TaggedObject enc arity a
913− , TaggedObject enc arity b
914− ) => TaggedObject enc arity (a :+: b)
915− where
916− taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
917− taggedObject opts targs tagFieldName contentsFieldName x
918− taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
919− taggedObject opts targs tagFieldName contentsFieldName x
920−
921−instance ( IsRecord a isRecord
922− , TaggedObject' enc pairs arity a isRecord
923− , FromPairs enc pairs
924− , FromString enc
925− , KeyValuePair enc pairs
926− , Constructor c
927− ) => TaggedObject enc arity (C1 c a)
928− where
929− taggedObject opts targs tagFieldName contentsFieldName =
930− fromPairs . mappend tag . contents
931− where
932− tag = tagFieldName `pair`
933− (fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
934− :: enc)
935− contents =
936− (unTagged :: Tagged isRecord pairs -> pairs) .
937− taggedObject' opts targs contentsFieldName . unM1
938−
939−class TaggedObject' enc pairs arity f isRecord where
940− taggedObject' :: Options -> ToArgs enc arity a
941− -> String -> f a -> Tagged isRecord pairs
942−
943−instance ( GToJSON enc arity f
944− , KeyValuePair enc pairs
945− ) => TaggedObject' enc pairs arity f False
946− where
947− taggedObject' opts targs contentsFieldName =
948− Tagged . (contentsFieldName `pair`) . gToJSON opts targs
949−
950−instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
951− taggedObject' _ _ _ _ = Tagged mempty
952−
953−instance ( RecordToPairs enc pairs arity f
954− ) => TaggedObject' enc pairs arity f True
955− where
956− taggedObject' opts targs _ = Tagged . recordToPairs opts targs
957−
958−--------------------------------------------------------------------------------
959−
960−-- | Get the name of the constructor of a sum datatype.
961−class GetConName f where
962− getConName :: f a -> String
963−
964−instance (GetConName a, GetConName b) => GetConName (a :+: b) where
965− getConName (L1 x) = getConName x
966− getConName (R1 x) = getConName x
967−
968−instance (Constructor c) => GetConName (C1 c a) where
969− getConName = conName
970−
971−-- For genericToJSONKey
972−instance GetConName a => GetConName (D1 d a) where
973− getConName (M1 x) = getConName x
974−
975−--------------------------------------------------------------------------------
976−
977−-- Reflection of SumEncoding variants
978−
979−data ObjectWithSingleField
980−data TwoElemArray
981−data UntaggedValue
982−
983−--------------------------------------------------------------------------------
984−
985−class SumToJSON' s enc arity f where
986− sumToJSON' :: Options -> ToArgs enc arity a
987− -> f a -> Tagged s enc
988−
989−instance ( SumToJSON' s enc arity a
990− , SumToJSON' s enc arity b
991− ) => SumToJSON' s enc arity (a :+: b)
992− where
993− sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
994− sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
995−
996−--------------------------------------------------------------------------------
997−
998−instance ( GToJSON Value arity a
999− , ConsToJSON Value arity a
1000− , Constructor c
1001− ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
1002− sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
1003− mv <- VM.unsafeNew 2
1004− VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1005− $ conName (undefined :: t c a p)
1006− VM.unsafeWrite mv 1 $ gToJSON opts targs x
1007− return mv
1008−
1009−--------------------------------------------------------------------------------
1010−
1011−instance ( GToJSON Encoding arity a
1012− , ConsToJSON Encoding arity a
1013− , Constructor c
1014− ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
1015− where
1016− sumToJSON' opts targs x = Tagged $ E.list id
1017− [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
1018− , gToJSON opts targs x
1019− ]
1020−
1021−--------------------------------------------------------------------------------
1022−
1023−class ConsToJSON enc arity f where
1024− consToJSON :: Options -> ToArgs enc arity a
1025− -> f a -> enc
1026−
1027−class ConsToJSON' enc arity f isRecord where
1028− consToJSON' :: Options -> ToArgs enc arity a
1029− -> f a -> Tagged isRecord enc
1030−
1031−instance ( IsRecord f isRecord
1032− , ConsToJSON' enc arity f isRecord
1033− ) => ConsToJSON enc arity f
1034− where
1035− consToJSON opts targs =
1036− (unTagged :: Tagged isRecord enc -> enc)
1037− . consToJSON' opts targs
1038− {-# INLINE consToJSON #-}
1039−
1040−instance OVERLAPPING_
1041− ( RecordToPairs enc pairs arity (S1 s f)
1042− , FromPairs enc pairs
1043− , GToJSON enc arity f
1044− ) => ConsToJSON' enc arity (S1 s f) True
1045− where
1046− consToJSON' opts targs
1047− | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
1048− | otherwise = Tagged . fromPairs . recordToPairs opts targs
1049− {-# INLINE consToJSON' #-}
1050−
1051−instance ( RecordToPairs enc pairs arity f
1052− , FromPairs enc pairs
1053− ) => ConsToJSON' enc arity f True
1054− where
1055− consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
1056− {-# INLINE consToJSON' #-}
1057−
1058−instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059− consToJSON' opts targs = Tagged . gToJSON opts targs
1060− {-# INLINE consToJSON' #-}
1061−
1062−--------------------------------------------------------------------------------
1063−
1064−class RecordToPairs enc pairs arity f where
1065− -- 1st element: whole thing
1066− -- 2nd element: in case the record has only 1 field, just the value
1067− -- of the field (without the key); 'Nothing' otherwise
1068− recordToPairs :: Options -> ToArgs enc arity a
1069− -> f a -> pairs
1070−
1071−instance ( Monoid pairs
1072− , RecordToPairs enc pairs arity a
1073− , RecordToPairs enc pairs arity b
1074− ) => RecordToPairs enc pairs arity (a :*: b)
1075− where
1076− recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
1077− pairsOf a `mappend` pairsOf b
1078− where
1079− pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
1080− pairsOf = recordToPairs opts targs
1081− {-# INLINE recordToPairs #-}
1082−
1083−instance ( Selector s
1084− , GToJSON enc arity a
1085− , KeyValuePair enc pairs
1086− ) => RecordToPairs enc pairs arity (S1 s a)
1087− where
1088− recordToPairs = fieldToPair
1089− {-# INLINE recordToPairs #-}
1090−
1091−instance INCOHERENT_
1092− ( Selector s
1093− , GToJSON enc arity (K1 i (Maybe a))
1094− , KeyValuePair enc pairs
1095− , Monoid pairs
1096− ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
1097− where
1098− recordToPairs opts _ (M1 k1) | omitNothingFields opts
1099− , K1 Nothing <- k1 = mempty
1100− recordToPairs opts targs m1 = fieldToPair opts targs m1
1101− {-# INLINE recordToPairs #-}
1102−
1103−instance INCOHERENT_
1104− ( Selector s
1105− , GToJSON enc arity (K1 i (Maybe a))
1106− , KeyValuePair enc pairs
1107− , Monoid pairs
1108− ) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a)))
1109− where
1110− recordToPairs opts targs = recordToPairs opts targs . unwrap
1111− where
1112− unwrap :: S1 s (K1 i (Semigroup.Option a)) p -> S1 s (K1 i (Maybe a)) p
1113− unwrap (M1 (K1 (Semigroup.Option a))) = M1 (K1 a)
1114− {-# INLINE recordToPairs #-}
1115−
1116−fieldToPair :: (Selector s
1117− , GToJSON enc arity a
1118− , KeyValuePair enc pairs)
1119− => Options -> ToArgs enc arity p
1120− -> S1 s a p -> pairs
1121−fieldToPair opts targs m1 =
1122− let key = fieldLabelModifier opts (selName m1)
1123− value = gToJSON opts targs (unM1 m1)
1124− in key `pair` value
1125−{-# INLINE fieldToPair #-}
1126−
1127−--------------------------------------------------------------------------------
1128−
1129−class WriteProduct arity f where
1130− writeProduct :: Options
1131− -> ToArgs Value arity a
1132− -> VM.MVector s Value
1133− -> Int -- ^ index
1134− -> Int -- ^ length
1135− -> f a
1136− -> ST s ()
1137−
1138−instance ( WriteProduct arity a
1139− , WriteProduct arity b
1140− ) => WriteProduct arity (a :*: b) where
1141− writeProduct opts targs mv ix len (a :*: b) = do
1142− writeProduct opts targs mv ix lenL a
1143− writeProduct opts targs mv ixR lenR b
1144− where
1145− lenL = len `unsafeShiftR` 1
1146− lenR = len - lenL
1147− ixR = ix + lenL
1148− {-# INLINE writeProduct #-}
1149−
1150−instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1151− writeProduct opts targs mv ix _ =
1152− VM.unsafeWrite mv ix . gToJSON opts targs
1153− {-# INLINE writeProduct #-}
1154−
1155−--------------------------------------------------------------------------------
1156−
1157−class EncodeProduct arity f where
1158− encodeProduct :: Options -> ToArgs Encoding arity a
1159− -> f a -> Encoding' E.InArray
1160−
1161−instance ( EncodeProduct arity a
1162− , EncodeProduct arity b
1163− ) => EncodeProduct arity (a :*: b) where
1164− encodeProduct opts targs (a :*: b) | omitNothingFields opts =
1165− E.econcat $ intersperse E.comma $
1166− filter (not . E.nullEncoding)
1167− [encodeProduct opts targs a, encodeProduct opts targs b]
1168− encodeProduct opts targs (a :*: b) =
1169− encodeProduct opts targs a >*<
1170− encodeProduct opts targs b
1171− {-# INLINE encodeProduct #-}
1172−
1173−instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
1174− encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
1175− {-# INLINE encodeProduct #-}
1176−
1177−--------------------------------------------------------------------------------
1178−
1179−instance ( GToJSON enc arity a
1180− , ConsToJSON enc arity a
1181− , FromPairs enc pairs
1182− , KeyValuePair enc pairs
1183− , Constructor c
1184− ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1185− where
1186− sumToJSON' opts targs =
1187− Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1188− where
1189− typ = constructorTagModifier opts $
1190− conName (undefined :: t c a p)
1191−
1192−--------------------------------------------------------------------------------
1193−
1194−instance OVERLAPPABLE_
1195− ( ConsToJSON enc arity a
1196− ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1197− where
1198− sumToJSON' opts targs = Tagged . gToJSON opts targs
1199−
1200−instance OVERLAPPING_
1201− ( Constructor c
1202− , FromString enc
1203− ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1204− where
1205− sumToJSON' opts _ _ = Tagged . fromString $
1206− constructorTagModifier opts $ conName (undefined :: t c U1 p)
1207−
1208−-------------------------------------------------------------------------------
1209−-- Instances
1210−-------------------------------------------------------------------------------
1211−
1212−-------------------------------------------------------------------------------
1213−-- base
1214−-------------------------------------------------------------------------------
1215−
1216−instance ToJSON2 Const where
1217− liftToJSON2 t _ _ _ (Const x) = t x
1218− {-# INLINE liftToJSON2 #-}
1219−
1220− liftToEncoding2 t _ _ _ (Const x) = t x
1221− {-# INLINE liftToEncoding2 #-}
1222−
1223−instance ToJSON a => ToJSON1 (Const a) where
1224− liftToJSON _ _ (Const x) = toJSON x
1225− {-# INLINE liftToJSON #-}
1226−
1227− liftToEncoding _ _ (Const x) = toEncoding x
1228− {-# INLINE liftToEncoding #-}
1229−
1230−instance ToJSON a => ToJSON (Const a b) where
1231− toJSON (Const x) = toJSON x
1232− {-# INLINE toJSON #-}
1233−
1234− toEncoding (Const x) = toEncoding x
1235− {-# INLINE toEncoding #-}
1236−
1237−
1238−instance ToJSON1 Maybe where
1239− liftToJSON t _ (Just a) = t a
1240− liftToJSON _ _ Nothing = Null
1241− {-# INLINE liftToJSON #-}
1242−
1243− liftToEncoding t _ (Just a) = t a
1244− liftToEncoding _ _ Nothing = E.null_
1245− {-# INLINE liftToEncoding #-}
1246−
1247−instance (ToJSON a) => ToJSON (Maybe a) where
1248− toJSON = toJSON1
1249− {-# INLINE toJSON #-}
1250−
1251− toEncoding = toEncoding1
1252− {-# INLINE toEncoding #-}
1253−
1254−
1255−instance ToJSON2 Either where
1256− liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton "Left" (toA a)
1257− liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton "Right" (toB b)
1258− {-# INLINE liftToJSON2 #-}
1259−
1260− liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a
1261−
1262− liftToEncoding2 _toA _ toB _ (Right b) = E.pairs $ E.pair "Right" $ toB b
1263− {-# INLINE liftToEncoding2 #-}
1264−
1265−instance (ToJSON a) => ToJSON1 (Either a) where
1266− liftToJSON = liftToJSON2 toJSON toJSONList
1267− {-# INLINE liftToJSON #-}
1268−
1269− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
1270− {-# INLINE liftToEncoding #-}
1271−
1272−instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
1273− toJSON = toJSON2
1274− {-# INLINE toJSON #-}
1275−
1276− toEncoding = toEncoding2
1277− {-# INLINE toEncoding #-}
1278−
1279−instance ToJSON Void where
1280− toJSON = absurd
1281− {-# INLINE toJSON #-}
1282−
1283− toEncoding = absurd
1284− {-# INLINE toEncoding #-}
1285−
1286−
1287−instance ToJSON Bool where
1288− toJSON = Bool
1289− {-# INLINE toJSON #-}
1290−
1291− toEncoding = E.bool
1292− {-# INLINE toEncoding #-}
1293−
1294−instance ToJSONKey Bool where
1295− toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
1296−
1297−
1298−instance ToJSON Ordering where
1299− toJSON = toJSON . orderingToText
1300− toEncoding = toEncoding . orderingToText
1301−
1302−orderingToText :: Ordering -> T.Text
1303−orderingToText o = case o of
1304− LT -> "LT"
1305− EQ -> "EQ"
1306− GT -> "GT"
1307−
1308−instance ToJSON () where
1309− toJSON _ = emptyArray
1310− {-# INLINE toJSON #-}
1311−
1312− toEncoding _ = emptyArray_
1313− {-# INLINE toEncoding #-}
1314−
1315−
1316−instance ToJSON Char where
1317− toJSON = String . T.singleton
1318− {-# INLINE toJSON #-}
1319−
1320− toJSONList = String . T.pack
1321− {-# INLINE toJSONList #-}
1322−
1323− toEncoding = E.string . (:[])
1324− {-# INLINE toEncoding #-}
1325−
1326− toEncodingList = E.string
1327− {-# INLINE toEncodingList #-}
1328−
1329−
1330−instance ToJSON Double where
1331− toJSON = realFloatToJSON
1332− {-# INLINE toJSON #-}
1333−
1334− toEncoding = E.double
1335− {-# INLINE toEncoding #-}
1336−
1337−instance ToJSONKey Double where
1338− toJSONKey = toJSONKeyTextEnc E.doubleText
1339− {-# INLINE toJSONKey #-}
1340−
1341−
1342−instance ToJSON Number where
1343− toJSON (D d) = toJSON d
1344− toJSON (I i) = toJSON i
1345− {-# INLINE toJSON #-}
1346−
1347− toEncoding (D d) = toEncoding d
1348− toEncoding (I i) = toEncoding i
1349− {-# INLINE toEncoding #-}
1350−
1351−
1352−instance ToJSON Float where
1353− toJSON = realFloatToJSON
1354− {-# INLINE toJSON #-}
1355−
1356− toEncoding = E.float
1357− {-# INLINE toEncoding #-}
1358−
1359−instance ToJSONKey Float where
1360− toJSONKey = toJSONKeyTextEnc E.floatText
1361− {-# INLINE toJSONKey #-}
1362−
1363−
1364−instance (ToJSON a, Integral a) => ToJSON (Ratio a) where
1365− toJSON r = object [ "numerator" .= numerator r
1366− , "denominator" .= denominator r
1367− ]
1368− {-# INLINE toJSON #-}
1369−
1370− toEncoding r = E.pairs $
1371− "numerator" .= numerator r <>
1372− "denominator" .= denominator r
1373− {-# INLINE toEncoding #-}
1374−
1375−
1376−instance HasResolution a => ToJSON (Fixed a) where
1377− toJSON = Number . realToFrac
1378− {-# INLINE toJSON #-}
1379−
1380− toEncoding = E.scientific . realToFrac
1381− {-# INLINE toEncoding #-}
1382−
1383−instance HasResolution a => ToJSONKey (Fixed a) where
1384− toJSONKey = toJSONKeyTextEnc (E.scientificText . realToFrac)
1385− {-# INLINE toJSONKey #-}
1386−
1387−
1388−instance ToJSON Int where
1389− toJSON = Number . fromIntegral
1390− {-# INLINE toJSON #-}
1391−
1392− toEncoding = E.int
1393− {-# INLINE toEncoding #-}
1394−
1395−instance ToJSONKey Int where
1396− toJSONKey = toJSONKeyTextEnc E.intText
1397− {-# INLINE toJSONKey #-}
1398−
1399−
1400−instance ToJSON Integer where
1401− toJSON = Number . fromInteger
1402− {-# INLINE toJSON #-}
1403−
1404− toEncoding = E.integer
1405− {-# INLINE toEncoding #-}
1406−
1407−instance ToJSONKey Integer where
1408− toJSONKey = toJSONKeyTextEnc E.integerText
1409− {-# INLINE toJSONKey #-}
1410−
1411−
1412−instance ToJSON Natural where
1413− toJSON = toJSON . toInteger
1414− {-# INLINE toJSON #-}
1415−
1416− toEncoding = toEncoding . toInteger
1417− {-# INLINE toEncoding #-}
1418−
1419−instance ToJSONKey Natural where
1420− toJSONKey = toJSONKeyTextEnc (E.integerText . toInteger)
1421− {-# INLINE toJSONKey #-}
1422−
1423−
1424−instance ToJSON Int8 where
1425− toJSON = Number . fromIntegral
1426− {-# INLINE toJSON #-}
1427−
1428− toEncoding = E.int8
1429− {-# INLINE toEncoding #-}
1430−
1431−instance ToJSONKey Int8 where
1432− toJSONKey = toJSONKeyTextEnc E.int8Text
1433− {-# INLINE toJSONKey #-}
1434−
1435−
1436−instance ToJSON Int16 where
1437− toJSON = Number . fromIntegral
1438− {-# INLINE toJSON #-}
1439−
1440− toEncoding = E.int16
1441− {-# INLINE toEncoding #-}
1442−
1443−instance ToJSONKey Int16 where
1444− toJSONKey = toJSONKeyTextEnc E.int16Text
1445− {-# INLINE toJSONKey #-}
1446−
1447−
1448−instance ToJSON Int32 where
1449− toJSON = Number . fromIntegral
1450− {-# INLINE toJSON #-}
1451−
1452− toEncoding = E.int32
1453− {-# INLINE toEncoding #-}
1454−
1455−instance ToJSONKey Int32 where
1456− toJSONKey = toJSONKeyTextEnc E.int32Text
1457− {-# INLINE toJSONKey #-}
1458−
1459−
1460−instance ToJSON Int64 where
1461− toJSON = Number . fromIntegral
1462− {-# INLINE toJSON #-}
1463−
1464− toEncoding = E.int64
1465− {-# INLINE toEncoding #-}
1466−
1467−instance ToJSONKey Int64 where
1468− toJSONKey = toJSONKeyTextEnc E.int64Text
1469− {-# INLINE toJSONKey #-}
1470−
1471−instance ToJSON Word where
1472− toJSON = Number . fromIntegral
1473− {-# INLINE toJSON #-}
1474−
1475− toEncoding = E.word
1476− {-# INLINE toEncoding #-}
1477−
1478−instance ToJSONKey Word where
1479− toJSONKey = toJSONKeyTextEnc E.wordText
1480− {-# INLINE toJSONKey #-}
1481−
1482−
1483−instance ToJSON Word8 where
1484− toJSON = Number . fromIntegral
1485− {-# INLINE toJSON #-}
1486−
1487− toEncoding = E.word8
1488− {-# INLINE toEncoding #-}
1489−
1490−instance ToJSONKey Word8 where
1491− toJSONKey = toJSONKeyTextEnc E.word8Text
1492− {-# INLINE toJSONKey #-}
1493−
1494−
1495−instance ToJSON Word16 where
1496− toJSON = Number . fromIntegral
1497− {-# INLINE toJSON #-}
1498−
1499− toEncoding = E.word16
1500− {-# INLINE toEncoding #-}
1501−
1502−instance ToJSONKey Word16 where
1503− toJSONKey = toJSONKeyTextEnc E.word16Text
1504− {-# INLINE toJSONKey #-}
1505−
1506−
1507−instance ToJSON Word32 where
1508− toJSON = Number . fromIntegral
1509− {-# INLINE toJSON #-}
1510−
1511− toEncoding = E.word32
1512− {-# INLINE toEncoding #-}
1513−
1514−instance ToJSONKey Word32 where
1515− toJSONKey = toJSONKeyTextEnc E.word32Text
1516− {-# INLINE toJSONKey #-}
1517−
1518−
1519−instance ToJSON Word64 where
1520− toJSON = Number . fromIntegral
1521− {-# INLINE toJSON #-}
1522−
1523− toEncoding = E.word64
1524− {-# INLINE toEncoding #-}
1525−
1526−instance ToJSONKey Word64 where
1527− toJSONKey = toJSONKeyTextEnc E.word64Text
1528− {-# INLINE toJSONKey #-}
1529−
1530−instance ToJSON CTime where
1531− toJSON (CTime i) = toJSON i
1532− {-# INLINE toJSON #-}
1533−
1534− toEncoding (CTime i) = toEncoding i
1535− {-# INLINE toEncoding #-}
1536−
1537−instance ToJSON Text where
1538− toJSON = String
1539− {-# INLINE toJSON #-}
1540−
1541− toEncoding = E.text
1542− {-# INLINE toEncoding #-}
1543−
1544−instance ToJSONKey Text where
1545− toJSONKey = toJSONKeyText id
1546− {-# INLINE toJSONKey #-}
1547−
1548−
1549−instance ToJSON LT.Text where
1550− toJSON = String . LT.toStrict
1551− {-# INLINE toJSON #-}
1552−
1553− toEncoding = E.lazyText
1554− {-# INLINE toEncoding #-}
1555−
1556−instance ToJSONKey LT.Text where
1557− toJSONKey = toJSONKeyText LT.toStrict
1558−
1559−
1560−instance ToJSON Version where
1561− toJSON = toJSON . showVersion
1562− {-# INLINE toJSON #-}
1563−
1564− toEncoding = toEncoding . showVersion
1565− {-# INLINE toEncoding #-}
1566−
1567−instance ToJSONKey Version where
1568− toJSONKey = toJSONKeyText (T.pack . showVersion)
1569−
1570−-------------------------------------------------------------------------------
1571−-- semigroups NonEmpty
1572−-------------------------------------------------------------------------------
1573−
1574−instance ToJSON1 NonEmpty where
1575− liftToJSON t _ = listValue t . NE.toList
1576− {-# INLINE liftToJSON #-}
1577−
1578− liftToEncoding t _ = listEncoding t . NE.toList
1579− {-# INLINE liftToEncoding #-}
1580−
1581−instance (ToJSON a) => ToJSON (NonEmpty a) where
1582− toJSON = toJSON1
1583− {-# INLINE toJSON #-}
1584−
1585− toEncoding = toEncoding1
1586− {-# INLINE toEncoding #-}
1587−
1588−-------------------------------------------------------------------------------
1589−-- scientific
1590−-------------------------------------------------------------------------------
1591−
1592−instance ToJSON Scientific where
1593− toJSON = Number
1594− {-# INLINE toJSON #-}
1595−
1596− toEncoding = E.scientific
1597− {-# INLINE toEncoding #-}
1598−
1599−instance ToJSONKey Scientific where
1600− toJSONKey = toJSONKeyTextEnc E.scientificText
1601−
1602−-------------------------------------------------------------------------------
1603−-- DList
1604−-------------------------------------------------------------------------------
1605−
1606−instance ToJSON1 DList.DList where
1607− liftToJSON t _ = listValue t . toList
1608− {-# INLINE liftToJSON #-}
1609−
1610− liftToEncoding t _ = listEncoding t . toList
1611− {-# INLINE liftToEncoding #-}
1612−
1613−instance (ToJSON a) => ToJSON (DList.DList a) where
1614− toJSON = toJSON1
1615− {-# INLINE toJSON #-}
1616−
1617− toEncoding = toEncoding1
1618− {-# INLINE toEncoding #-}
1619−
1620−-------------------------------------------------------------------------------
1621−-- transformers - Functors
1622−-------------------------------------------------------------------------------
1623−
1624−instance ToJSON1 Identity where
1625− liftToJSON t _ (Identity a) = t a
1626− {-# INLINE liftToJSON #-}
1627−
1628− liftToJSONList _ tl xs = tl (map runIdentity xs)
1629− {-# INLINE liftToJSONList #-}
1630−
1631− liftToEncoding t _ (Identity a) = t a
1632− {-# INLINE liftToEncoding #-}
1633−
1634− liftToEncodingList _ tl xs = tl (map runIdentity xs)
1635− {-# INLINE liftToEncodingList #-}
1636−
1637−instance (ToJSON a) => ToJSON (Identity a) where
1638− toJSON = toJSON1
1639− {-# INLINE toJSON #-}
1640−
1641− toJSONList = liftToJSONList toJSON toJSONList
1642− {-# INLINE toJSONList #-}
1643−
1644− toEncoding = toEncoding1
1645− {-# INLINE toEncoding #-}
1646−
1647− toEncodingList = liftToEncodingList toEncoding toEncodingList
1648− {-# INLINE toEncodingList #-}
1649−
1650−instance (ToJSONKey a) => ToJSONKey (Identity a) where
1651− toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1652− toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1653−
1654−
1655−instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
1656− liftToJSON tv tvl (Compose x) = liftToJSON g gl x
1657− where
1658− g = liftToJSON tv tvl
1659− gl = liftToJSONList tv tvl
1660− {-# INLINE liftToJSON #-}
1661−
1662− liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)
1663− where
1664− g = liftToJSON te tel
1665− gl = liftToJSONList te tel
1666− {-# INLINE liftToJSONList #-}
1667−
1668− liftToEncoding te tel (Compose x) = liftToEncoding g gl x
1669− where
1670− g = liftToEncoding te tel
1671− gl = liftToEncodingList te tel
1672− {-# INLINE liftToEncoding #-}
1673−
1674− liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)
1675− where
1676− g = liftToEncoding te tel
1677− gl = liftToEncodingList te tel
1678− {-# INLINE liftToEncodingList #-}
1679−
1680−instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
1681− toJSON = toJSON1
1682− {-# INLINE toJSON #-}
1683−
1684− toJSONList = liftToJSONList toJSON toJSONList
1685− {-# INLINE toJSONList #-}
1686−
1687− toEncoding = toEncoding1
1688− {-# INLINE toEncoding #-}
1689−
1690− toEncodingList = liftToEncodingList toEncoding toEncodingList
1691− {-# INLINE toEncodingList #-}
1692−
1693−
1694−instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) where
1695− liftToJSON tv tvl (Pair x y) = liftToJSON2 tx txl ty tyl (x, y)
1696− where
1697− tx = liftToJSON tv tvl
1698− txl = liftToJSONList tv tvl
1699− ty = liftToJSON tv tvl
1700− tyl = liftToJSONList tv tvl
1701−
1702− liftToEncoding te tel (Pair x y) = liftToEncoding2 tx txl ty tyl (x, y)
1703− where
1704− tx = liftToEncoding te tel
1705− txl = liftToEncodingList te tel
1706− ty = liftToEncoding te tel
1707− tyl = liftToEncodingList te tel
1708−
1709−instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where
1710− toJSON = toJSON1
1711− {-# INLINE toJSON #-}
1712−
1713− toEncoding = toEncoding1
1714− {-# INLINE toEncoding #-}
1715−
1716−instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where
1717− liftToJSON tv tvl (InL x) = Object $ H.singleton "InL" (liftToJSON tv tvl x)
1718− liftToJSON tv tvl (InR y) = Object $ H.singleton "InR" (liftToJSON tv tvl y)
1719−
1720− liftToEncoding te tel (InL x) = E.pairs $ E.pair "InL" $ liftToEncoding te tel x
1721− liftToEncoding te tel (InR y) = E.pairs $ E.pair "InR" $ liftToEncoding te tel y
1722−
1723−instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where
1724− toJSON = toJSON1
1725− {-# INLINE toJSON #-}
1726−
1727− toEncoding = toEncoding1
1728− {-# INLINE toEncoding #-}
1729−
1730−-------------------------------------------------------------------------------
1731−-- containers
1732−-------------------------------------------------------------------------------
1733−
1734−instance ToJSON1 Seq.Seq where
1735− liftToJSON t _ = listValue t . toList
1736− {-# INLINE liftToJSON #-}
1737−
1738− liftToEncoding t _ = listEncoding t . toList
1739− {-# INLINE liftToEncoding #-}
1740−
1741−instance (ToJSON a) => ToJSON (Seq.Seq a) where
1742− toJSON = toJSON1
1743− {-# INLINE toJSON #-}
1744−
1745− toEncoding = toEncoding1
1746− {-# INLINE toEncoding #-}
1747−
1748−
1749−instance ToJSON1 Set.Set where
1750− liftToJSON t _ = listValue t . Set.toList
1751− {-# INLINE liftToJSON #-}
1752−
1753− liftToEncoding t _ = listEncoding t . Set.toList
1754− {-# INLINE liftToEncoding #-}
1755−
1756−instance (ToJSON a) => ToJSON (Set.Set a) where
1757− toJSON = toJSON1
1758− {-# INLINE toJSON #-}
1759−
1760− toEncoding = toEncoding1
1761− {-# INLINE toEncoding #-}
1762−
1763−
1764−instance ToJSON IntSet.IntSet where
1765− toJSON = toJSON . IntSet.toList
1766− {-# INLINE toJSON #-}
1767−
1768− toEncoding = toEncoding . IntSet.toList
1769− {-# INLINE toEncoding #-}
1770−
1771−
1772−instance ToJSON1 IntMap.IntMap where
1773− liftToJSON t tol = liftToJSON to' tol' . IntMap.toList
1774− where
1775− to' = liftToJSON2 toJSON toJSONList t tol
1776− tol' = liftToJSONList2 toJSON toJSONList t tol
1777− {-# INLINE liftToJSON #-}
1778−
1779− liftToEncoding t tol = liftToEncoding to' tol' . IntMap.toList
1780− where
1781− to' = liftToEncoding2 toEncoding toEncodingList t tol
1782− tol' = liftToEncodingList2 toEncoding toEncodingList t tol
1783− {-# INLINE liftToEncoding #-}
1784−
1785−instance ToJSON a => ToJSON (IntMap.IntMap a) where
1786− toJSON = toJSON1
1787− {-# INLINE toJSON #-}
1788−
1789− toEncoding = toEncoding1
1790− {-# INLINE toEncoding #-}
1791−
1792−
1793−instance ToJSONKey k => ToJSON1 (M.Map k) where
1794− liftToJSON g _ = case toJSONKey of
1795− ToJSONKeyText f _ -> Object . mapHashKeyVal f g
1796− ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1797− {-# INLINE liftToJSON #-}
1798−
1799− liftToEncoding g _ = case toJSONKey of
1800− ToJSONKeyText _ f -> dict f g M.foldrWithKey
1801− ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1802− where
1803− pairEncoding f (a, b) = E.list id [f a, g b]
1804− {-# INLINE liftToEncoding #-}
1805−
1806−
1807−instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where
1808− toJSON = toJSON1
1809− {-# INLINE toJSON #-}
1810−
1811− toEncoding = toEncoding1
1812− {-# INLINE toEncoding #-}
1813−
1814−
1815−instance ToJSON1 Tree.Tree where
1816− liftToJSON t tol = go
1817− where
1818− go (Tree.Node root branches) =
1819− liftToJSON2 t tol to' tol' (root, branches)
1820−
1821− to' = liftToJSON go (listValue go)
1822− tol' = liftToJSONList go (listValue go)
1823− {-# INLINE liftToJSON #-}
1824−
1825− liftToEncoding t tol = go
1826− where
1827− go (Tree.Node root branches) =
1828− liftToEncoding2 t tol to' tol' (root, branches)
1829−
1830− to' = liftToEncoding go (listEncoding go)
1831− tol' = liftToEncodingList go (listEncoding go)
1832− {-# INLINE liftToEncoding #-}
1833−
1834−instance (ToJSON v) => ToJSON (Tree.Tree v) where
1835− toJSON = toJSON1
1836− {-# INLINE toJSON #-}
1837−
1838− toEncoding = toEncoding1
1839− {-# INLINE toEncoding #-}
1840−
1841−-------------------------------------------------------------------------------
1842−-- uuid
1843−-------------------------------------------------------------------------------
1844−
1845−instance ToJSON UUID.UUID where
1846− toJSON = toJSON . UUID.toText
1847− toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1848−
1849−instance ToJSONKey UUID.UUID where
1850− toJSONKey = ToJSONKeyText UUID.toText $
1851− E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1852−
1853−-------------------------------------------------------------------------------
1854−-- vector
1855−-------------------------------------------------------------------------------
1856−
1857−instance ToJSON1 Vector where
1858− liftToJSON t _ = Array . V.map t
1859− {-# INLINE liftToJSON #-}
1860−
1861− liftToEncoding t _ = listEncoding t . V.toList
1862− {-# INLINE liftToEncoding #-}
1863−
1864−instance (ToJSON a) => ToJSON (Vector a) where
1865− {-# SPECIALIZE instance ToJSON Array #-}
1866−
1867− toJSON = toJSON1
1868− {-# INLINE toJSON #-}
1869−
1870− toEncoding = toEncoding1
1871− {-# INLINE toEncoding #-}
1872−
1873−encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
1874−encodeVector = listEncoding toEncoding . VG.toList
1875−{-# INLINE encodeVector #-}
1876−
1877−vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
1878−vectorToJSON = Array . V.map toJSON . V.convert
1879−{-# INLINE vectorToJSON #-}
1880−
1881−instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
1882− toJSON = vectorToJSON
1883− {-# INLINE toJSON #-}
1884−
1885− toEncoding = encodeVector
1886− {-# INLINE toEncoding #-}
1887−
1888−
1889−instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where
1890− toJSON = vectorToJSON
1891− {-# INLINE toJSON #-}
1892−
1893− toEncoding = encodeVector
1894− {-# INLINE toEncoding #-}
1895−
1896−
1897−instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where
1898− toJSON = vectorToJSON
1899− {-# INLINE toJSON #-}
1900−
1901− toEncoding = encodeVector
1902− {-# INLINE toEncoding #-}
1903−
1904−-------------------------------------------------------------------------------
1905−-- unordered-containers
1906−-------------------------------------------------------------------------------
1907−
1908−instance ToJSON1 HashSet.HashSet where
1909− liftToJSON t _ = listValue t . HashSet.toList
1910− {-# INLINE liftToJSON #-}
1911−
1912− liftToEncoding t _ = listEncoding t . HashSet.toList
1913− {-# INLINE liftToEncoding #-}
1914−
1915−instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
1916− toJSON = toJSON1
1917− {-# INLINE toJSON #-}
1918−
1919− toEncoding = toEncoding1
1920− {-# INLINE toEncoding #-}
1921−
1922−
1923−instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1924− liftToJSON g _ = case toJSONKey of
1925− ToJSONKeyText f _ -> Object . mapKeyVal f g
1926− ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList
1927− {-# INLINE liftToJSON #-}
1928−
1929− -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1930− liftToEncoding g _ = case toJSONKey of
1931− ToJSONKeyText _ f -> dict f g H.foldrWithKey
1932− ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1933− where
1934− pairEncoding f (a, b) = E.list id [f a, g b]
1935− {-# INLINE liftToEncoding #-}
1936−
1937−instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938− {-# SPECIALIZE instance ToJSON Object #-}
1939−
1940− toJSON = toJSON1
1941− {-# INLINE toJSON #-}
1942−
1943− toEncoding = toEncoding1
1944− {-# INLINE toEncoding #-}
1945−
1946−-------------------------------------------------------------------------------
1947−-- aeson
1948−-------------------------------------------------------------------------------
1949−
1950−instance ToJSON Value where
1951− toJSON a = a
1952− {-# INLINE toJSON #-}
1953−
1954− toEncoding = E.value
1955− {-# INLINE toEncoding #-}
1956−
1957−instance ToJSON DotNetTime where
1958− toJSON = toJSON . dotNetTime
1959−
1960− toEncoding = toEncoding . dotNetTime
1961−
1962−dotNetTime :: DotNetTime -> String
1963−dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1964− where secs = formatTime defaultTimeLocale "/Date(%s" t
1965−
1966−formatMillis :: (FormatTime t) => t -> String
1967−formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1968−
1969−-------------------------------------------------------------------------------
1970−-- primitive
1971−-------------------------------------------------------------------------------
1972−
1973−instance ToJSON a => ToJSON (PM.Array a) where
1974− -- note: we could do better than this if vector exposed the data
1975− -- constructor in Data.Vector.
1976− toJSON = toJSON . Exts.toList
1977− toEncoding = toEncoding . Exts.toList
1978−
1979−instance ToJSON a => ToJSON (PM.SmallArray a) where
1980− toJSON = toJSON . Exts.toList
1981− toEncoding = toEncoding . Exts.toList
1982−
1983−#if (MIN_VERSION_primitive(0,6,4))
1984−instance (PM.Prim a,ToJSON a) => ToJSON (PM.PrimArray a) where
1985− toJSON = toJSON . Exts.toList
1986− toEncoding = toEncoding . Exts.toList
1987−
1988−#if !MIN_VERSION_primitive(0,7,0)
1989−instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where
1990− toJSON = toJSON . Exts.toList
1991− toEncoding = toEncoding . Exts.toList
1992−#endif
1993−#endif
1994−
1995−-------------------------------------------------------------------------------
1996−-- time
1997−-------------------------------------------------------------------------------
1998−
1999−instance ToJSON Day where
2000− toJSON = stringEncoding . E.day
2001− toEncoding = E.day
2002−
2003−instance ToJSONKey Day where
2004− toJSONKey = toJSONKeyTextEnc E.day
2005−
2006−
2007−instance ToJSON TimeOfDay where
2008− toJSON = stringEncoding . E.timeOfDay
2009− toEncoding = E.timeOfDay
2010−
2011−instance ToJSONKey TimeOfDay where
2012− toJSONKey = toJSONKeyTextEnc E.timeOfDay
2013−
2014−
2015−instance ToJSON LocalTime where
2016− toJSON = stringEncoding . E.localTime
2017− toEncoding = E.localTime
2018−
2019−instance ToJSONKey LocalTime where
2020− toJSONKey = toJSONKeyTextEnc E.localTime
2021−
2022−
2023−instance ToJSON ZonedTime where
2024− toJSON = stringEncoding . E.zonedTime
2025− toEncoding = E.zonedTime
2026−
2027−instance ToJSONKey ZonedTime where
2028− toJSONKey = toJSONKeyTextEnc E.zonedTime
2029−
2030−
2031−instance ToJSON UTCTime where
2032− toJSON = stringEncoding . E.utcTime
2033− toEncoding = E.utcTime
2034−
2035−instance ToJSONKey UTCTime where
2036− toJSONKey = toJSONKeyTextEnc E.utcTime
2037−
2038−-- | Encode something t a JSON string.
2039−stringEncoding :: Encoding' Text -> Value
2040−stringEncoding = String
2041− . T.dropAround (== '"')
2042− . T.decodeLatin1
2043− . L.toStrict
2044− . E.encodingToLazyByteString
2045−{-# INLINE stringEncoding #-}
2046−
2047−
2048−instance ToJSON NominalDiffTime where
2049− toJSON = Number . realToFrac
2050− {-# INLINE toJSON #-}
2051−
2052− toEncoding = E.scientific . realToFrac
2053− {-# INLINE toEncoding #-}
2054−
2055−
2056−instance ToJSON DiffTime where
2057− toJSON = Number . realToFrac
2058− {-# INLINE toJSON #-}
2059−
2060− toEncoding = E.scientific . realToFrac
2061− {-# INLINE toEncoding #-}
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−
2107−-------------------------------------------------------------------------------
2108−-- base Monoid/Semigroup
2109−-------------------------------------------------------------------------------
2110−
2111−instance ToJSON1 Monoid.Dual where
2112− liftToJSON t _ = t . Monoid.getDual
2113− {-# INLINE liftToJSON #-}
2114−
2115− liftToEncoding t _ = t . Monoid.getDual
2116− {-# INLINE liftToEncoding #-}
2117−
2118−instance ToJSON a => ToJSON (Monoid.Dual a) where
2119− toJSON = toJSON1
2120− {-# INLINE toJSON #-}
2121−
2122− toEncoding = toEncoding1
2123− {-# INLINE toEncoding #-}
2124−
2125−
2126−instance ToJSON1 Monoid.First where
2127− liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
2128− {-# INLINE liftToJSON #-}
2129−
2130− liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
2131− {-# INLINE liftToEncoding #-}
2132−
2133−instance ToJSON a => ToJSON (Monoid.First a) where
2134− toJSON = toJSON1
2135− {-# INLINE toJSON #-}
2136−
2137− toEncoding = toEncoding1
2138− {-# INLINE toEncoding #-}
2139−
2140−
2141−instance ToJSON1 Monoid.Last where
2142− liftToJSON t to' = liftToJSON t to' . Monoid.getLast
2143− {-# INLINE liftToJSON #-}
2144−
2145− liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
2146− {-# INLINE liftToEncoding #-}
2147−
2148−instance ToJSON a => ToJSON (Monoid.Last a) where
2149− toJSON = toJSON1
2150− {-# INLINE toJSON #-}
2151−
2152− toEncoding = toEncoding1
2153− {-# INLINE toEncoding #-}
2154−
2155−
2156−instance ToJSON1 Semigroup.Min where
2157− liftToJSON t _ (Semigroup.Min x) = t x
2158− {-# INLINE liftToJSON #-}
2159−
2160− liftToEncoding t _ (Semigroup.Min x) = t x
2161− {-# INLINE liftToEncoding #-}
2162−
2163−instance ToJSON a => ToJSON (Semigroup.Min a) where
2164− toJSON = toJSON1
2165− {-# INLINE toJSON #-}
2166−
2167− toEncoding = toEncoding1
2168− {-# INLINE toEncoding #-}
2169−
2170−
2171−instance ToJSON1 Semigroup.Max where
2172− liftToJSON t _ (Semigroup.Max x) = t x
2173− {-# INLINE liftToJSON #-}
2174−
2175− liftToEncoding t _ (Semigroup.Max x) = t x
2176− {-# INLINE liftToEncoding #-}
2177−
2178−instance ToJSON a => ToJSON (Semigroup.Max a) where
2179− toJSON = toJSON1
2180− {-# INLINE toJSON #-}
2181−
2182− toEncoding = toEncoding1
2183− {-# INLINE toEncoding #-}
2184−
2185−instance ToJSON1 Semigroup.First where
2186− liftToJSON t _ (Semigroup.First x) = t x
2187− {-# INLINE liftToJSON #-}
2188−
2189− liftToEncoding t _ (Semigroup.First x) = t x
2190− {-# INLINE liftToEncoding #-}
2191−
2192−instance ToJSON a => ToJSON (Semigroup.First a) where
2193− toJSON = toJSON1
2194− {-# INLINE toJSON #-}
2195−
2196− toEncoding = toEncoding1
2197− {-# INLINE toEncoding #-}
2198−
2199−
2200−instance ToJSON1 Semigroup.Last where
2201− liftToJSON t _ (Semigroup.Last x) = t x
2202− {-# INLINE liftToJSON #-}
2203−
2204− liftToEncoding t _ (Semigroup.Last x) = t x
2205− {-# INLINE liftToEncoding #-}
2206−
2207−instance ToJSON a => ToJSON (Semigroup.Last a) where
2208− toJSON = toJSON1
2209− {-# INLINE toJSON #-}
2210−
2211− toEncoding = toEncoding1
2212− {-# INLINE toEncoding #-}
2213−
2214−
2215−instance ToJSON1 Semigroup.WrappedMonoid where
2216− liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2217− {-# INLINE liftToJSON #-}
2218−
2219− liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2220− {-# INLINE liftToEncoding #-}
2221−
2222−instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2223− toJSON = toJSON1
2224− {-# INLINE toJSON #-}
2225−
2226− toEncoding = toEncoding1
2227− {-# INLINE toEncoding #-}
2228−
2229−
2230−instance ToJSON1 Semigroup.Option where
2231− liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2232− {-# INLINE liftToJSON #-}
2233−
2234− liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2235− {-# INLINE liftToEncoding #-}
2236−
2237−instance ToJSON a => ToJSON (Semigroup.Option a) where
2238− toJSON = toJSON1
2239− {-# INLINE toJSON #-}
2240−
2241− toEncoding = toEncoding1
2242− {-# INLINE toEncoding #-}
2243−
2244−-------------------------------------------------------------------------------
2245−-- tagged
2246−-------------------------------------------------------------------------------
2247−
2248−instance ToJSON1 Proxy where
2249− liftToJSON _ _ _ = Null
2250− {-# INLINE liftToJSON #-}
2251−
2252− liftToEncoding _ _ _ = E.null_
2253− {-# INLINE liftToEncoding #-}
2254−
2255−instance ToJSON (Proxy a) where
2256− toJSON _ = Null
2257− {-# INLINE toJSON #-}
2258−
2259− toEncoding _ = E.null_
2260− {-# INLINE toEncoding #-}
2261−
2262−
2263−instance ToJSON2 Tagged where
2264− liftToJSON2 _ _ t _ (Tagged x) = t x
2265− {-# INLINE liftToJSON2 #-}
2266−
2267− liftToEncoding2 _ _ t _ (Tagged x) = t x
2268− {-# INLINE liftToEncoding2 #-}
2269−
2270−instance ToJSON1 (Tagged a) where
2271− liftToJSON t _ (Tagged x) = t x
2272− {-# INLINE liftToJSON #-}
2273−
2274− liftToEncoding t _ (Tagged x) = t x
2275− {-# INLINE liftToEncoding #-}
2276−
2277−instance ToJSON b => ToJSON (Tagged a b) where
2278− toJSON = toJSON1
2279− {-# INLINE toJSON #-}
2280−
2281− toEncoding = toEncoding1
2282− {-# INLINE toEncoding #-}
2283−
2284−instance ToJSONKey b => ToJSONKey (Tagged a b) where
2285− toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2286− toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
2287−
2288−-------------------------------------------------------------------------------
2289−-- Instances for converting t map keys
2290−-------------------------------------------------------------------------------
2291−
2292−instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
2293−instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
2294−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
2295−
2296−instance ToJSONKey Char where
2297− toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
2298− toJSONKeyList = toJSONKeyText T.pack
2299−
2300−instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
2301− toJSONKey = toJSONKeyList
2302−
2303−-------------------------------------------------------------------------------
2304−-- Tuple instances
2305−-------------------------------------------------------------------------------
2306−
2307−instance ToJSON2 (,) where
2308− liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
2309− mv <- VM.unsafeNew 2
2310− VM.unsafeWrite mv 0 (toA a)
2311− VM.unsafeWrite mv 1 (toB b)
2312− return mv
2313− {-# INLINE liftToJSON2 #-}
2314−
2315− liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
2316− {-# INLINE liftToEncoding2 #-}
2317−
2318−instance (ToJSON a) => ToJSON1 ((,) a) where
2319− liftToJSON = liftToJSON2 toJSON toJSONList
2320− {-# INLINE liftToJSON #-}
2321− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2322− {-# INLINE liftToEncoding #-}
2323−
2324−instance (ToJSON a, ToJSON b) => ToJSON (a, b) where
2325− toJSON = toJSON2
2326− {-# INLINE toJSON #-}
2327− toEncoding = toEncoding2
2328− {-# INLINE toEncoding #-}
2329−
2330−instance (ToJSON a) => ToJSON2 ((,,) a) where
2331− liftToJSON2 toB _ toC _ (a, b, c) = Array $ V.create $ do
2332− mv <- VM.unsafeNew 3
2333− VM.unsafeWrite mv 0 (toJSON a)
2334− VM.unsafeWrite mv 1 (toB b)
2335− VM.unsafeWrite mv 2 (toC c)
2336− return mv
2337− {-# INLINE liftToJSON2 #-}
2338−
2339− liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2340− [ toEncoding a
2341− , toB b
2342− , toC c
2343− ]
2344− {-# INLINE liftToEncoding2 #-}
2345−
2346−instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
2347− liftToJSON = liftToJSON2 toJSON toJSONList
2348− {-# INLINE liftToJSON #-}
2349− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2350− {-# INLINE liftToEncoding #-}
2351−
2352−instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a, b, c) where
2353− toJSON = toJSON2
2354− {-# INLINE toJSON #-}
2355− toEncoding = toEncoding2
2356− {-# INLINE toEncoding #-}
2357−
2358−instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
2359− liftToJSON2 toC _ toD _ (a, b, c, d) = Array $ V.create $ do
2360− mv <- VM.unsafeNew 4
2361− VM.unsafeWrite mv 0 (toJSON a)
2362− VM.unsafeWrite mv 1 (toJSON b)
2363− VM.unsafeWrite mv 2 (toC c)
2364− VM.unsafeWrite mv 3 (toD d)
2365− return mv
2366− {-# INLINE liftToJSON2 #-}
2367−
2368− liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2369− [ toEncoding a
2370− , toEncoding b
2371− , toC c
2372− , toD d
2373− ]
2374− {-# INLINE liftToEncoding2 #-}
2375−
2376−instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
2377− liftToJSON = liftToJSON2 toJSON toJSONList
2378− {-# INLINE liftToJSON #-}
2379− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2380− {-# INLINE liftToEncoding #-}
2381−
2382−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a, b, c, d) where
2383− toJSON = toJSON2
2384− {-# INLINE toJSON #-}
2385− toEncoding = toEncoding2
2386− {-# INLINE toEncoding #-}
2387−
2388−instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
2389− liftToJSON2 toD _ toE _ (a, b, c, d, e) = Array $ V.create $ do
2390− mv <- VM.unsafeNew 5
2391− VM.unsafeWrite mv 0 (toJSON a)
2392− VM.unsafeWrite mv 1 (toJSON b)
2393− VM.unsafeWrite mv 2 (toJSON c)
2394− VM.unsafeWrite mv 3 (toD d)
2395− VM.unsafeWrite mv 4 (toE e)
2396− return mv
2397− {-# INLINE liftToJSON2 #-}
2398−
2399− liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
2400− [ toEncoding a
2401− , toEncoding b
2402− , toEncoding c
2403− , toD d
2404− , toE e
2405− ]
2406− {-# INLINE liftToEncoding2 #-}
2407−
2408−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
2409− liftToJSON = liftToJSON2 toJSON toJSONList
2410− {-# INLINE liftToJSON #-}
2411− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2412− {-# INLINE liftToEncoding #-}
2413−
2414−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON (a, b, c, d, e) where
2415− toJSON = toJSON2
2416− {-# INLINE toJSON #-}
2417− toEncoding = toEncoding2
2418− {-# INLINE toEncoding #-}
2419−
2420−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) where
2421− liftToJSON2 toE _ toF _ (a, b, c, d, e, f) = Array $ V.create $ do
2422− mv <- VM.unsafeNew 6
2423− VM.unsafeWrite mv 0 (toJSON a)
2424− VM.unsafeWrite mv 1 (toJSON b)
2425− VM.unsafeWrite mv 2 (toJSON c)
2426− VM.unsafeWrite mv 3 (toJSON d)
2427− VM.unsafeWrite mv 4 (toE e)
2428− VM.unsafeWrite mv 5 (toF f)
2429− return mv
2430− {-# INLINE liftToJSON2 #-}
2431−
2432− liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
2433− [ toEncoding a
2434− , toEncoding b
2435− , toEncoding c
2436− , toEncoding d
2437− , toE e
2438− , toF f
2439− ]
2440− {-# INLINE liftToEncoding2 #-}
2441−
2442−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
2443− liftToJSON = liftToJSON2 toJSON toJSONList
2444− {-# INLINE liftToJSON #-}
2445− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2446− {-# INLINE liftToEncoding #-}
2447−
2448−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON (a, b, c, d, e, f) where
2449− toJSON = toJSON2
2450− {-# INLINE toJSON #-}
2451− toEncoding = toEncoding2
2452− {-# INLINE toEncoding #-}
2453−
2454−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,) a b c d e) where
2455− liftToJSON2 toF _ toG _ (a, b, c, d, e, f, g) = Array $ V.create $ do
2456− mv <- VM.unsafeNew 7
2457− VM.unsafeWrite mv 0 (toJSON a)
2458− VM.unsafeWrite mv 1 (toJSON b)
2459− VM.unsafeWrite mv 2 (toJSON c)
2460− VM.unsafeWrite mv 3 (toJSON d)
2461− VM.unsafeWrite mv 4 (toJSON e)
2462− VM.unsafeWrite mv 5 (toF f)
2463− VM.unsafeWrite mv 6 (toG g)
2464− return mv
2465− {-# INLINE liftToJSON2 #-}
2466−
2467− liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
2468− [ toEncoding a
2469− , toEncoding b
2470− , toEncoding c
2471− , toEncoding d
2472− , toEncoding e
2473− , toF f
2474− , toG g
2475− ]
2476− {-# INLINE liftToEncoding2 #-}
2477−
2478−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
2479− liftToJSON = liftToJSON2 toJSON toJSONList
2480− {-# INLINE liftToJSON #-}
2481− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2482− {-# INLINE liftToEncoding #-}
2483−
2484−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON (a, b, c, d, e, f, g) where
2485− toJSON = toJSON2
2486− {-# INLINE toJSON #-}
2487− toEncoding = toEncoding2
2488− {-# INLINE toEncoding #-}
2489−
2490−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2 ((,,,,,,,) a b c d e f) where
2491− liftToJSON2 toG _ toH _ (a, b, c, d, e, f, g, h) = Array $ V.create $ do
2492− mv <- VM.unsafeNew 8
2493− VM.unsafeWrite mv 0 (toJSON a)
2494− VM.unsafeWrite mv 1 (toJSON b)
2495− VM.unsafeWrite mv 2 (toJSON c)
2496− VM.unsafeWrite mv 3 (toJSON d)
2497− VM.unsafeWrite mv 4 (toJSON e)
2498− VM.unsafeWrite mv 5 (toJSON f)
2499− VM.unsafeWrite mv 6 (toG g)
2500− VM.unsafeWrite mv 7 (toH h)
2501− return mv
2502− {-# INLINE liftToJSON2 #-}
2503−
2504− liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
2505− [ toEncoding a
2506− , toEncoding b
2507− , toEncoding c
2508− , toEncoding d
2509− , toEncoding e
2510− , toEncoding f
2511− , toG g
2512− , toH h
2513− ]
2514− {-# INLINE liftToEncoding2 #-}
2515−
2516−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
2517− liftToJSON = liftToJSON2 toJSON toJSONList
2518− {-# INLINE liftToJSON #-}
2519− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2520− {-# INLINE liftToEncoding #-}
2521−
2522−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON (a, b, c, d, e, f, g, h) where
2523− toJSON = toJSON2
2524− {-# INLINE toJSON #-}
2525− toEncoding = toEncoding2
2526− {-# INLINE toEncoding #-}
2527−
2528−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON2 ((,,,,,,,,) a b c d e f g) where
2529− liftToJSON2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = Array $ V.create $ do
2530− mv <- VM.unsafeNew 9
2531− VM.unsafeWrite mv 0 (toJSON a)
2532− VM.unsafeWrite mv 1 (toJSON b)
2533− VM.unsafeWrite mv 2 (toJSON c)
2534− VM.unsafeWrite mv 3 (toJSON d)
2535− VM.unsafeWrite mv 4 (toJSON e)
2536− VM.unsafeWrite mv 5 (toJSON f)
2537− VM.unsafeWrite mv 6 (toJSON g)
2538− VM.unsafeWrite mv 7 (toH h)
2539− VM.unsafeWrite mv 8 (toI i)
2540− return mv
2541− {-# INLINE liftToJSON2 #-}
2542−
2543− liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
2544− [ toEncoding a
2545− , toEncoding b
2546− , toEncoding c
2547− , toEncoding d
2548− , toEncoding e
2549− , toEncoding f
2550− , toEncoding g
2551− , toH h
2552− , toI i
2553− ]
2554− {-# INLINE liftToEncoding2 #-}
2555−
2556−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
2557− liftToJSON = liftToJSON2 toJSON toJSONList
2558− {-# INLINE liftToJSON #-}
2559− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2560− {-# INLINE liftToEncoding #-}
2561−
2562−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON (a, b, c, d, e, f, g, h, i) where
2563− toJSON = toJSON2
2564− {-# INLINE toJSON #-}
2565− toEncoding = toEncoding2
2566− {-# INLINE toEncoding #-}
2567−
2568−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON2 ((,,,,,,,,,) a b c d e f g h) where
2569− liftToJSON2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = Array $ V.create $ do
2570− mv <- VM.unsafeNew 10
2571− VM.unsafeWrite mv 0 (toJSON a)
2572− VM.unsafeWrite mv 1 (toJSON b)
2573− VM.unsafeWrite mv 2 (toJSON c)
2574− VM.unsafeWrite mv 3 (toJSON d)
2575− VM.unsafeWrite mv 4 (toJSON e)
2576− VM.unsafeWrite mv 5 (toJSON f)
2577− VM.unsafeWrite mv 6 (toJSON g)
2578− VM.unsafeWrite mv 7 (toJSON h)
2579− VM.unsafeWrite mv 8 (toI i)
2580− VM.unsafeWrite mv 9 (toJ j)
2581− return mv
2582− {-# INLINE liftToJSON2 #-}
2583−
2584− liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
2585− [ toEncoding a
2586− , toEncoding b
2587− , toEncoding c
2588− , toEncoding d
2589− , toEncoding e
2590− , toEncoding f
2591− , toEncoding g
2592− , toEncoding h
2593− , toI i
2594− , toJ j
2595− ]
2596− {-# INLINE liftToEncoding2 #-}
2597−
2598−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
2599− liftToJSON = liftToJSON2 toJSON toJSONList
2600− {-# INLINE liftToJSON #-}
2601− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2602− {-# INLINE liftToEncoding #-}
2603−
2604−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON (a, b, c, d, e, f, g, h, i, j) where
2605− toJSON = toJSON2
2606− {-# INLINE toJSON #-}
2607− toEncoding = toEncoding2
2608− {-# INLINE toEncoding #-}
2609−
2610−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON2 ((,,,,,,,,,,) a b c d e f g h i) where
2611− liftToJSON2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = Array $ V.create $ do
2612− mv <- VM.unsafeNew 11
2613− VM.unsafeWrite mv 0 (toJSON a)
2614− VM.unsafeWrite mv 1 (toJSON b)
2615− VM.unsafeWrite mv 2 (toJSON c)
2616− VM.unsafeWrite mv 3 (toJSON d)
2617− VM.unsafeWrite mv 4 (toJSON e)
2618− VM.unsafeWrite mv 5 (toJSON f)
2619− VM.unsafeWrite mv 6 (toJSON g)
2620− VM.unsafeWrite mv 7 (toJSON h)
2621− VM.unsafeWrite mv 8 (toJSON i)
2622− VM.unsafeWrite mv 9 (toJ j)
2623− VM.unsafeWrite mv 10 (toK k)
2624− return mv
2625− {-# INLINE liftToJSON2 #-}
2626−
2627− liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
2628− [ toEncoding a
2629− , toEncoding b
2630− , toEncoding c
2631− , toEncoding d
2632− , toEncoding e
2633− , toEncoding f
2634− , toEncoding g
2635− , toEncoding h
2636− , toEncoding i
2637− , toJ j
2638− , toK k
2639− ]
2640− {-# INLINE liftToEncoding2 #-}
2641−
2642−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
2643− liftToJSON = liftToJSON2 toJSON toJSONList
2644− {-# INLINE liftToJSON #-}
2645− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2646− {-# INLINE liftToEncoding #-}
2647−
2648−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON (a, b, c, d, e, f, g, h, i, j, k) where
2649− toJSON = toJSON2
2650− {-# INLINE toJSON #-}
2651− toEncoding = toEncoding2
2652− {-# INLINE toEncoding #-}
2653−
2654−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) where
2655− liftToJSON2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = Array $ V.create $ do
2656− mv <- VM.unsafeNew 12
2657− VM.unsafeWrite mv 0 (toJSON a)
2658− VM.unsafeWrite mv 1 (toJSON b)
2659− VM.unsafeWrite mv 2 (toJSON c)
2660− VM.unsafeWrite mv 3 (toJSON d)
2661− VM.unsafeWrite mv 4 (toJSON e)
2662− VM.unsafeWrite mv 5 (toJSON f)
2663− VM.unsafeWrite mv 6 (toJSON g)
2664− VM.unsafeWrite mv 7 (toJSON h)
2665− VM.unsafeWrite mv 8 (toJSON i)
2666− VM.unsafeWrite mv 9 (toJSON j)
2667− VM.unsafeWrite mv 10 (toK k)
2668− VM.unsafeWrite mv 11 (toL l)
2669− return mv
2670− {-# INLINE liftToJSON2 #-}
2671−
2672− liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
2673− [ toEncoding a
2674− , toEncoding b
2675− , toEncoding c
2676− , toEncoding d
2677− , toEncoding e
2678− , toEncoding f
2679− , toEncoding g
2680− , toEncoding h
2681− , toEncoding i
2682− , toEncoding j
2683− , toK k
2684− , toL l
2685− ]
2686− {-# INLINE liftToEncoding2 #-}
2687−
2688−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
2689− liftToJSON = liftToJSON2 toJSON toJSONList
2690− {-# INLINE liftToJSON #-}
2691− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2692− {-# INLINE liftToEncoding #-}
2693−
2694−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l) where
2695− toJSON = toJSON2
2696− {-# INLINE toJSON #-}
2697− toEncoding = toEncoding2
2698− {-# INLINE toEncoding #-}
2699−
2700−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) where
2701− liftToJSON2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = Array $ V.create $ do
2702− mv <- VM.unsafeNew 13
2703− VM.unsafeWrite mv 0 (toJSON a)
2704− VM.unsafeWrite mv 1 (toJSON b)
2705− VM.unsafeWrite mv 2 (toJSON c)
2706− VM.unsafeWrite mv 3 (toJSON d)
2707− VM.unsafeWrite mv 4 (toJSON e)
2708− VM.unsafeWrite mv 5 (toJSON f)
2709− VM.unsafeWrite mv 6 (toJSON g)
2710− VM.unsafeWrite mv 7 (toJSON h)
2711− VM.unsafeWrite mv 8 (toJSON i)
2712− VM.unsafeWrite mv 9 (toJSON j)
2713− VM.unsafeWrite mv 10 (toJSON k)
2714− VM.unsafeWrite mv 11 (toL l)
2715− VM.unsafeWrite mv 12 (toM m)
2716− return mv
2717− {-# INLINE liftToJSON2 #-}
2718−
2719− liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
2720− [ toEncoding a
2721− , toEncoding b
2722− , toEncoding c
2723− , toEncoding d
2724− , toEncoding e
2725− , toEncoding f
2726− , toEncoding g
2727− , toEncoding h
2728− , toEncoding i
2729− , toEncoding j
2730− , toEncoding k
2731− , toL l
2732− , toM m
2733− ]
2734− {-# INLINE liftToEncoding2 #-}
2735−
2736−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
2737− liftToJSON = liftToJSON2 toJSON toJSONList
2738− {-# INLINE liftToJSON #-}
2739− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2740− {-# INLINE liftToEncoding #-}
2741−
2742−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) where
2743− toJSON = toJSON2
2744− {-# INLINE toJSON #-}
2745− toEncoding = toEncoding2
2746− {-# INLINE toEncoding #-}
2747−
2748−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) where
2749− liftToJSON2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = Array $ V.create $ do
2750− mv <- VM.unsafeNew 14
2751− VM.unsafeWrite mv 0 (toJSON a)
2752− VM.unsafeWrite mv 1 (toJSON b)
2753− VM.unsafeWrite mv 2 (toJSON c)
2754− VM.unsafeWrite mv 3 (toJSON d)
2755− VM.unsafeWrite mv 4 (toJSON e)
2756− VM.unsafeWrite mv 5 (toJSON f)
2757− VM.unsafeWrite mv 6 (toJSON g)
2758− VM.unsafeWrite mv 7 (toJSON h)
2759− VM.unsafeWrite mv 8 (toJSON i)
2760− VM.unsafeWrite mv 9 (toJSON j)
2761− VM.unsafeWrite mv 10 (toJSON k)
2762− VM.unsafeWrite mv 11 (toJSON l)
2763− VM.unsafeWrite mv 12 (toM m)
2764− VM.unsafeWrite mv 13 (toN n)
2765− return mv
2766− {-# INLINE liftToJSON2 #-}
2767−
2768− liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2769− [ toEncoding a
2770− , toEncoding b
2771− , toEncoding c
2772− , toEncoding d
2773− , toEncoding e
2774− , toEncoding f
2775− , toEncoding g
2776− , toEncoding h
2777− , toEncoding i
2778− , toEncoding j
2779− , toEncoding k
2780− , toEncoding l
2781− , toM m
2782− , toN n
2783− ]
2784− {-# INLINE liftToEncoding2 #-}
2785−
2786−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
2787− liftToJSON = liftToJSON2 toJSON toJSONList
2788− {-# INLINE liftToJSON #-}
2789− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2790− {-# INLINE liftToEncoding #-}
2791−
2792−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
2793− toJSON = toJSON2
2794− {-# INLINE toJSON #-}
2795− toEncoding = toEncoding2
2796− {-# INLINE toEncoding #-}
2797−
2798−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
2799− liftToJSON2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = Array $ V.create $ do
2800− mv <- VM.unsafeNew 15
2801− VM.unsafeWrite mv 0 (toJSON a)
2802− VM.unsafeWrite mv 1 (toJSON b)
2803− VM.unsafeWrite mv 2 (toJSON c)
2804− VM.unsafeWrite mv 3 (toJSON d)
2805− VM.unsafeWrite mv 4 (toJSON e)
2806− VM.unsafeWrite mv 5 (toJSON f)
2807− VM.unsafeWrite mv 6 (toJSON g)
2808− VM.unsafeWrite mv 7 (toJSON h)
2809− VM.unsafeWrite mv 8 (toJSON i)
2810− VM.unsafeWrite mv 9 (toJSON j)
2811− VM.unsafeWrite mv 10 (toJSON k)
2812− VM.unsafeWrite mv 11 (toJSON l)
2813− VM.unsafeWrite mv 12 (toJSON m)
2814− VM.unsafeWrite mv 13 (toN n)
2815− VM.unsafeWrite mv 14 (toO o)
2816− return mv
2817− {-# INLINE liftToJSON2 #-}
2818−
2819− liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2820− [ toEncoding a
2821− , toEncoding b
2822− , toEncoding c
2823− , toEncoding d
2824− , toEncoding e
2825− , toEncoding f
2826− , toEncoding g
2827− , toEncoding h
2828− , toEncoding i
2829− , toEncoding j
2830− , toEncoding k
2831− , toEncoding l
2832− , toEncoding m
2833− , toN n
2834− , toO o
2835− ]
2836− {-# INLINE liftToEncoding2 #-}
2837−
2838−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
2839− liftToJSON = liftToJSON2 toJSON toJSONList
2840− {-# INLINE liftToJSON #-}
2841− liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2842− {-# INLINE liftToEncoding #-}
2843−
2844−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n, ToJSON o) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
2845− toJSON = toJSON2
2846− {-# INLINE toJSON #-}
2847− toEncoding = toEncoding2
2848− {-# INLINE toEncoding #-}
2849−
2850−--------------------------------------------------------------------------------
2851−
2852−-- | Wrap a list of pairs as an object.
2853−class Monoid pairs => FromPairs enc pairs | enc -> pairs where
2854− fromPairs :: pairs -> enc
2855−
2856−instance (a ~ Value) => FromPairs (Encoding' a) Series where
2857− fromPairs = E.pairs
2858−
2859−instance FromPairs Value (DList Pair) where
2860− fromPairs = object . toList
2861−
2862−-- | Like 'KeyValue' but the value is already converted to JSON
2863−-- ('Value' or 'Encoding'), and the result actually represents lists of pairs
2864−-- so it can be readily concatenated.
2865−class Monoid kv => KeyValuePair v kv where
2866− pair :: String -> v -> kv
2867−
2868−instance (v ~ Value) => KeyValuePair v (DList Pair) where
2869− pair k v = DList.singleton (pack k .= v)
2870−
2871−instance (e ~ Encoding) => KeyValuePair e Series where
2872− pair = E.pairStr
Makefiledeleted−2
@@ -1,2 +0,0 @@
1−lint:
2− ./run-hlint.sh --cpp-include include/ --cpp-file travis/cabal_macros.h Data/ attoparsec-iso8601/ benchmarks/ examples/ ffi/ pure/ tests/
README.markdown+5−4
@@ -1,4 +1,4 @@
1−# Welcome to `aeson` [![Hackage](https://img.shields.io/hackage/v/aeson.svg)](https://hackage.haskell.org/package/aeson) [![Build Status](https://travis-ci.org/bos/aeson.svg)](https://travis-ci.org/bos/aeson)
1+# Welcome to aeson
2
2
3aeson is a fast Haskell library for working with JSON data.
3aeson is a fast Haskell library for working with JSON data.
4
4
@@ -15,13 +15,14 @@ Master [git repository](http://github.com/bos/aeson):
15
15
16* `git clone git://github.com/bos/aeson.git`
16* `git clone git://github.com/bos/aeson.git`
17
17
18−See what's changed in recent (and upcoming) releases:
18+There's also a [Mercurial mirror](http://bitbucket.org/bos/aeson):
19
19
20−* https://github.com/bos/aeson/blob/master/changelog.md
20+* `hg clone http://bitbucket.org/bos/aeson`
21
21
22(You can create and contribute changes using either git or Mercurial.)
22(You can create and contribute changes using either git or Mercurial.)
23
23
24
24
25# Authors
25# Authors
26
26
27−This library was originally written by Bryan O'Sullivan.
27+This library is written and maintained by Bryan O'Sullivan,
28+<bos@serpentine.com>.
aeson.cabal+93−187
@@ -1,16 +1,16 @@
1name: aeson
1name: aeson
2−version: 1.4.6.0
2+version: 0.9.0.1
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5category: Text, Web, JSON
5category: Text, Web, JSON
6−copyright: (c) 2011-2016 Bryan O'Sullivan
6+copyright: (c) 2011-2015 Bryan O'Sullivan
7 (c) 2011 MailRank, Inc.
7 (c) 2011 MailRank, Inc.
8author: Bryan O'Sullivan <bos@serpentine.com>
8author: Bryan O'Sullivan <bos@serpentine.com>
9−maintainer: Adam Bergmark <adam@bergmark.nl>
9+maintainer: Bryan O'Sullivan <bos@serpentine.com>
10stability: experimental
10stability: experimental
11−tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1
11+tested-with: GHC == 7.4, GHC == 7.6, GHC == 7.8
12synopsis: Fast JSON parsing and encoding
12synopsis: Fast JSON parsing and encoding
13−cabal-version: >= 1.10
13+cabal-version: >= 1.8
14homepage: https://github.com/bos/aeson
14homepage: https://github.com/bos/aeson
15bug-reports: https://github.com/bos/aeson/issues
15bug-reports: https://github.com/bos/aeson/issues
16build-type: Simple
16build-type: Simple
@@ -21,246 +21,152 @@ description:
21 To get started, see the documentation for the @Data.Aeson@ module
21 To get started, see the documentation for the @Data.Aeson@ module
22 below.
22 below.
23 .
23 .
24+ Parsing performance on an early 2011 MacBook Pro (2.2GHz Core i7),
25+ running 64-bit GHC 7.6.3, for mostly-English tweets from Twitter's
26+ JSON search API:
27+ .
28+ * 0.8 KB: 34124 msg\/sec (27.8 MB\/sec)
29+ .
30+ * 6.4 KB: 6833 msg\/sec (43.0 MB\/sec)
31+ .
32+ * 11.8 KB: 3410 msg\/sec (39.2 MB\/sec)
33+ .
34+ * 31.2 KB: 1157 msg\/sec (35.3 MB\/sec)
35+ .
36+ * 61.5 KB: 542 msg\/sec (32.5 MB\/sec)
37+ .
38+ Handling heavily-escaped text is a little more work. Here is
39+ parsing performance with Japanese tweets, where much of the text
40+ is entirely Unicode-escaped.
41+ .
42+ * 14.6 KB: 2101 msg\/sec (30.0 MB\/sec)
43+ .
44+ * 44.1 KB: 667 msg\/sec (28.7 MB\/sec)
45+ .
46+ * 82.9 KB: 360 msg\/sec (29.2 MB\/sec)
47+ .
48+ Encoding performance on the same machine and data:
49+ .
50+ * English, 0.8 KB: 109697 msg\/sec (89.3 MB\/sec)
51+ .
52+ * English, 6.4 KB: 18517 msg\/sec (116.4 MB\/sec)
53+ .
54+ * Engish, 61.5 KB: 1963 msg\/sec (118.0 MB\/sec)
55+ .
56+ * Japanese, 14.6 KB: 12140 msg\/sec (173.5 MB\/sec)
57+ .
58+ * Japanese, 44.1 KB: 3980 msg\/sec (171.3 MB\/sec)
59+ .
24 (A note on naming: in Greek mythology, Aeson was the father of Jason.)
60 (A note on naming: in Greek mythology, Aeson was the father of Jason.)
25
61
26extra-source-files:
62extra-source-files:
27− *.yaml
28 README.markdown
63 README.markdown
29 benchmarks/*.cabal
64 benchmarks/*.cabal
30 benchmarks/*.hs
65 benchmarks/*.hs
31 benchmarks/*.py
66 benchmarks/*.py
32− benchmarks/Compare/*.hs
33 benchmarks/Makefile
67 benchmarks/Makefile
34− benchmarks/Typed/*.hs
35 benchmarks/json-data/*.json
68 benchmarks/json-data/*.json
36− cbits/*.c
37 changelog.md
69 changelog.md
38− examples/*.cabal
39 examples/*.hs
70 examples/*.hs
40− examples/Twitter/*.hs
41− ffi/Data/Aeson/Parser/*.hs
42− include/*.h
43− tests/JSONTestSuite/test_parsing/*.json
44− tests/JSONTestSuite/test_transform/*.json
45− tests/golden/*.expected
46− pure/Data/Aeson/Parser/*.hs
47
71
48flag developer
72flag developer
49 description: operate in developer mode
73 description: operate in developer mode
50 default: False
74 default: False
51 manual: True
75 manual: True
52
76
53−flag fast
77+flag old-locale
54− description: compile without optimizations
78+ description: If false then depend on time >= 1.5.
55− default: False
79+ .
56− manual: True
80+ If true then depend on time < 1.5 together with old-locale.
57−
58−flag bytestring-builder
59− description: Depend on the bytestring-builder package for backwards compatibility.
60 default: False
81 default: False
61− manual: False
62−
63−flag cffi
64− description: Controls whether to include c-ffi bits or pure haskell. Default to False for security.
65− default: False
66− manual: True
67
82
68library
83library
69− default-language: Haskell2010
70− hs-source-dirs: . attoparsec-iso8601/
71−
72 exposed-modules:
84 exposed-modules:
73 Data.Aeson
85 Data.Aeson
74− Data.Aeson.Encoding
86+ Data.Aeson.Encode
75 Data.Aeson.Parser
87 Data.Aeson.Parser
76− Data.Aeson.Text
77 Data.Aeson.Types
88 Data.Aeson.Types
78 Data.Aeson.TH
89 Data.Aeson.TH
79− Data.Aeson.QQ.Simple
80−
81− Data.Aeson.Encoding.Internal
82− Data.Aeson.Internal
83− Data.Aeson.Internal.Time
84− Data.Aeson.Parser.Internal
85−
86− -- Deprecated modules
87− exposed-modules:
88− Data.Aeson.Encode
89
90
90 other-modules:
91 other-modules:
91− Data.Aeson.Encoding.Builder
92+ Data.Aeson.Encode.ByteString
92− Data.Aeson.Internal.Functions
93+ Data.Aeson.Functions
93− Data.Aeson.Parser.Unescape
94+ Data.Aeson.Parser.Internal
94− Data.Aeson.Parser.Time
95− Data.Aeson.Types.FromJSON
96− Data.Aeson.Types.Generic
97− Data.Aeson.Types.ToJSON
98 Data.Aeson.Types.Class
95 Data.Aeson.Types.Class
96+ Data.Aeson.Types.Generic
97+ Data.Aeson.Types.Instances
99 Data.Aeson.Types.Internal
98 Data.Aeson.Types.Internal
100− Data.Attoparsec.Time
101− Data.Attoparsec.Time.Internal
102−
103− -- GHC bundled libs
104− build-depends:
105− base >= 4.7.0.0 && < 5,
106− bytestring >= 0.10.4.0 && < 0.11,
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.9.0.0 && < 2.16,
111− text >= 1.2.3.0 && < 1.3,
112− time >= 1.4 && < 1.10
113
99
114− if impl(ghc >= 8.0)
115− build-depends: bytestring >= 0.10.8.1
116−
117− -- Compat
118 build-depends:
100 build-depends:
119− base-compat >= 0.9.1 && < 0.12,
120− time-compat >= 1.9.2.2 && < 1.10
121−
122− if !impl(ghc >= 8.6)
123− build-depends:
124− contravariant >=1.4.1 && <1.6
125−
126− if !impl(ghc >= 8.0)
127− -- `Data.Semigroup` and `Control.Monad.Fail` and `Control.Monad.IO.Class` are available in base only since GHC 8.0 / base 4.9
128− build-depends:
129− semigroups >= 0.18.5 && < 0.20,
130− transformers >= 0.3.0.0 && < 0.6,
131− transformers-compat >= 0.6.2 && < 0.7,
132− fail == 4.9.*
133−
134− if !impl(ghc >= 7.10)
135− -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8
136− build-depends: nats >= 1.1.1 && < 1.2,
137− void >= 0.7.2 && < 0.8
138−
139− -- cannot use latest version
140− build-depends:
141− unordered-containers >= 0.2.8.0 && < 0.3,
142−
143− -- not in LTS-12.10
144− tagged >= 0.8.5 && < 0.9,
145− primitive >= 0.6.3.0 && < 0.8
146−
147− -- Other dependencies
148− build-depends:
149− attoparsec >= 0.13.2.2 && < 0.14,
101+ attoparsec >= 0.13.0.0,
102+ base >= 4.5 && < 5,
103+ bytestring >= 0.10.4.0,
104+ containers,
105+ deepseq,
150− dlist >= 0.8.0.4 && < 0.9,
106+ dlist >= 0.2,
107+ ghc-prim >= 0.2,
151− hashable >= 1.2.7.0 && < 1.4,
108+ hashable >= 1.1.2.0,
109+ mtl,
152− scientific >= 0.3.6.2 && < 0.4,
110+ scientific >= 0.3.1 && < 0.4,
153− th-abstraction >= 0.2.8.0 && < 0.4,
111+ syb,
154− uuid-types >= 1.0.3 && < 1.1,
112+ template-haskell >= 2.4,
113+ text >= 1.1.1.0,
114+ transformers,
115+ unordered-containers >= 0.2.5.0,
155− vector >= 0.12.0.1 && < 0.13
116+ vector >= 0.7.1
156−
117+
157− ghc-options: -Wall
118+ if flag(old-locale)
119+ build-depends: time < 1.5, old-locale
120+ else
121+ build-depends: time >= 1.5
158
122
159 if flag(developer)
123 if flag(developer)
160 ghc-options: -Werror
124 ghc-options: -Werror
161 ghc-prof-options: -auto-all
125 ghc-prof-options: -auto-all
162
126
163− if flag(fast)
164− ghc-options: -O0
165− else
166− ghc-options: -O2
127+ ghc-options: -O2 -Wall
167−
168− include-dirs: include
169− if impl(ghcjs) || !flag(cffi)
170− hs-source-dirs: pure
171− other-modules: Data.Aeson.Parser.UnescapePure
172− else
173− c-sources: cbits/unescape_string.c
174− cpp-options: -DCFFI
175− hs-source-dirs: ffi
176− other-modules: Data.Aeson.Parser.UnescapeFFI
177
128
178test-suite tests
129test-suite tests
179− default-language: Haskell2010
180− type: exitcode-stdio-1.0
130+ type: exitcode-stdio-1.0
181− hs-source-dirs: tests ffi pure
131+ hs-source-dirs: tests
182− main-is: Tests.hs
132+ main-is: Properties.hs
183− c-sources: cbits/unescape_string.c
184− ghc-options: -Wall -threaded -rtsopts
185−
186 other-modules:
133 other-modules:
187− Data.Aeson.Parser.UnescapeFFI
188− Data.Aeson.Parser.UnescapePure
189− DataFamilies.Properties
190− DataFamilies.Instances
191− DataFamilies.Encoders
192− DataFamilies.Types
193 Encoders
134 Encoders
194− ErrorMessages
195 Functions
135 Functions
196 Instances
136 Instances
197 Options
137 Options
198− PropUtils
199− Properties
138+ Properties.ZonedTime
200− PropertyGeneric
201− PropertyKeys
202− PropertyRoundTrip
203− PropertyRTFunctors
204− PropertyTH
205− SerializationFormatSpec
206 Types
139 Types
207− UnitTests
140+
208− UnitTests.NullaryConstructors
141+ ghc-options: -Wall -threaded -rtsopts
209
142
210 build-depends:
143 build-depends:
144+ HUnit,
211− QuickCheck >= 2.10.0.1 && < 2.14,
145+ QuickCheck >= 2.7,
212 aeson,
146 aeson,
213− integer-logarithms >= 1 && <1.1,
214 attoparsec,
147 attoparsec,
215 base,
148 base,
216− base-compat,
217− base-orphans >= 0.5.3 && <0.9,
218− base16-bytestring,
149+ bytestring,
219 containers,
150 containers,
220− directory,
221− dlist,
222− Diff >= 0.4 && < 0.5,
223− filepath,
224− generic-deriving >= 1.10 && < 1.14,
225 ghc-prim >= 0.2,
151 ghc-prim >= 0.2,
226− hashable >= 1.2.4.0,
227− scientific,
228− tagged,
229 template-haskell,
152 template-haskell,
230− tasty,
153+ test-framework,
231− tasty-golden,
154+ test-framework-hunit,
232− tasty-hunit,
155+ test-framework-quickcheck2,
233− tasty-quickcheck,
234 text,
156 text,
235 time,
157 time,
236− time-compat,
237 unordered-containers,
158 unordered-containers,
238− uuid-types,
239− vector,
159+ vector
240− quickcheck-instances >= 0.3.21 && <0.4
241
160
242− if flag(bytestring-builder)
161+ if flag(old-locale)
243− build-depends: bytestring >= 0.9 && < 0.10.4,
162+ build-depends: time < 1.5, old-locale
244− bytestring-builder >= 0.10.4 && < 1
245 else
163 else
246− build-depends: bytestring >= 0.10.4
164+ build-depends: time >= 1.5
247−
248− if !impl(ghc >= 8.0)
249− build-depends:
250− semigroups >= 0.18.2 && < 0.20,
251− transformers >= 0.2.2.0,
252− transformers-compat >= 0.3
253−
254− if !impl(ghc >= 7.10)
255− build-depends: nats >=1 && <1.2,
256− void >=0.7.2 && <0.8
257−
258− if impl(ghc >= 7.8)
259− build-depends: hashable-time >= 0.2 && <0.3
260−
261− if flag(fast)
262− ghc-options: -fno-enable-rewrite-rules
263
165
264source-repository head
166source-repository head
265 type: git
167 type: git
266 location: git://github.com/bos/aeson.git
168 location: git://github.com/bos/aeson.git
169+
170+source-repository head
171+ type: mercurial
172+ location: https://bitbucket.org/bos/aeson
attoparsec-iso8601/Data/Attoparsec/Time.hsdeleted−148
@@ -1,148 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−-- |
5−-- Module: Data.Aeson.Parser.Time
6−-- Copyright: (c) 2015-2016 Bryan O'Sullivan
7−-- License: BSD3
8−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
9−-- Stability: experimental
10−-- Portability: portable
11−--
12−-- Parsers for parsing dates and times.
13−
14−module Data.Attoparsec.Time
15− (
16− day
17− , localTime
18− , timeOfDay
19− , timeZone
20− , utcTime
21− , zonedTime
22− ) where
23−
24−import Prelude.Compat
25−
26−import Control.Applicative ((<|>))
27−import Control.Monad (void, when)
28−import Data.Attoparsec.Text as A
29−import Data.Attoparsec.Time.Internal (toPico)
30−import Data.Bits ((.&.))
31−import Data.Char (isDigit, ord)
32−import Data.Fixed (Pico)
33−import Data.Int (Int64)
34−import Data.Maybe (fromMaybe)
35−import Data.Time.Calendar (Day, fromGregorianValid)
36−import Data.Time.Clock (UTCTime(..))
37−import qualified Data.Text as T
38−import qualified Data.Time.LocalTime as Local
39−
40−-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
41−day :: Parser Day
42−day = do
43− absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id
44− y <- (decimal <* char '-') <|> fail "date must be of form [+,-]YYYY-MM-DD"
45− m <- (twoDigits <* char '-') <|> fail "date must be of form [+,-]YYYY-MM-DD"
46− d <- twoDigits <|> fail "date must be of form [+,-]YYYY-MM-DD"
47− maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d)
48−
49−-- | Parse a two-digit integer (e.g. day of month, hour).
50−twoDigits :: Parser Int
51−twoDigits = do
52− a <- digit
53− b <- digit
54− let c2d c = ord c .&. 15
55− return $! c2d a * 10 + c2d b
56−
57−-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
58−timeOfDay :: Parser Local.TimeOfDay
59−timeOfDay = do
60− h <- twoDigits
61− m <- char ':' *> twoDigits
62− s <- option 0 (char ':' *> seconds)
63− if h < 24 && m < 60 && s < 61
64− then return (Local.TimeOfDay h m s)
65− else fail "invalid time"
66−
67−data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64
68−
69−-- | Parse a count of seconds, with the integer part being two digits
70−-- long.
71−seconds :: Parser Pico
72−seconds = do
73− real <- twoDigits
74− mc <- peekChar
75− case mc of
76− Just '.' -> do
77− t <- anyChar *> takeWhile1 isDigit
78− return $! parsePicos real t
79− _ -> return $! fromIntegral real
80− where
81− parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
82− where T n t' = T.foldl' step (T 12 (fromIntegral a0)) t
83− step ma@(T m a) c
84− | m <= 0 = ma
85− | otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15)
86−
87−-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
88−-- zero. (This makes some speedups possible.)
89−timeZone :: Parser (Maybe Local.TimeZone)
90−timeZone = do
91− let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar)
92− maybeSkip ' '
93− ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
94− if ch == 'Z'
95− then return Nothing
96− else do
97− h <- twoDigits
98− mm <- peekChar
99− m <- case mm of
100− Just ':' -> anyChar *> twoDigits
101− Just d | isDigit d -> twoDigits
102− _ -> return 0
103− let off | ch == '-' = negate off0
104− | otherwise = off0
105− off0 = h * 60 + m
106− case undefined of
107− _ | off == 0 ->
108− return Nothing
109− | off < -720 || off > 840 || m > 59 ->
110− fail "invalid time zone offset"
111− | otherwise ->
112− let !tz = Local.minutesToTimeZone off
113− in return (Just tz)
114−
115−-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
116−-- The space may be replaced with a @T@. The number of seconds is optional
117−-- and may be followed by a fractional component.
118−localTime :: Parser Local.LocalTime
119−localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay
120− where daySep = satisfy (\c -> c == 'T' || c == ' ')
121−
122−-- | Behaves as 'zonedTime', but converts any time zone offset into a
123−-- UTC time.
124−utcTime :: Parser UTCTime
125−utcTime = do
126− lt@(Local.LocalTime d t) <- localTime
127− mtz <- timeZone
128− case mtz of
129− Nothing -> let !tt = Local.timeOfDayToTime t
130− in return (UTCTime d tt)
131− Just tz -> return $! Local.localTimeToUTC tz lt
132−
133−-- | Parse a date with time zone info. Acceptable formats:
134−--
135−-- @YYYY-MM-DD HH:MM Z@
136−-- @YYYY-MM-DD HH:MM:SS Z@
137−-- @YYYY-MM-DD HH:MM:SS.SSS Z@
138−--
139−-- The first space may instead be a @T@, and the second space is
140−-- optional. The @Z@ represents UTC. The @Z@ may be replaced with a
141−-- time zone offset of the form @+0000@ or @-08:00@, where the first
142−-- two digits are hours, the @:@ is optional and the second two digits
143−-- (also optional) are minutes.
144−zonedTime :: Parser Local.ZonedTime
145−zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
146−
147−utc :: Local.TimeZone
148−utc = Local.TimeZone 0 False ""
attoparsec-iso8601/Data/Attoparsec/Time/Internal.hsdeleted−64
@@ -1,64 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−-- |
4−-- Module: Data.Aeson.Internal.Time
5−-- Copyright: (c) 2015-2016 Bryan O'Sullivan
6−-- License: BSD3
7−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8−-- Stability: experimental
9−-- Portability: portable
10−
11−module Data.Attoparsec.Time.Internal
12− (
13− TimeOfDay64(..)
14− , fromPico
15− , toPico
16− , diffTimeOfDay64
17− , toTimeOfDay64
18− ) where
19−
20−import Prelude.Compat
21−
22−import Data.Int (Int64)
23−import Data.Time
24−import Unsafe.Coerce (unsafeCoerce)
25−
26−#if MIN_VERSION_time(1,6,0)
27−
28−import Data.Time.Clock (diffTimeToPicoseconds)
29−
30−#endif
31−
32−import Data.Fixed (Pico, Fixed(MkFixed))
33−
34−#if !MIN_VERSION_time(1,6,0)
35−
36−diffTimeToPicoseconds :: DiffTime -> Integer
37−diffTimeToPicoseconds = unsafeCoerce
38−
39−#endif
40−
41−toPico :: Integer -> Pico
42−toPico = MkFixed
43−
44−fromPico :: Pico -> Integer
45−fromPico (MkFixed i) = i
46−
47−-- | Like TimeOfDay, but using a fixed-width integer for seconds.
48−data TimeOfDay64 = TOD {-# UNPACK #-} !Int
49− {-# UNPACK #-} !Int
50− {-# UNPACK #-} !Int64
51−
52−posixDayLength :: DiffTime
53−posixDayLength = 86400
54−
55−diffTimeOfDay64 :: DiffTime -> TimeOfDay64
56−diffTimeOfDay64 t
57− | t >= posixDayLength = TOD 23 59 (60000000000000 + pico (t - posixDayLength))
58− | otherwise = TOD (fromIntegral h) (fromIntegral m) s
59− where (h,mp) = pico t `quotRem` 3600000000000000
60− (m,s) = mp `quotRem` 60000000000000
61− pico = fromIntegral . diffTimeToPicoseconds
62−
63−toTimeOfDay64 :: TimeOfDay -> TimeOfDay64
64−toTimeOfDay64 (TimeOfDay h m s) = TOD h m (fromIntegral (fromPico s))
attoparsec-iso8601/LICENSEdeleted−30
@@ -1,30 +0,0 @@
1−Copyright (c) 2011, MailRank, Inc.
2−
3−All rights reserved.
4−
5−Redistribution and use in source and binary forms, with or without
6−modification, are permitted provided that the following conditions
7−are met:
8−
9−1. Redistributions of source code must retain the above copyright
10− notice, this list of conditions and the following disclaimer.
11−
12−2. Redistributions in binary form must reproduce the above copyright
13− notice, this list of conditions and the following disclaimer in the
14− documentation and/or other materials provided with the distribution.
15−
16−3. Neither the name of the author nor the names of his contributors
17− may be used to endorse or promote products derived from this software
18− without specific prior written permission.
19−
20−THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
21−OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
22−WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23−DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
24−ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25−DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
26−OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
27−HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
28−STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
29−ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30−POSSIBILITY OF SUCH DAMAGE.
attoparsec-iso8601/README.mddeleted−19
@@ -1,19 +0,0 @@
1−Parsing of ISO 8601 dates.
2−
3−This package is used to parse dates in aeson. It is split into a
4−separate package to be shared by other projects that want to parse
5−dates like aeson does.
6−
7−For now, this project is located in the aeson repository and aeson
8−itself uses the source of this package without pulling in the package
9−as a dependency.
10−
11−## Stability
12−
13−Since aeson depends on this package we want to be very careful about
14−changing the format.
15−
16−There may be breaking changes if we find that the format is
17−incorrectly too lenient. We consider widening of the allowed input a
18−non-breaking addition since all previously valid input will still
19−parse correctly.
attoparsec-iso8601/attoparsec-iso8601.cabaldeleted−55
@@ -1,55 +0,0 @@
1−name: attoparsec-iso8601
2−version: 1.0.1.0
3−synopsis: Parsing of ISO 8601 dates, originally from aeson.
4−description: Parsing of ISO 8601 dates, originally from aeson.
5−license: BSD3
6−license-file: LICENSE
7−category: Parsing
8−copyright: (c) 2011-2016 Bryan O'Sullivan
9− (c) 2011 MailRank, Inc.
10−author: Bryan O'Sullivan <bos@serpentine.com>
11−maintainer: Adam Bergmark <adam@bergmark.nl>
12−stability: experimental
13−cabal-version: >=1.10
14−homepage: https://github.com/bos/aeson
15−bug-reports: https://github.com/bos/aeson/issues
16−build-type: Simple
17−extra-source-files:
18− README.md
19−
20−flag developer
21− description: operate in developer mode
22− default: False
23− manual: True
24−
25−flag fast
26− description: compile without optimizations
27− default: False
28− manual: True
29−
30−library
31− hs-source-dirs: .
32− default-language: Haskell2010
33− ghc-options: -Wall
34− exposed-modules:
35− Data.Attoparsec.Time.Internal
36− Data.Attoparsec.Time
37− build-depends:
38− attoparsec >= 0.13.0.1,
39− base >= 4.7 && < 5,
40− base-compat >= 0.9.1 && < 0.12,
41− text >= 1.1.1.0,
42− time >= 1.1.1.4
43−
44− if flag(fast)
45− ghc-options: -O0
46− else
47− ghc-options: -O2
48−
49− if flag(developer)
50− ghc-options: -Werror
51− ghc-prof-options: -auto-all
52−
53−source-repository head
54− type: git
55− location: git://github.com/bos/aeson.git
attoparsec-iso8601/changelog.mddeleted−5
@@ -1,5 +0,0 @@
1−For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/attoparsec-iso8601/changelog.md](https://github.com/bos/aeson/blob/master/attoparsec-iso8601/changelog.md).
2−
3−### 1.0.1.0
4−
5−* Fixes handling of `UTCTime` wrt. leap seconds , thanks to Adam Schønemann
benchmarks/AesonCompareAutoInstances.hsnew file+231
@@ -0,0 +1,231 @@
1+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TemplateHaskell #-}
2+
3+module Main where
4+
5+--------------------------------------------------------------------------------
6+
7+import Criterion.Main hiding (defaultOptions)
8+
9+import Control.DeepSeq (NFData, rnf, deepseq)
10+
11+import Data.Typeable (Typeable)
12+import Data.Data (Data)
13+import GHC.Generics (Generic)
14+
15+import Data.Aeson.Types
16+import Data.Aeson.TH
17+import qualified Data.Aeson.Generic as G (fromJSON, toJSON)
18+
19+import Data.Aeson.Encode
20+
21+import Options
22+
23+--------------------------------------------------------------------------------
24+
25+data D a = Nullary
26+ | Unary Int
27+ | Product String Char a
28+ | Record { testOne :: Double
29+ , testTwo :: Bool
30+ , testThree :: D a
31+ }
32+ deriving (Show, Eq, Data, Typeable)
33+
34+deriveJSON opts ''D
35+
36+instance NFData a => NFData (D a) where
37+ rnf Nullary = ()
38+ rnf (Unary n) = rnf n
39+ rnf (Product s c x) = s `deepseq` c `deepseq` rnf x
40+ rnf (Record d b y) = d `deepseq` b `deepseq` rnf y
41+
42+type T = D (D (D ()))
43+
44+d :: T
45+d = Record
46+ { testOne = 1234.56789
47+ , testTwo = True
48+ , testThree = Product "Hello World!" 'a' $
49+ Record
50+ { testOne = 9876.54321
51+ , testTwo = False
52+ , testThree = Product "Yeehaa!!!" '\n' Nullary
53+ }
54+ }
55+
56+--------------------------------------------------------------------------------
57+
58+data D' a = Nullary'
59+ | Unary' Int
60+ | Product' String Char a
61+ | Record' { testOne' :: Double
62+ , testTwo' :: Bool
63+ , testThree' :: D' a
64+ }
65+ deriving (Show, Eq, Generic, Data, Typeable)
66+
67+instance ToJSON a => ToJSON (D' a) where
68+ toJSON = genericToJSON opts
69+
70+instance FromJSON a => FromJSON (D' a) where
71+ parseJSON = genericParseJSON opts
72+
73+instance NFData a => NFData (D' a) where
74+ rnf Nullary' = ()
75+ rnf (Unary' n) = rnf n
76+ rnf (Product' s c x) = s `deepseq` c `deepseq` rnf x
77+ rnf (Record' d b y) = d `deepseq` b `deepseq` rnf y
78+
79+type T' = D' (D' (D' ()))
80+
81+d' :: T'
82+d' = Record'
83+ { testOne' = 1234.56789
84+ , testTwo' = True
85+ , testThree' = Product' "Hello World!" 'a' $
86+ Record'
87+ { testOne' = 9876.54321
88+ , testTwo' = False
89+ , testThree' = Product' "Yeehaa!!!" '\n' Nullary'
90+ }
91+ }
92+
93+--------------------------------------------------------------------------------
94+
95+data BigRecord = BigRecord
96+ { field01 :: !Int, field02 :: !Int, field03 :: !Int, field04 :: !Int, field05 :: !Int
97+ , field06 :: !Int, field07 :: !Int, field08 :: !Int, field09 :: !Int, field10 :: !Int
98+ , field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
99+ , field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
100+ , field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
101+ } deriving (Show, Eq, Generic, Data, Typeable)
102+
103+instance NFData BigRecord
104+
105+bigRecord = BigRecord 1 2 3 4 5
106+ 6 7 8 9 10
107+ 11 12 13 14 15
108+ 16 17 18 19 20
109+ 21 22 23 24 25
110+
111+gBigRecordToJSON :: BigRecord -> Value
112+gBigRecordToJSON = genericToJSON opts
113+
114+gBigRecordFromJSON :: Value -> Result BigRecord
115+gBigRecordFromJSON = parse $ genericParseJSON opts
116+
117+thBigRecordToJSON :: BigRecord -> Value
118+thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
119+
120+thBigRecordFromJSON :: Value -> Result BigRecord
121+thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
122+
123+--------------------------------------------------------------------------------
124+
125+data BigProduct = BigProduct
126+ !Int !Int !Int !Int !Int
127+ !Int !Int !Int !Int !Int
128+ !Int !Int !Int !Int !Int
129+ !Int !Int !Int !Int !Int
130+ !Int !Int !Int !Int !Int
131+ deriving (Show, Eq, Generic, Data, Typeable)
132+
133+instance NFData BigProduct
134+
135+bigProduct = BigProduct 1 2 3 4 5
136+ 6 7 8 9 10
137+ 11 12 13 14 15
138+ 16 17 18 19 20
139+ 21 22 23 24 25
140+
141+gBigProductToJSON :: BigProduct -> Value
142+gBigProductToJSON = genericToJSON opts
143+
144+gBigProductFromJSON :: Value -> Result BigProduct
145+gBigProductFromJSON = parse $ genericParseJSON opts
146+
147+thBigProductToJSON :: BigProduct -> Value
148+thBigProductToJSON = $(mkToJSON opts ''BigProduct)
149+
150+thBigProductFromJSON :: Value -> Result BigProduct
151+thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
152+
153+--------------------------------------------------------------------------------
154+
155+data BigSum = F01 | F02 | F03 | F04 | F05
156+ | F06 | F07 | F08 | F09 | F10
157+ | F11 | F12 | F13 | F14 | F15
158+ | F16 | F17 | F18 | F19 | F20
159+ | F21 | F22 | F23 | F24 | F25
160+ deriving (Show, Eq, Generic, Data, Typeable)
161+
162+instance NFData BigSum
163+
164+bigSum = F25
165+
166+gBigSumToJSON :: BigSum -> Value
167+gBigSumToJSON = genericToJSON opts
168+
169+gBigSumFromJSON :: Value -> Result BigSum
170+gBigSumFromJSON = parse $ genericParseJSON opts
171+
172+thBigSumToJSON :: BigSum -> Value
173+thBigSumToJSON = $(mkToJSON opts ''BigSum)
174+
175+thBigSumFromJSON :: Value -> Result BigSum
176+thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
177+
178+--------------------------------------------------------------------------------
179+
180+type FJ a = Value -> Result a
181+
182+main :: IO ()
183+main = defaultMain
184+ [ let v = toJSON d
185+ in (d, d', v) `deepseq`
186+ bgroup "D"
187+ [ group "toJSON" (nf toJSON d)
188+ (nf G.toJSON d)
189+ (nf toJSON d')
190+ , group "fromJSON" (nf ( fromJSON :: FJ T ) v)
191+ (nf (G.fromJSON :: FJ T ) v)
192+ (nf ( fromJSON :: FJ T') v)
193+ ]
194+ , let v = thBigRecordToJSON bigRecord
195+ in bigRecord `deepseq` v `deepseq`
196+ bgroup "BigRecord"
197+ [ group "toJSON" (nf thBigRecordToJSON bigRecord)
198+ (nf G.toJSON bigRecord)
199+ (nf gBigRecordToJSON bigRecord)
200+ , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
201+ (nf (G.fromJSON :: FJ BigRecord) v)
202+ (nf (gBigRecordFromJSON :: FJ BigRecord) v)
203+ ]
204+ , let v = thBigProductToJSON bigProduct
205+ in bigProduct `deepseq` v `deepseq`
206+ bgroup "BigProduct"
207+ [ group "toJSON" (nf thBigProductToJSON bigProduct)
208+ (nf G.toJSON bigProduct)
209+ (nf gBigProductToJSON bigProduct)
210+ , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
211+ (nf (G.fromJSON :: FJ BigProduct) v)
212+ (nf (gBigProductFromJSON :: FJ BigProduct) v)
213+ ]
214+ , let v = thBigSumToJSON bigSum
215+ in bigSum `deepseq` v `deepseq`
216+ bgroup "BigSum"
217+ [ group "toJSON" (nf thBigSumToJSON bigSum)
218+ (nf G.toJSON bigSum)
219+ (nf gBigSumToJSON bigSum)
220+ , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
221+ (nf (G.fromJSON :: FJ BigSum) v)
222+ (nf (gBigSumFromJSON :: FJ BigSum) v)
223+ ]
224+ ]
225+
226+group n th syb gen = bcompare
227+ [ bgroup n [ bench "th" th
228+ , bench "syb" syb
229+ , bench "generic" gen
230+ ]
231+ ]
benchmarks/AesonEncode.hs+7−13
@@ -1,20 +1,15 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE OverloadedStrings #-}
4
2
5−module Main (main) where
6−
7−import Prelude.Compat
8−
9−import Control.DeepSeq
3+import Control.Exception
10−import Control.Monad (forM_)
4+import Control.Monad
11import Data.Aeson
5import Data.Aeson
12−import Data.Attoparsec.ByteString (IResult(..), parseWith)
6+import Data.Attoparsec (IResult(..), parseWith)
13import Data.Char (isDigit)
7import Data.Char (isDigit)
14import Data.Time.Clock
8import Data.Time.Clock
15import System.Environment (getArgs)
9import System.Environment (getArgs)
16import System.IO
10import System.IO
17import qualified Data.ByteString as B
11import qualified Data.ByteString as B
12+import Control.DeepSeq
18
13
19main :: IO ()
14main :: IO ()
20main = do
15main = do
@@ -22,9 +17,8 @@ main = do
22 let (cnt,args) = case args0 of
17 let (cnt,args) = case args0 of
23 (i:c:a) | all isDigit i && all isDigit c -> (c,a)
18 (i:c:a) | all isDigit i && all isDigit c -> (c,a)
24 (c:a) -> (c,a)
19 (c:a) -> (c,a)
25− [] -> error "Unexpected empty list"
26 let count = read cnt :: Int
20 let count = read cnt :: Int
27− forM_ args $ \arg -> withFile arg ReadMode $ \h -> do
21+ forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
28 putStrLn $ arg ++ ":"
22 putStrLn $ arg ++ ":"
29 let refill = B.hGet h 16384
23 let refill = B.hGet h 16384
30 result0 <- parseWith refill json =<< refill
24 result0 <- parseWith refill json =<< refill
@@ -34,7 +28,7 @@ main = do
34 start <- getCurrentTime
28 start <- getCurrentTime
35 let loop !n r
29 let loop !n r
36 | n >= count = return ()
30 | n >= count = return ()
37− | otherwise = {-# SCC "loop" #-}
31+ | otherwise = {-# SCC "loop" #-} do
38 rnf (encode r) `seq` loop (n+1) r
32 rnf (encode r) `seq` loop (n+1) r
39 loop 0 r0
33 loop 0 r0
40 delta <- flip diffUTCTime start `fmap` getCurrentTime
34 delta <- flip diffUTCTime start `fmap` getCurrentTime
benchmarks/AesonFoldable.hsdeleted−86
@@ -1,86 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−module Main (main) where
5−
6−import Criterion.Main
7−
8−import Prelude.Compat
9−
10−import Data.Foldable (toList)
11−import qualified Data.Aeson as A
12−import qualified Data.Sequence as S
13−import qualified Data.Vector as V
14−import qualified Data.Vector.Unboxed as U
15−
16−-------------------------------------------------------------------------------
17−-- List
18−-------------------------------------------------------------------------------
19−
20−newtype L f = L { getL :: f Int }
21−
22−instance Foldable f => A.ToJSON (L f) where
23− toJSON = error "do not use this"
24− toEncoding = A.toEncoding . toList . getL
25−
26−-------------------------------------------------------------------------------
27−-- Foldable
28−-------------------------------------------------------------------------------
29−
30−newtype F f = F { getF :: f Int }
31−
32−instance Foldable f => A.ToJSON (F f) where
33− toJSON = error "do not use this"
34− toEncoding = A.foldable . getF
35−
36−-------------------------------------------------------------------------------
37−-- Values
38−-------------------------------------------------------------------------------
39−
40−valueList :: [Int]
41−valueList = [1..1000]
42−
43−valueSeq :: S.Seq Int
44−valueSeq = S.fromList valueList
45−
46−valueVector :: V.Vector Int
47−valueVector = V.fromList valueList
48−
49−valueUVector :: U.Vector Int
50−valueUVector = U.fromList valueList
51−
52−-------------------------------------------------------------------------------
53−-- Main
54−-------------------------------------------------------------------------------
55−
56−benchEncode
57− :: A.ToJSON a
58− => String
59− -> a
60− -> Benchmark
61−benchEncode name val
62− = bench ("A " ++ name) $ nf A.encode val
63−
64−main :: IO ()
65−main = defaultMain
66− [ bgroup "encode"
67− [ bgroup "List"
68− [ benchEncode "-" valueList
69− , benchEncode "L" $ L valueList
70− , benchEncode "F" $ F valueList
71− ]
72− , bgroup "Seq"
73− [ benchEncode "-" valueSeq
74− , benchEncode "L" $ L valueSeq
75− , benchEncode "F" $ F valueSeq
76− ]
77− , bgroup "Vector"
78− [ benchEncode "-" valueVector
79− , benchEncode "L" $ L valueVector
80− , benchEncode "F" $ F valueVector
81− ]
82− , bgroup "Vector.Unboxed"
83− [ benchEncode "-" valueUVector
84− ]
85− ]
86− ]
benchmarks/AesonMap.hsdeleted−214
@@ -1,214 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE RankNTypes #-}
4−
5−{-# OPTIONS_GHC -fno-warn-orphans #-}
6−
7−module Main (main) where
8−
9−import Prelude.Compat
10−
11−import Control.DeepSeq
12−import Criterion.Main
13−import Data.Hashable
14−import Data.Proxy (Proxy (..))
15−import Data.Tagged (Tagged (..))
16−import Data.Aeson
17−import Data.Aeson.Types (fromJSONKeyCoerce)
18−import qualified Data.ByteString.Lazy as LBS
19−import qualified Data.HashMap.Strict as HM
20−import qualified Data.Map as M
21−import qualified Data.Text as T
22−
23−value :: Int -> HM.HashMap T.Text T.Text
24−value n = HM.fromList $ map f [1..n]
25− where
26− f m = let t = T.pack (show m) in (t, t)
27−
28−-------------------------------------------------------------------------------
29−-- Orphans
30−-------------------------------------------------------------------------------
31−
32−instance Hashable b => Hashable (Tagged a b) where
33− hashWithSalt salt (Tagged a) = hashWithSalt salt a
34−
35−-------------------------------------------------------------------------------
36−-- Text
37−-------------------------------------------------------------------------------
38−
39−newtype T1 = T1 T.Text
40− deriving (Eq, Ord)
41−
42−instance NFData T1 where
43− rnf (T1 t) = rnf t
44−instance Hashable T1 where
45− hashWithSalt salt (T1 t) = hashWithSalt salt t
46−
47−instance FromJSON T1 where
48− parseJSON = withText "T1" $ pure . T1
49−instance FromJSONKey T1 where
50− fromJSONKey = FromJSONKeyText T1
51−
52−-------------------------------------------------------------------------------
53−-- Coerce
54−-------------------------------------------------------------------------------
55−
56−newtype T2 = T2 T.Text
57− deriving (Eq, Ord)
58−
59−instance NFData T2 where
60− rnf (T2 t) = rnf t
61−instance Hashable T2 where
62− hashWithSalt salt (T2 t) = hashWithSalt salt t
63−
64−instance FromJSON T2 where
65− parseJSON = withText "T2" $ pure . T2
66−instance FromJSONKey T2 where
67− fromJSONKey = fromJSONKeyCoerce
68−
69−-------------------------------------------------------------------------------
70−-- TextParser
71−-------------------------------------------------------------------------------
72−
73−newtype T3 = T3 T.Text
74− deriving (Eq, Ord)
75−
76−instance NFData T3 where
77− rnf (T3 t) = rnf t
78−instance Hashable T3 where
79− hashWithSalt salt (T3 t) = hashWithSalt salt t
80−
81−instance FromJSON T3 where
82− parseJSON = withText "T3" $ pure . T3
83−instance FromJSONKey T3 where
84− fromJSONKey = FromJSONKeyTextParser (pure . T3)
85−
86−-------------------------------------------------------------------------------
87−-- Values
88−-------------------------------------------------------------------------------
89−
90−value10, value100, value1000, value10000 :: HM.HashMap T.Text T.Text
91−value10 = value 10
92−value100 = value 100
93−value1000 = value 1000
94−value10000 = value 10000
95−
96−encodedValue10 :: LBS.ByteString
97−encodedValue10 = encode value10
98−
99−encodedValue100 :: LBS.ByteString
100−encodedValue100 = encode value100
101−
102−encodedValue1000 :: LBS.ByteString
103−encodedValue1000 = encode value1000
104−
105−encodedValue10000 :: LBS.ByteString
106−encodedValue10000 = encode value10000
107−
108−-------------------------------------------------------------------------------
109−-- Helpers
110−-------------------------------------------------------------------------------
111−
112−decodeHM
113− :: (FromJSON (HM.HashMap k T.Text), Eq k, Hashable k)
114− => Proxy k -> LBS.ByteString -> Maybe (HM.HashMap k T.Text)
115−decodeHM _ = decode
116−
117−decodeMap
118− :: (FromJSON (M.Map k T.Text), Ord k)
119− => Proxy k -> LBS.ByteString -> Maybe (M.Map k T.Text)
120−decodeMap _ = decode
121−
122−proxyText :: Proxy T.Text
123−proxyText = Proxy
124−
125−proxyT1 :: Proxy T1
126−proxyT1 = Proxy
127−
128−proxyT2 :: Proxy T2
129−proxyT2 = Proxy
130−
131−proxyT3 :: Proxy T3
132−proxyT3 = Proxy
133−
134−proxyTagged :: Proxy a -> Proxy (Tagged () a)
135−proxyTagged _ = Proxy
136−
137−-------------------------------------------------------------------------------
138−-- Main
139−-------------------------------------------------------------------------------
140−
141−benchDecodeHM
142− :: String
143− -> LBS.ByteString
144− -> Benchmark
145−benchDecodeHM name val = bgroup name
146− [ bench "Text" $ nf (decodeHM proxyText) val
147− , bench "Identity" $ nf (decodeHM proxyT1) val
148− , bench "Coerce" $ nf (decodeHM proxyT2) val
149− , bench "Parser" $ nf (decodeHM proxyT3) val
150− , bench "Tagged Text" $ nf (decodeHM $ proxyTagged proxyText) val
151− , bench "Tagged Identity" $ nf (decodeHM $ proxyTagged proxyT1) val
152− , bench "Tagged Coerce" $ nf (decodeHM $ proxyTagged proxyT2) val
153− , bench "Tagged Parser" $ nf (decodeHM $ proxyTagged proxyT3) val
154− ]
155−
156−benchDecodeMap
157− :: String
158− -> LBS.ByteString
159− -> Benchmark
160−benchDecodeMap name val = bgroup name
161− [ bench "Text" $ nf (decodeMap proxyText) val
162− , bench "Identity" $ nf (decodeMap proxyT1) val
163− , bench "Coerce" $ nf (decodeMap proxyT2) val
164− , bench "Parser" $ nf (decodeMap proxyT3) val
165− ]
166−
167−benchEncodeHM
168− :: String
169− -> HM.HashMap T.Text T.Text
170− -> Benchmark
171−benchEncodeHM name val = bgroup name
172− [ bench "Text" $ nf encode val
173− ]
174−
175−benchEncodeMap
176− :: String
177− -> HM.HashMap T.Text T.Text
178− -> Benchmark
179−benchEncodeMap name val = bgroup name
180− [ bench "Text" $ nf encode val'
181− ]
182− where
183− val' :: M.Map T.Text T.Text
184− val' = M.fromList . HM.toList $ val
185−
186−main :: IO ()
187−main = defaultMain
188− [ bgroup "decode"
189− [ bgroup "HashMap"
190− [ benchDecodeHM "10" encodedValue10
191− , benchDecodeHM "100" encodedValue100
192− , benchDecodeHM "1000" encodedValue1000
193− , benchDecodeHM "10000" encodedValue10000
194− ]
195− , bgroup "Map"
196− [ benchDecodeMap "10" encodedValue10
197− , benchDecodeMap "100" encodedValue100
198− , benchDecodeMap "1000" encodedValue1000
199− , benchDecodeMap "10000" encodedValue10000
200− ]
201− ]
202− , bgroup "encode"
203− [ bgroup "HashMap"
204− [ benchEncodeHM "100" value100
205− , benchEncodeHM "1000" value1000
206− , benchEncodeHM "10000" value10000
207− ]
208− , bgroup "Map"
209− [ benchEncodeMap "100" value100
210− , benchEncodeMap "1000" value1000
211− , benchEncodeMap "10000" value10000
212− ]
213− ]
214− ]
benchmarks/AesonParse.hs+5−10
@@ -1,14 +1,9 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE OverloadedStrings #-}
4
2
5−module Main (main) where
3+import Control.Exception
6−
7−import Prelude.Compat
8−
9−import Data.Aeson
10import Control.Monad
4import Control.Monad
5+import Data.Aeson
11−import Data.Attoparsec.ByteString (IResult(..), parseWith)
6+import Data.Attoparsec (IResult(..), parseWith)
12import Data.Time.Clock
7import Data.Time.Clock
13import System.Environment (getArgs)
8import System.Environment (getArgs)
14import System.IO
9import System.IO
@@ -19,7 +14,7 @@ main = do
19 (bs:cnt:args) <- getArgs
14 (bs:cnt:args) <- getArgs
20 let count = read cnt :: Int
15 let count = read cnt :: Int
21 blkSize = read bs
16 blkSize = read bs
22− forM_ args $ \arg -> withFile arg ReadMode $ \h -> do
17+ forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
23 putStrLn $ arg ++ ":"
18 putStrLn $ arg ++ ":"
24 start <- getCurrentTime
19 start <- getCurrentTime
25 let loop !good !bad
20 let loop !good !bad
benchmarks/AesonTuples.hs+3−5
@@ -1,11 +1,9 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+module Main where
2
2
3−module Main (main) where
3+--------------------------------------------------------------------------------
4−
5−import Prelude.Compat
6
4
7−import Control.DeepSeq (deepseq)
8import Criterion.Main
5import Criterion.Main
6+import Control.DeepSeq (deepseq)
9import Data.Aeson
7import Data.Aeson
10
8
11--------------------------------------------------------------------------------
9--------------------------------------------------------------------------------
benchmarks/Auto/G/BigProduct.hsdeleted−33
@@ -1,33 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−
3−module Auto.G.BigProduct where
4−
5−import Control.DeepSeq
6−import Data.Aeson
7−import GHC.Generics (Generic)
8−import Options
9−
10−data BigProduct = BigProduct
11− !Int !Int !Int !Int !Int
12− !Int !Int !Int !Int !Int
13− !Int !Int !Int !Int !Int
14− !Int !Int !Int !Int !Int
15− !Int !Int !Int !Int !Int
16− deriving (Show, Eq, Generic)
17−
18−instance NFData BigProduct where
19− rnf a = a `seq` ()
20−
21−instance ToJSON BigProduct where
22− toJSON = genericToJSON opts
23− toEncoding = genericToEncoding opts
24−
25−instance FromJSON BigProduct where
26− parseJSON = genericParseJSON opts
27−
28−bigProduct :: BigProduct
29−bigProduct = BigProduct 1 2 3 4 5
30− 6 7 8 9 10
31− 11 12 13 14 15
32− 16 17 18 19 20
33− 21 22 23 24 25
benchmarks/Auto/G/BigRecord.hsdeleted−33
@@ -1,33 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−
3−module Auto.G.BigRecord where
4−
5−import Control.DeepSeq
6−import Data.Aeson
7−import GHC.Generics (Generic)
8−import Options
9−
10−data BigRecord = BigRecord
11− { field01 :: !Int, field02 :: !Int, field03 :: !Int, field04 :: !Int, field05 :: !Int
12− , field06 :: !Int, field07 :: !Int, field08 :: !Int, field09 :: !Int, field10 :: !Int
13− , field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
14− , field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
15− , field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
16− } deriving (Show, Eq, Generic)
17−
18−instance NFData BigRecord where
19− rnf a = a `seq` ()
20−
21−instance ToJSON BigRecord where
22− toJSON = genericToJSON opts
23− toEncoding = genericToEncoding opts
24−
25−instance FromJSON BigRecord where
26− parseJSON = genericParseJSON opts
27−
28−bigRecord :: BigRecord
29−bigRecord = BigRecord 1 2 3 4 5
30− 6 7 8 9 10
31− 11 12 13 14 15
32− 16 17 18 19 20
33− 21 22 23 24 25
benchmarks/Auto/G/BigSum.hsdeleted−28
@@ -1,28 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−
3−module Auto.G.BigSum where
4−
5−import Control.DeepSeq
6−import Data.Aeson
7−import GHC.Generics (Generic)
8−import Options
9−
10−data BigSum = F01 | F02 | F03 | F04 | F05
11− | F06 | F07 | F08 | F09 | F10
12− | F11 | F12 | F13 | F14 | F15
13− | F16 | F17 | F18 | F19 | F20
14− | F21 | F22 | F23 | F24 | F25
15− deriving (Show, Eq, Generic)
16−
17−instance NFData BigSum where
18− rnf a = a `seq` ()
19−
20−instance ToJSON BigSum where
21− toJSON = genericToJSON opts
22− toEncoding = genericToEncoding opts
23−
24−instance FromJSON BigSum where
25− parseJSON = genericParseJSON opts
26−
27−bigSum :: BigSum
28−bigSum = F25
benchmarks/Auto/G/D.hsdeleted−44
@@ -1,44 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−
3−module Auto.G.D where
4−
5−import Control.DeepSeq
6−import Data.Aeson
7−import GHC.Generics (Generic)
8−import Options
9−
10−data D a = Nullary
11− | Unary Int
12− | Product String Char a
13− | Record { testOne :: Double
14− , testTwo :: Bool
15− , testThree :: D a
16− }
17− deriving (Show, Eq, Generic)
18−
19−instance NFData a => NFData (D a) where
20− rnf Nullary = ()
21− rnf (Unary n) = rnf n
22− rnf (Product s c x) = s `deepseq` c `deepseq` rnf x
23− rnf (Record a b y) = a `deepseq` b `deepseq` rnf y
24−
25−instance ToJSON a => ToJSON (D a) where
26− toJSON = genericToJSON opts
27− toEncoding = genericToEncoding opts
28−
29−instance FromJSON a => FromJSON (D a) where
30− parseJSON = genericParseJSON opts
31−
32−type T = D (D (D ()))
33−
34−d :: T
35−d = Record
36− { testOne = 1234.56789
37− , testTwo = True
38− , testThree = Product "Hello World!" 'a'
39− Record
40− { testOne = 9876.54321
41− , testTwo = False
42− , testThree = Product "Yeehaa!!!" '\n' Nullary
43− }
44− }
benchmarks/Auto/T/BigProduct.hsdeleted−27
@@ -1,27 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Auto.T.BigProduct where
4−
5−import Control.DeepSeq
6−import Data.Aeson.TH
7−import Options
8−
9−data BigProduct = BigProduct
10− !Int !Int !Int !Int !Int
11− !Int !Int !Int !Int !Int
12− !Int !Int !Int !Int !Int
13− !Int !Int !Int !Int !Int
14− !Int !Int !Int !Int !Int
15− deriving (Show, Eq)
16−
17−instance NFData BigProduct where
18− rnf a = a `seq` ()
19−
20−deriveJSON opts ''BigProduct
21−
22−bigProduct :: BigProduct
23−bigProduct = BigProduct 1 2 3 4 5
24− 6 7 8 9 10
25− 11 12 13 14 15
26− 16 17 18 19 20
27− 21 22 23 24 25
benchmarks/Auto/T/BigRecord.hsdeleted−27
@@ -1,27 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Auto.T.BigRecord where
4−
5−import Control.DeepSeq
6−import Data.Aeson.TH
7−import Options
8−
9−data BigRecord = BigRecord
10− { field01 :: !Int, field02 :: !Int, field03 :: !Int, field04 :: !Int, field05 :: !Int
11− , field06 :: !Int, field07 :: !Int, field08 :: !Int, field09 :: !Int, field10 :: !Int
12− , field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
13− , field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
14− , field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
15− } deriving (Show, Eq)
16−
17−instance NFData BigRecord where
18− rnf a = a `seq` ()
19−
20−deriveJSON opts ''BigRecord
21−
22−bigRecord :: BigRecord
23−bigRecord = BigRecord 1 2 3 4 5
24− 6 7 8 9 10
25− 11 12 13 14 15
26− 16 17 18 19 20
27− 21 22 23 24 25
benchmarks/Auto/T/BigSum.hsdeleted−22
@@ -1,22 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Auto.T.BigSum where
4−
5−import Control.DeepSeq
6−import Data.Aeson.TH
7−import Options
8−
9−data BigSum = F01 | F02 | F03 | F04 | F05
10− | F06 | F07 | F08 | F09 | F10
11− | F11 | F12 | F13 | F14 | F15
12− | F16 | F17 | F18 | F19 | F20
13− | F21 | F22 | F23 | F24 | F25
14− deriving (Show, Eq)
15−
16−instance NFData BigSum where
17− rnf a = a `seq` ()
18−
19−deriveJSON opts ''BigSum
20−
21−bigSum :: BigSum
22−bigSum = F25
benchmarks/Auto/T/D.hsdeleted−38
@@ -1,38 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Auto.T.D where
4−
5−import Control.DeepSeq
6−import Data.Aeson.TH
7−import Options
8−
9−data D a = Nullary
10− | Unary Int
11− | Product String Char a
12− | Record { testOne :: Double
13− , testTwo :: Bool
14− , testThree :: D a
15− }
16− deriving (Show, Eq)
17−
18−instance NFData a => NFData (D a) where
19− rnf Nullary = ()
20− rnf (Unary n) = rnf n
21− rnf (Product s c x) = s `deepseq` c `deepseq` rnf x
22− rnf (Record a b y) = a `deepseq` b `deepseq` rnf y
23−
24−deriveJSON opts ''D
25−
26−type T = D (D (D ()))
27−
28−d :: T
29−d = Record
30− { testOne = 1234.56789
31− , testTwo = True
32− , testThree = Product "Hello World!" 'a'
33− Record
34− { testOne = 9876.54321
35− , testTwo = False
36− , testThree = Product "Yeehaa!!!" '\n' Nullary
37− }
38− }
benchmarks/AutoCompare.hsdeleted−73
@@ -1,73 +0,0 @@
1−{-# LANGUAGE RankNTypes #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3−
4−module Main (main) where
5−
6−import Control.DeepSeq
7−import Control.Monad
8−import Criterion.Main
9−import Data.Aeson
10−
11−import qualified Auto.T.D as T
12−import qualified Auto.T.BigRecord as T
13−import qualified Auto.T.BigProduct as T
14−import qualified Auto.T.BigSum as T
15−import qualified Auto.G.D as G
16−import qualified Auto.G.BigRecord as G
17−import qualified Auto.G.BigProduct as G
18−import qualified Auto.G.BigSum as G
19−
20−--------------------------------------------------------------------------------
21−
22−runBench :: IO ()
23−runBench = defaultMain
24− [ compareBench "D" T.d G.d
25− , compareBench "BigRecord" T.bigRecord G.bigRecord
26− , compareBench "BigProduct" T.bigProduct G.bigProduct
27− , compareBench "BigSum" T.bigSum G.bigSum
28− ]
29−
30−group :: String -> Benchmarkable -> Benchmarkable -> Benchmark
31−group n th gen = bgroup n [ bench "th" th
32− , bench "generic" gen
33− ]
34−
35−compareBench
36− :: forall a b
37− . (ToJSON a, FromJSON a, NFData a, ToJSON b, FromJSON b, NFData b)
38− => String -> a -> b -> Benchmark
39−compareBench name a b = v `deepseq` bgroup name
40− [ group "toJSON" (nf toJSON a)
41− (nf toJSON b)
42− , group "encode" (nf encode a)
43− (nf encode b)
44− , group "fromJSON" (nf (fromJSON :: Value -> Result a) v)
45− (nf (fromJSON :: Value -> Result b) v)
46− ] where
47− v = toJSON a -- == toJSON b
48−
49−sanityCheck :: IO ()
50−sanityCheck = do
51− check T.d
52− check G.d
53− check T.bigRecord
54− check G.bigRecord
55− check T.bigProduct
56− check G.bigProduct
57− check T.bigSum
58− check G.bigSum
59−
60−check :: (Show a, Eq a, FromJSON a, ToJSON a)
61− => a -> IO ()
62−check x = do
63− unless (Success x == (fromJSON . toJSON) x) $ fail $ "toJSON: " ++ show x
64− unless (Success x == (decode_ . encode) x) $ fail $ "encode: " ++ show x
65− where
66− decode_ s = case decode s of
67− Just v -> fromJSON v
68− Nothing -> fail ""
69−
70−main :: IO ()
71−main = do
72− sanityCheck
73− runBench
benchmarks/Compare.hsdeleted−35
@@ -1,35 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−
5−module Main (main) where
6−
7−import Prelude.Compat
8−
9−import Compare.BufferBuilder ()
10−import Criterion.Main
11−import Data.BufferBuilder.Json
12−import Twitter
13−import Twitter.Manual ()
14−import Typed.Common
15−import qualified Data.Aeson as Aeson
16−import qualified Compare.JsonBench as JsonBench
17−
18−#ifdef MIN_VERSION_json_builder
19−import Data.Json.Builder
20−import Compare.JsonBuilder ()
21−#endif
22−
23−main :: IO ()
24−main =
25− defaultMain [
26− env (load "json-data/twitter100.json") $ \ ~(twtr :: Result) ->
27− bgroup "twitter" [
28− bench "aeson" $ nf Aeson.encode twtr
29− , bench "buffer-builder" $ nf encodeJson twtr
30−#ifdef MIN_VERSION_json_builder
31− , bench "json-builder" $ nf toJsonLBS twtr
32−#endif
33− ]
34− , JsonBench.benchmarks
35− ]
benchmarks/Compare/BufferBuilder.hsdeleted−64
@@ -1,64 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−
5−{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
6−{-# OPTIONS_GHC -fno-warn-orphans #-}
7−
8−module Compare.BufferBuilder () where
9−
10−import Prelude.Compat hiding ((<>))
11−
12−import Data.BufferBuilder.Json
13−import Data.Int (Int64)
14−import Data.Monoid ((<>))
15−import Twitter
16−import qualified Data.BufferBuilder.Utf8 as UB
17−
18−instance (ToJson a, ToJson b) => ToJson (a,b) where
19− toJson (a,b) = array [toJson a, toJson b]
20−
21−instance ToJson Int64 where
22− toJson a = unsafeValueUtf8Builder $
23− UB.appendDecimalSignedInt (fromIntegral a)
24− {-# INLINE toJson #-}
25−
26−instance ToJson Metadata where
27− toJson Metadata{..} = toJson $
28− "result_type" .= result_type
29−
30−instance ToJson Geo where
31− toJson Geo{..} = toJson $
32− "type_" .= type_
33− <> "coordinates" .= coordinates
34−
35−instance ToJson Story where
36− toJson Story{..} = toJson $
37− "from_user_id_str" .= from_user_id_str
38− <> "profile_image_url" .= profile_image_url
39− <> "created_at" .= created_at
40− <> "from_user" .= from_user
41− <> "id_str" .= id_str
42− <> "metadata" .= metadata
43− <> "to_user_id" .= to_user_id
44− <> "text" .= text
45− <> "id" .= id_
46− <> "from_user_id" .= from_user_id
47− <> "geo" .= geo
48− <> "iso_language_code" .= iso_language_code
49− <> "to_user_id_str" .= to_user_id_str
50− <> "source" .= source
51−
52−instance ToJson Result where
53− toJson Result{..} = toJson $
54− "results" .= results
55− <> "max_id" .= max_id
56− <> "since_id" .= since_id
57− <> "refresh_url" .= refresh_url
58− <> "next_page" .= next_page
59− <> "results_per_page" .= results_per_page
60− <> "page" .= page
61− <> "completed_in" .= completed_in
62− <> "since_id_str" .= since_id_str
63− <> "max_id_str" .= max_id_str
64− <> "query" .= query
benchmarks/Compare/JsonBench.hsdeleted−339
@@ -1,339 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE BangPatterns #-}
3−{-# LANGUAGE MagicHash #-}
4−{-# LANGUAGE NoImplicitPrelude #-}
5−{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE RecordWildCards #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
8−
9−-- Adapted from a buffer-builder benchmark:
10−--
11−-- https://github.com/chadaustin/buffer-builder/blob/master/test.json
12−
13−module Compare.JsonBench (benchmarks) where
14−
15−import Prelude.Compat hiding ((<>))
16−
17−import Control.DeepSeq (NFData(..))
18−import Criterion
19−import Data.Aeson ((.:))
20−import Data.Monoid ((<>))
21−import Data.Text (Text)
22−import Typed.Common (load)
23−import qualified Control.Monad.Fail as Fail
24−import qualified Data.Aeson as Aeson
25−import qualified Data.BufferBuilder.Json as Json
26−
27−#ifdef MIN_VERSION_json_builder
28−import qualified Data.Json.Builder as JB
29−#endif
30−
31−data EyeColor = Green | Blue | Brown
32− deriving (Eq, Show)
33−data Gender = Male | Female
34− deriving (Eq, Show)
35−data Fruit = Apple | Strawberry | Banana
36− deriving (Eq, Show)
37−data Friend = Friend
38− { fId :: !Int
39− , fName :: !Text
40− } deriving (Eq, Show)
41−
42−data User = User
43− { uId :: !Text
44− , uIndex :: !Int
45− , uGuid :: !Text
46− , uIsActive :: !Bool
47− , uBalance :: !Text
48− , uPicture :: !Text
49− , uAge :: !Int
50− , uEyeColor :: !EyeColor
51− , uName :: !Text
52− , uGender :: !Gender
53− , uCompany :: !Text
54− , uEmail :: !Text
55− , uPhone :: !Text
56− , uAddress :: !Text
57− , uAbout :: !Text
58− , uRegistered :: !Text -- UTCTime?
59− , uLatitude :: !Double
60− , uLongitude :: !Double
61− , uTags :: ![Text]
62− , uFriends :: ![Friend]
63− , uGreeting :: !Text
64− , uFavouriteFruit :: !Fruit
65− } deriving (Eq, Show)
66−
67−instance NFData EyeColor where rnf !_ = ()
68−instance NFData Gender where rnf !_ = ()
69−instance NFData Fruit where rnf !_ = ()
70−
71−instance NFData Friend where
72− rnf Friend {..} = rnf fId `seq` rnf fName
73−
74−instance NFData User where
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
76−
77−eyeColorTable :: [(Text, EyeColor)]
78−eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]
79−
80−genderTable :: [(Text, Gender)]
81−genderTable = [("male", Male), ("female", Female)]
82−
83−fruitTable :: [(Text, Fruit)]
84−fruitTable = [("apple", Apple), ("strawberry", Strawberry), ("banana", Banana)]
85−
86−enumFromJson :: Fail.MonadFail m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum
87−enumFromJson enumName table extract v = do
88− s <- extract v
89− case lookup s table of
90− Just r -> return r
91− Nothing -> fail $ "Bad " ++ enumName ++ ": " ++ show s
92−
93−--- Aeson instances ---
94−
95−instance Aeson.FromJSON EyeColor where
96− parseJSON = enumFromJson "EyeColor" eyeColorTable Aeson.parseJSON
97−
98−instance Aeson.FromJSON Gender where
99− parseJSON = enumFromJson "Gender" genderTable Aeson.parseJSON
100−
101−instance Aeson.FromJSON Fruit where
102− parseJSON = enumFromJson "Fruit" fruitTable Aeson.parseJSON
103−
104−instance Aeson.FromJSON Friend where
105− parseJSON = Aeson.withObject "Friend" $ \o -> do
106− fId <- o .: "id"
107− fName <- o .: "name"
108− return Friend {..}
109−
110−instance Aeson.FromJSON User where
111− parseJSON = Aeson.withObject "User" $ \o -> do
112− uId <- o .: "_id"
113− uIndex <- o .: "index"
114− uGuid <- o .: "guid"
115− uIsActive <- o .: "isActive"
116− uBalance <- o .: "balance"
117− uPicture <- o .: "picture"
118− uAge <- o .: "age"
119− uEyeColor <- o .: "eyeColor"
120− uName <- o .: "name"
121− uGender <- o .: "gender"
122− uCompany <- o .: "company"
123− uEmail <- o .: "email"
124− uPhone <- o .: "phone"
125− uAddress <- o .: "address"
126− uAbout <- o .: "about"
127− uRegistered <- o .: "registered"
128− uLatitude <- o .: "latitude"
129− uLongitude <- o .: "longitude"
130− uTags <- o .: "tags"
131− uFriends <- o .: "friends"
132− uGreeting <- o .: "greeting"
133− uFavouriteFruit <- o .: "favoriteFruit"
134− return User {..}
135−
136−instance Aeson.ToJSON EyeColor where
137− toJSON ec = Aeson.toJSON $ case ec of
138− Green -> "green" :: Text
139− Blue -> "blue"
140− Brown -> "brown"
141−
142− toEncoding ec = Aeson.toEncoding $ case ec of
143− Green -> "green" :: Text
144− Blue -> "blue"
145− Brown -> "brown"
146−
147−instance Aeson.ToJSON Gender where
148− toJSON g = Aeson.toJSON $ case g of
149− Male -> "male" :: Text
150− Female -> "female"
151−
152− toEncoding g = Aeson.toEncoding $ case g of
153− Male -> "male" :: Text
154− Female -> "female"
155−
156−instance Aeson.ToJSON Fruit where
157− toJSON f = Aeson.toJSON $ case f of
158− Apple -> "apple" :: Text
159− Banana -> "banana"
160− Strawberry -> "strawberry"
161−
162− toEncoding f = Aeson.toEncoding $ case f of
163− Apple -> "apple" :: Text
164− Banana -> "banana"
165− Strawberry -> "strawberry"
166−
167−instance Aeson.ToJSON Friend where
168− toJSON Friend {..} = Aeson.object
169− [ "id" Aeson..= fId
170− , "name" Aeson..= fName
171− ]
172−
173− toEncoding Friend {..} = Aeson.pairs $
174− "id" Aeson..= fId
175− <> "name" Aeson..= fName
176−
177−instance Aeson.ToJSON User where
178− toJSON User{..} = Aeson.object
179− [ "_id" Aeson..= uId
180− , "index" Aeson..= uIndex
181− , "guid" Aeson..= uGuid
182− , "isActive" Aeson..= uIsActive
183− , "balance" Aeson..= uBalance
184− , "picture" Aeson..= uPicture
185− , "age" Aeson..= uAge
186− , "eyeColor" Aeson..= uEyeColor
187− , "name" Aeson..= uName
188− , "gender" Aeson..= uGender
189− , "company" Aeson..= uCompany
190− , "email" Aeson..= uEmail
191− , "phone" Aeson..= uPhone
192− , "address" Aeson..= uAddress
193− , "about" Aeson..= uAbout
194− , "registered" Aeson..= uRegistered
195− , "latitude" Aeson..= uLatitude
196− , "longitude" Aeson..= uLongitude
197− , "tags" Aeson..= uTags
198− , "friends" Aeson..= uFriends
199− , "greeting" Aeson..= uGreeting
200− , "favoriteFruit" Aeson..= uFavouriteFruit
201− ]
202−
203− toEncoding User{..} = Aeson.pairs $
204− "_id" Aeson..= uId
205− <> "index" Aeson..= uIndex
206− <> "guid" Aeson..= uGuid
207− <> "isActive" Aeson..= uIsActive
208− <> "balance" Aeson..= uBalance
209− <> "picture" Aeson..= uPicture
210− <> "age" Aeson..= uAge
211− <> "eyeColor" Aeson..= uEyeColor
212− <> "name" Aeson..= uName
213− <> "gender" Aeson..= uGender
214− <> "company" Aeson..= uCompany
215− <> "email" Aeson..= uEmail
216− <> "phone" Aeson..= uPhone
217− <> "address" Aeson..= uAddress
218− <> "about" Aeson..= uAbout
219− <> "registered" Aeson..= uRegistered
220− <> "latitude" Aeson..= uLatitude
221− <> "longitude" Aeson..= uLongitude
222− <> "tags" Aeson..= uTags
223− <> "friends" Aeson..= uFriends
224− <> "greeting" Aeson..= uGreeting
225− <> "favoriteFruit" Aeson..= uFavouriteFruit
226−
227−--- BufferBuilder instances ---
228−
229−instance Json.ToJson EyeColor where
230− toJson ec = Json.toJson $ case ec of
231− Green -> "green" :: Text
232− Blue -> "blue"
233− Brown -> "brown"
234−
235−instance Json.ToJson Gender where
236− toJson g = Json.toJson $ case g of
237− Male -> "male" :: Text
238− Female -> "female"
239−
240−instance Json.ToJson Fruit where
241− toJson f = Json.toJson $ case f of
242− Apple -> "apple" :: Text
243− Strawberry -> "strawberry"
244− Banana -> "banana"
245−
246−instance Json.ToJson Friend where
247− toJson Friend{..} = Json.toJson $
248− "_id" Json..= fId
249− <> "name" Json..= fName
250−
251−instance Json.ToJson User where
252− toJson User{..} = Json.toJson $
253− "_id"# Json..=# uId
254− <> "index"# Json..=# uIndex
255− <> "guid"# Json..=# uGuid
256− <> "isActive"# Json..=# uIsActive
257− <> "balance"# Json..=# uBalance
258− <> "picture"# Json..=# uPicture
259− <> "age"# Json..=# uAge
260− <> "eyeColor"# Json..=# uEyeColor
261− <> "name"# Json..=# uName
262− <> "gender"# Json..=# uGender
263− <> "company"# Json..=# uCompany
264− <> "email"# Json..=# uEmail
265− <> "phone"# Json..=# uPhone
266− <> "address"# Json..=# uAddress
267− <> "about"# Json..=# uAbout
268− <> "registered"# Json..=# uRegistered
269− <> "latitude"# Json..=# uLatitude
270− <> "longitude"# Json..=# uLongitude
271− <> "tags"# Json..=# uTags
272− <> "friends"# Json..=# uFriends
273− <> "greeting"# Json..=# uGreeting
274− <> "favoriteFruit"# Json..=# uFavouriteFruit
275−
276−#ifdef MIN_VERSION_json_builder
277−---- json-builder instances ----
278−
279−instance JB.Value EyeColor where
280− toJson ec = JB.toJson $ case ec of
281− Green -> "green" :: Text
282− Blue -> "blue"
283− Brown -> "brown"
284−
285−instance JB.Value Gender where
286− toJson g = JB.toJson $ case g of
287− Male -> "male" :: Text
288− Female -> "female"
289−
290−instance JB.Value Fruit where
291− toJson f = JB.toJson $ case f of
292− Apple -> "apple" :: Text
293− Strawberry -> "strawberry"
294− Banana -> "banana"
295−
296−instance JB.Value Friend where
297− toJson Friend{..} = JB.toJson $
298− ("_id" :: Text) `JB.row` fId
299− <> ("name" :: Text) `JB.row` fName
300−
301−instance JB.Value User where
302− toJson User{..} =
303− let t :: Text -> Text
304− t = id
305− in JB.toJson $
306− t "_id" `JB.row` uId
307− <> t "index" `JB.row` uIndex
308− <> t "guid" `JB.row` uGuid
309− <> t "isActive" `JB.row` uIsActive
310− <> t "balance" `JB.row` uBalance
311− <> t "picture" `JB.row` uPicture
312− <> t "age" `JB.row` uAge
313− <> t "eyeColor" `JB.row` uEyeColor
314− <> t "name" `JB.row` uName
315− <> t "gender" `JB.row` uGender
316− <> t "company" `JB.row` uCompany
317− <> t "email" `JB.row` uEmail
318− <> t "phone" `JB.row` uPhone
319− <> t "address" `JB.row` uAddress
320− <> t "about" `JB.row` uAbout
321− <> t "registered" `JB.row` uRegistered
322− <> t "latitude" `JB.row` uLatitude
323− <> t "longitude" `JB.row` uLongitude
324− <> t "tags" `JB.row` uTags
325− <> t "friends" `JB.row` uFriends
326− <> t "greeting" `JB.row` uGreeting
327− <> t "favoriteFruit" `JB.row` uFavouriteFruit
328−#endif
329−
330−benchmarks :: Benchmark
331−benchmarks = env (load "json-data/buffer-builder.json") $
332− \ ~(parsedUserList :: [User]) ->
333− bgroup "json-bench" [
334− bench "aeson" $ nf Aeson.encode parsedUserList
335− , bench "buffer-builder" $ nf Json.encodeJson parsedUserList
336−#ifdef MIN_VERSION_json_builder
337− , bench "json-builder" $ nf JB.toJsonLBS parsedUserList
338−#endif
339− ]
benchmarks/Compare/JsonBuilder.hsdeleted−68
@@ -1,68 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE RecordWildCards #-}
3−
4−{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
5−{-# OPTIONS_GHC -fno-warn-orphans #-}
6−
7−module Compare.JsonBuilder () where
8−
9−import Prelude.Compat hiding ((<>))
10−
11−import Data.Json.Builder
12−import Data.Monoid ((<>))
13−import Twitter
14−
15−instance JsObject Metadata where
16− toObject Metadata{..} = row "result_type" result_type
17−
18−instance Value Metadata where
19− toJson = toJson . toObject
20−
21−instance JsObject Geo where
22− toObject Geo{..} =
23− row "type_" type_ <>
24− row "coordinates" coordinates
25−
26−instance Value Geo where
27− toJson = toJson . toObject
28−
29−instance Value a => Value (Maybe a) where
30− toJson (Just a) = toJson a
31− toJson Nothing = jsNull
32−
33−instance JsObject Story where
34− toObject Story{..} =
35− row "from_user_id_str" from_user_id_str <>
36− row "profile_image_url" profile_image_url <>
37− row "created_at" created_at <>
38− row "from_user" from_user <>
39− row "id_str" id_str <>
40− row "metadata" metadata <>
41− row "to_user_id" to_user_id <>
42− row "text" text <>
43− row "id" id_ <>
44− row "from_user_id" from_user_id <>
45− row "geo" geo <>
46− row "iso_language_code" iso_language_code <>
47− row "to_user_id_str" to_user_id_str <>
48− row "source" source
49−
50−instance Value Story where
51− toJson = toJson . toObject
52−
53−instance JsObject Result where
54− toObject Result{..} =
55− row "results" results <>
56− row "max_id" max_id <>
57− row "since_id" since_id <>
58− row "refresh_url" refresh_url <>
59− row "next_page" next_page <>
60− row "results_per_page" results_per_page <>
61− row "page" page <>
62− row "completed_in" completed_in <>
63− row "since_id_str" since_id_str <>
64− row "max_id_str" max_id_str <>
65− row "query" query
66−
67−instance Value Result where
68− toJson = toJson . toObject
benchmarks/CompareWithJSON.hs+17−40
@@ -1,25 +1,16 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3{-# OPTIONS_GHC -fno-warn-orphans #-}
1{-# OPTIONS_GHC -fno-warn-orphans #-}
4
2
5−module Main (main) where
6−
7−import Prelude.Compat
8−
9import Blaze.ByteString.Builder (toLazyByteString)
3import Blaze.ByteString.Builder (toLazyByteString)
10import Blaze.ByteString.Builder.Char.Utf8 (fromString)
4import Blaze.ByteString.Builder.Char.Utf8 (fromString)
11import Control.DeepSeq (NFData(rnf))
5import Control.DeepSeq (NFData(rnf))
12import Criterion.Main
6import Criterion.Main
13−import Data.Maybe (fromMaybe)
7+import qualified Data.Aeson.Encode as A
14import qualified Data.Aeson as A
8import qualified Data.Aeson as A
15−import qualified Data.Aeson.Text as A
16−import qualified Data.Aeson.Parser.Internal as I
17−import qualified Data.ByteString as BS
18import qualified Data.ByteString.Lazy as BL
9import qualified Data.ByteString.Lazy as BL
10+import qualified Text.JSON as J
19import qualified Data.Text.Lazy as TL
11import qualified Data.Text.Lazy as TL
20import qualified Data.Text.Lazy.Builder as TLB
12import qualified Data.Text.Lazy.Builder as TLB
21import qualified Data.Text.Lazy.Encoding as TLE
13import qualified Data.Text.Lazy.Encoding as TLE
22−import qualified Text.JSON as J
23
14
24instance (NFData v) => NFData (J.JSObject v) where
15instance (NFData v) => NFData (J.JSObject v) where
25 rnf o = rnf (J.fromJSObject o)
16 rnf o = rnf (J.fromJSObject o)
@@ -27,7 +18,7 @@ instance (NFData v) => NFData (J.JSObject v) where
27instance NFData J.JSValue where
18instance NFData J.JSValue where
28 rnf J.JSNull = ()
19 rnf J.JSNull = ()
29 rnf (J.JSBool b) = rnf b
20 rnf (J.JSBool b) = rnf b
30− rnf (J.JSRational a b) = rnf a `seq` rnf b
21+ rnf (J.JSRational a b) = rnf a `seq` rnf b `seq` ()
31 rnf (J.JSString s) = rnf (J.fromJSString s)
22 rnf (J.JSString s) = rnf (J.fromJSString s)
32 rnf (J.JSArray lst) = rnf lst
23 rnf (J.JSArray lst) = rnf lst
33 rnf (J.JSObject o) = rnf o
24 rnf (J.JSObject o) = rnf o
@@ -38,18 +29,10 @@ decodeJ s =
38 J.Ok v -> v
29 J.Ok v -> v
39 J.Error _ -> error "fail to parse via JSON"
30 J.Error _ -> error "fail to parse via JSON"
40
31
41−decode :: BL.ByteString -> A.Value
32+decodeA :: BL.ByteString -> A.Value
42−decode s = fromMaybe (error "fail to parse via Aeson") $ A.decode s
33+decodeA s = case A.decode s of
43−
34+ Just v -> v
44−decode' :: BL.ByteString -> A.Value
45−decode' s = fromMaybe (error "fail to parse via Aeson") $ A.decode' s
46−
47−decodeS :: BS.ByteString -> A.Value
48−decodeS s = fromMaybe (error "fail to parse via Aeson") $ A.decodeStrict' s
35+ Nothing -> error "fail to parse via Aeson"
49−
50−decodeIP :: BL.ByteString -> A.Value
51−decodeIP s = fromMaybe (error "fail to parse via Parser.decodeWith") $
52− I.decodeWith I.jsonEOF A.fromJSON s
53
36
54encodeJ :: J.JSValue -> BL.ByteString
37encodeJ :: J.JSValue -> BL.ByteString
55encodeJ = toLazyByteString . fromString . J.encode
38encodeJ = toLazyByteString . fromString . J.encode
@@ -65,37 +48,31 @@ main = do
65 let enFile = "json-data/twitter100.json"
48 let enFile = "json-data/twitter100.json"
66 jpFile = "json-data/jp100.json"
49 jpFile = "json-data/jp100.json"
67 enA <- BL.readFile enFile
50 enA <- BL.readFile enFile
68− enS <- BS.readFile enFile
69 enJ <- readFile enFile
51 enJ <- readFile enFile
70 jpA <- BL.readFile jpFile
52 jpA <- BL.readFile jpFile
71− jpS <- BS.readFile jpFile
72 jpJ <- readFile jpFile
53 jpJ <- readFile jpFile
73 defaultMain [
54 defaultMain [
74 bgroup "decode" [
55 bgroup "decode" [
75 bgroup "en" [
56 bgroup "en" [
76− bench "aeson/lazy" $ nf decode enA
57+ bench "aeson" $ nf decodeA enA
77− , bench "aeson/strict" $ nf decode' enA
78− , bench "aeson/stricter" $ nf decodeS enS
79− , bench "aeson/parser" $ nf decodeIP enA
80− , bench "json" $ nf decodeJ enJ
58+ , bench "json" $ nf decodeJ enJ
81 ]
59 ]
82 , bgroup "jp" [
60 , bgroup "jp" [
83− bench "aeson" $ nf decode jpA
61+ bench "aeson" $ nf decodeA jpA
84− , bench "aeson/stricter" $ nf decodeS jpS
85− , bench "json" $ nf decodeJ jpJ
62+ , bench "json" $ nf decodeJ jpJ
86 ]
63 ]
87 ]
64 ]
88 , bgroup "encode" [
65 , bgroup "encode" [
89 bgroup "en" [
66 bgroup "en" [
90− bench "aeson-to-bytestring" $ nf A.encode (decode enA)
67+ bench "aeson-to-bytestring" $ nf A.encode (decodeA enA)
91− , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decode enA)
68+ , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decodeA enA)
92− , bench "aeson-to-text" $ nf encodeToText (decode enA)
69+ , bench "aeson-to-text" $ nf encodeToText (decodeA enA)
93 , bench "json" $ nf encodeJ (decodeJ enJ)
70 , bench "json" $ nf encodeJ (decodeJ enJ)
94 ]
71 ]
95 , bgroup "jp" [
72 , bgroup "jp" [
96− bench "aeson-to-bytestring" $ nf A.encode (decode jpA)
73+ bench "aeson-to-bytestring" $ nf A.encode (decodeA jpA)
97− , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decode jpA)
74+ , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decodeA jpA)
98− , bench "aeson-to-text" $ nf encodeToText (decode jpA)
75+ , bench "aeson-to-text" $ nf encodeToText (decodeA jpA)
99 , bench "json" $ nf encodeJ (decodeJ jpJ)
76 , bench "json" $ nf encodeJ (decodeJ jpJ)
100 ]
77 ]
101 ]
78 ]
benchmarks/Dates.hsdeleted−44
@@ -1,44 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−module Main (main) where
4−
5−import Prelude.Compat
6−
7−import Criterion.Main
8−import Data.Aeson (decode, encode)
9−import Data.Time.Clock (UTCTime)
10−import Data.Time.LocalTime (ZonedTime)
11−import qualified Data.ByteString.Lazy as BL
12−
13−utcTime :: BL.ByteString -> Maybe [UTCTime]
14−utcTime = decode
15−
16−zTime :: BL.ByteString -> Maybe [ZonedTime]
17−zTime = decode
18−
19−main :: IO ()
20−main = do
21− let file1 = BL.readFile "json-data/dates.json"
22− let file2 = BL.readFile "json-data/dates-fract.json"
23− defaultMain [
24− bgroup "decode" [
25− bgroup "UTCTime" [
26− env file1 $ \bs -> bench "whole" $ nf utcTime bs
27− , env file2 $ \bs -> bench "fractional" $ nf utcTime bs
28− ]
29− , bgroup "ZonedTime" [
30− env file1 $ \bs -> bench "whole" $ nf zTime bs
31− , env file2 $ \bs -> bench "fractional" $ nf zTime bs
32− ]
33− ]
34− , bgroup "encode" [
35− bgroup "UTCTime" [
36− env (utcTime <$> file1) $ \ts -> bench "whole" $ nf encode ts
37− , env (utcTime <$> file2) $ \ts -> bench "fractional" $ nf encode ts
38− ]
39− , bgroup "ZonedTime" [
40− env (zTime <$> file1) $ \ts -> bench "whole" $ nf encode ts
41− , env (zTime <$> file2) $ \ts -> bench "fractional" $ nf encode ts
42− ]
43− ]
44− ]
benchmarks/Escape.hsdeleted−32
@@ -1,32 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3−
4−{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
5−
6−module Main (main) where
7−
8−import Prelude.Compat
9−
10−import Criterion.Main
11−import qualified Data.Aeson.Parser.UnescapeFFI as FFI
12−import qualified Data.Aeson.Parser.UnescapePure as Pure
13−
14−import qualified Data.ByteString.Char8 as BS
15−import System.Environment (getArgs, withArgs)
16−
17−main :: IO ()
18−main = do
19− args_ <- getArgs
20− let (args, p, n) =
21− case args_ of
22− "--pattern" : p : args_ -> k p args_
23− _ -> k "\\\"" args_
24− k p args_ =
25− case args_ of
26− "--repeat" : n : args_ -> (args_, p, read n)
27− args_ -> (args_, p, 10000)
28− input = BS.concat $ replicate n $ BS.pack p
29− withArgs args $ defaultMain
30− [ bench "ffi" $ whnf FFI.unescapeText input
31− , bench "pure" $ whnf Pure.unescapeText input
32− ]
benchmarks/Issue673.hsdeleted−165
@@ -1,165 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−module Main (
5− main,
6− input17,
7− input32,
8− input64,
9− input128,
10− input256,
11− input2048,
12− input4096,
13− input8192,
14− input16384,
15− ) where
16−
17−import Criterion.Main
18−import Prelude.Compat
19−import Data.Int (Int64)
20−import Data.Scientific (Scientific)
21−import Data.Semigroup ((<>))
22−import Data.Aeson.Parser (scientific)
23−
24−import qualified Data.Attoparsec.ByteString.Lazy as AttoL
25−import qualified Data.Attoparsec.ByteString.Char8 as Atto8
26−import qualified Data.Aeson as A
27−import qualified Data.ByteString as BS
28−import qualified Data.ByteString.Lazy as LBS
29−import qualified Data.ByteString.Lazy.Char8 as LBS8
30−
31−decodeInt :: LBS.ByteString -> Maybe Int
32−decodeInt = A.decode
33−
34−decodeString :: LBS.ByteString -> Maybe String
35−decodeString = A.decode
36−
37−decodeScientific :: LBS.ByteString -> Maybe Scientific
38−decodeScientific = A.decode
39−
40−decodeViaRead :: LBS.ByteString -> Integer
41−decodeViaRead = read . LBS8.unpack
42−
43−decodeAtto :: LBS.ByteString -> Maybe Scientific
44−decodeAtto
45− = parseOnly (scientific <* AttoL.endOfInput)
46− where
47− parseOnly p lbs = case AttoL.parse p lbs of
48− AttoL.Done _ r -> Just r
49− AttoL.Fail {} -> Nothing
50−
51−decodeAtto8 :: LBS.ByteString -> Maybe Scientific
52−decodeAtto8
53− = parseOnly (Atto8.scientific <* AttoL.endOfInput)
54− where
55− parseOnly p lbs = case AttoL.parse p lbs of
56− AttoL.Done _ r -> Just r
57− AttoL.Fail {} -> Nothing
58−
59−generate :: Int64 -> LBS.ByteString
60−generate n = LBS8.replicate n '1'
61−
62−input17 :: LBS.ByteString
63−input17 = generate 17
64−
65−input32 :: LBS.ByteString
66−input32 = generate 32
67−
68−input64 :: LBS.ByteString
69−input64 = generate 64
70−
71−input128 :: LBS.ByteString
72−input128 = generate 128
73−
74−input256 :: LBS.ByteString
75−input256 = generate 256
76−
77−input2048 :: LBS.ByteString
78−input2048 = generate 2048
79−
80−input4096 :: LBS.ByteString
81−input4096 = generate 4096
82−
83−input8192 :: LBS.ByteString
84−input8192 = generate 8192
85−
86−input16384 :: LBS.ByteString
87−input16384 = generate 16384
88−
89−
90−main :: IO ()
91−main = defaultMain
92− -- works on 64bit
93− [ benchPair "17" input17
94− -- , benchPair "32" input32
95− -- , benchPair "64" input64
96− -- , benchPair "128" input128
97− -- , benchPair "256" input256
98− , benchPair "2048" input2048
99− , benchPair "4096" input4096
100− , benchPair "8192" input8192
101− , benchPair "16384" input16384
102− ]
103− where
104− benchPair name input = bgroup name
105− [ bench "Int" $ whnf decodeInt input
106− , bench "Simple" $ whnf bsToIntegerSimple (LBS.toStrict input)
107− , bench "Optim" $ whnf bsToInteger (LBS.toStrict input)
108− , bench "Read" $ whnf decodeViaRead input
109− , bench "Scientific" $ whnf decodeScientific input
110− , bench "parserA" $ whnf decodeAtto input
111− , bench "parserS" $ whnf decodeAtto8 input
112− , bench "String" $ whnf decodeString $ "\"" <> input <> "\""
113− ]
114−
115−-------------------------------------------------------------------------------
116−-- better fromInteger
117−-------------------------------------------------------------------------------
118−
119−bsToInteger :: BS.ByteString -> Integer
120−bsToInteger bs
121− | l > 40 = valInteger 10 l [ fromIntegral (w - 48) | w <- BS.unpack bs ]
122− | otherwise = bsToIntegerSimple bs
123− where
124− l = BS.length bs
125−
126−bsToIntegerSimple :: BS.ByteString -> Integer
127−bsToIntegerSimple = BS.foldl' step 0 where
128− step a b = a * 10 + fromIntegral (b - 48) -- 48 = '0'
129−
130−-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
131−-- digits are combined into a single radix b^2 digit. This process is
132−-- repeated until we are left with a single digit. This algorithm
133−-- performs well only on large inputs, so we use the simple algorithm
134−-- for smaller inputs.
135−valInteger :: Integer -> Int -> [Integer] -> Integer
136−valInteger = go
137− where
138− go :: Integer -> Int -> [Integer] -> Integer
139− go _ _ [] = 0
140− go _ _ [d] = d
141− go b l ds
142− | l > 40 = b' `seq` go b' l' (combine b ds')
143− | otherwise = valSimple b ds
144− where
145− -- ensure that we have an even number of digits
146− -- before we call combine:
147− ds' = if even l then ds else 0 : ds
148− b' = b * b
149− l' = (l + 1) `quot` 2
150−
151− combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)
152− where
153− d = d1 * b + d2
154− combine _ [] = []
155− combine _ [_] = errorWithoutStackTrace "this should not happen"
156−
157−-- The following algorithm is only linear for types whose Num operations
158−-- are in constant time.
159−valSimple :: Integer -> [Integer] -> Integer
160−valSimple base = go 0
161− where
162− go r [] = r
163− go r (d : ds) = r' `seq` go r' ds
164− where
165− r' = r * base + fromIntegral d
benchmarks/JsonParse.hs+3−10
@@ -1,23 +1,16 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−
5{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
6
3
7−module Main (main) where
8−
9−import Prelude.Compat
10−
11import Control.DeepSeq
4import Control.DeepSeq
12import Control.Monad
5import Control.Monad
6+import Text.JSON
13import Data.Time.Clock
7import Data.Time.Clock
14import System.Environment (getArgs)
8import System.Environment (getArgs)
15−import Text.JSON
16
9
17instance NFData JSValue where
10instance NFData JSValue where
18 rnf JSNull = ()
11 rnf JSNull = ()
19 rnf (JSBool b) = rnf b
12 rnf (JSBool b) = rnf b
20− rnf (JSRational b r) = rnf b `seq` rnf r
13+ rnf (JSRational b r) = rnf b `seq` rnf r `seq` ()
21 rnf (JSString s) = rnf (fromJSString s)
14 rnf (JSString s) = rnf (fromJSString s)
22 rnf (JSArray vs) = rnf vs
15 rnf (JSArray vs) = rnf vs
23 rnf (JSObject kvs) = rnf (fromJSObject kvs)
16 rnf (JSObject kvs) = rnf (fromJSObject kvs)
benchmarks/Micro.hsdeleted−22
@@ -1,22 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−module Main (main) where
4−
5−import Prelude.Compat
6−
7−import Criterion.Main
8−
9−-- Encoding is a newtype wrapper around Builder
10−import Data.Aeson.Encoding (text, string, encodingToLazyByteString)
11−import qualified Data.Text as T
12−
13−main :: IO ()
14−main = do
15− let txt = "append (append b (primBounded w1 x1)) (primBounded w2 x2)"
16− defaultMain [
17− bgroup "string" [
18− bench "text" $ nf (encodingToLazyByteString . text) (T.pack txt)
19− , bench "string direct" $ nf (encodingToLazyByteString . string) txt
20− , bench "string via text" $ nf (encodingToLazyByteString . text . T.pack) txt
21− ]
22− ]
benchmarks/Options.hs+1−1
@@ -1,4 +1,4 @@
1−module Options (opts) where
1+module Options where
2
2
3import Data.Aeson.Types
3import Data.Aeson.Types
4
4
benchmarks/ReadFile.hs+2−8
@@ -1,10 +1,4 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−
5−module Main (main) where
6−
7−import Prelude.Compat
8
2
9import Control.DeepSeq
3import Control.DeepSeq
10import Control.Exception
4import Control.Exception
@@ -20,7 +14,7 @@ import qualified Data.ByteString as B
20main = do
14main = do
21 (cnt:args) <- getArgs
15 (cnt:args) <- getArgs
22 let count = read cnt :: Int
16 let count = read cnt :: Int
23− forM_ args $ \arg -> withFile arg ReadMode $ \h -> do
17+ forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
24 putStrLn $ arg ++ ":"
18 putStrLn $ arg ++ ":"
25 start <- getCurrentTime
19 start <- getCurrentTime
26 let loop !n
20 let loop !n
benchmarks/Typed.hsdeleted−20
@@ -1,20 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−module Main (main) where
4−
5−import Prelude.Compat
6−
7−import Criterion.Main
8−import qualified Typed.Generic as Generic
9−import qualified Typed.Manual as Manual
10−import qualified Typed.TH as TH
11−
12−main :: IO ()
13−main = defaultMain [
14− Generic.benchmarks
15− , Manual.benchmarks
16− , TH.benchmarks
17− , Generic.decodeBenchmarks
18− , Manual.decodeBenchmarks
19− , TH.decodeBenchmarks
20− ]
benchmarks/Typed/Common.hsdeleted−22
@@ -1,22 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−{-# OPTIONS_GHC -fno-warn-unused-imports #-}
4−
5−module Typed.Common (load) where
6−
7−import Prelude.Compat
8−
9−import Data.ByteString.Lazy as L
10−import System.Exit
11−import System.IO
12−
13−import Data.Aeson hiding (Result)
14−
15−load :: FromJSON a => FilePath -> IO a
16−load fileName = do
17− mv <- eitherDecode' <$> L.readFile fileName
18− case mv of
19− Right v -> return v
20− Left err -> do
21− hPutStrLn stderr $ fileName ++ ": JSON decode failed - " ++ err
22− exitWith (ExitFailure 1)
benchmarks/Typed/Generic.hsdeleted−44
@@ -1,44 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−module Typed.Generic (benchmarks, decodeBenchmarks) where
4−
5−import Prelude.Compat
6−
7−import Data.Aeson hiding (Result)
8−import Criterion
9−import Data.ByteString.Lazy as L
10−import Twitter.Generic
11−import Typed.Common
12−
13−encodeDirect :: Result -> L.ByteString
14−encodeDirect = encode
15−
16−encodeViaValue :: Result -> L.ByteString
17−encodeViaValue = encode . toJSON
18−
19−benchmarks :: Benchmark
20−benchmarks =
21− env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
22− bgroup "encodeGeneric" [
23− bgroup "direct" [
24− bench "twitter100" $ nf encodeDirect twitter100
25− , bench "jp100" $ nf encodeDirect jp100
26− ]
27− , bgroup "viaValue" [
28− bench "twitter100" $ nf encodeViaValue twitter100
29− , bench "jp100" $ nf encodeViaValue jp100
30− ]
31− ]
32−
33−decodeDirect :: L.ByteString -> Maybe Result
34−decodeDirect = decode
35−
36−decodeBenchmarks :: Benchmark
37−decodeBenchmarks =
38− env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
39− bgroup "decodeGeneric"
40− [ bgroup "direct"
41− [ bench "twitter100" $ nf decodeDirect twitter100
42− , bench "jp100" $ nf decodeDirect jp100
43− ]
44− ]
benchmarks/Typed/Manual.hsdeleted−44
@@ -1,44 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−module Typed.Manual (benchmarks, decodeBenchmarks) where
4−
5−import Prelude.Compat
6−
7−import Data.Aeson hiding (Result)
8−import Criterion
9−import Data.ByteString.Lazy as L
10−import Twitter.Manual
11−import Typed.Common
12−
13−encodeDirect :: Result -> L.ByteString
14−encodeDirect = encode
15−
16−encodeViaValue :: Result -> L.ByteString
17−encodeViaValue = encode . toJSON
18−
19−benchmarks :: Benchmark
20−benchmarks =
21− env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
22− bgroup "encodeManual" [
23− bgroup "direct" [
24− bench "twitter100" $ nf encodeDirect twitter100
25− , bench "jp100" $ nf encodeDirect jp100
26− ]
27− , bgroup "viaValue" [
28− bench "twitter100" $ nf encodeViaValue twitter100
29− , bench "jp100" $ nf encodeViaValue jp100
30− ]
31− ]
32−
33−decodeDirect :: L.ByteString -> Maybe Result
34−decodeDirect = decode
35−
36−decodeBenchmarks :: Benchmark
37−decodeBenchmarks =
38− env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
39− bgroup "decodeManual"
40− [ bgroup "direct"
41− [ bench "twitter100" $ nf decodeDirect twitter100
42− , bench "jp100" $ nf decodeDirect jp100
43− ]
44− ]
benchmarks/Typed/TH.hsdeleted−44
@@ -1,44 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−module Typed.TH (benchmarks, decodeBenchmarks) where
4−
5−import Prelude.Compat
6−
7−import Data.Aeson hiding (Result)
8−import Criterion
9−import Data.ByteString.Lazy as L
10−import Twitter.TH
11−import Typed.Common
12−
13−encodeDirect :: Result -> L.ByteString
14−encodeDirect = encode
15−
16−encodeViaValue :: Result -> L.ByteString
17−encodeViaValue = encode . toJSON
18−
19−benchmarks :: Benchmark
20−benchmarks =
21− env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
22− bgroup "encodeTH" [
23− bgroup "direct" [
24− bench "twitter100" $ nf encodeDirect twitter100
25− , bench "jp100" $ nf encodeDirect jp100
26− ]
27− , bgroup "viaValue" [
28− bench "twitter100" $ nf encodeViaValue twitter100
29− , bench "jp100" $ nf encodeViaValue jp100
30− ]
31− ]
32−
33−decodeDirect :: L.ByteString -> Maybe Result
34−decodeDirect = decode
35−
36−decodeBenchmarks :: Benchmark
37−decodeBenchmarks =
38− env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
39− bgroup "decodeTH"
40− [ bgroup "direct"
41− [ bench "twitter100" $ nf decodeDirect twitter100
42− , bench "jp100" $ nf decodeDirect jp100
43− ]
44− ]
benchmarks/aeson-benchmarks.cabal+42−288
@@ -1,240 +1,66 @@
1name: aeson-benchmarks
1name: aeson-benchmarks
2version: 0
2version: 0
3build-type: Simple
3build-type: Simple
4−cabal-version: >=1.10
5
4
6−flag bytestring-builder
5+cabal-version: >=1.8
7− description: Depend on the bytestring-builder package for backwards compatibility.
8− default: False
9− manual: False
10
6
11−flag local-aeson
7+flag old-locale
12− description: Build the local version of aeson, to avoid rebuilding aeson's
8+ description: If false then depend on time >= 1.5.
13− reverse dependencies for benchmarking (statistics, criterion).
9+ .
10+ If true then depend on time < 1.5 together with old-locale.
14− default: True
11+ default: False
15− manual: True
16
12
17library
13library
18− default-language: Haskell2010
19−
20− if flag(bytestring-builder)
21− build-depends: bytestring >= 0.9 && < 0.10.4,
22− bytestring-builder >= 0.10.4 && < 1
23− else
24− build-depends: bytestring >= 0.10.4
25−
26− if flag(local-aeson)
27−
28− hs-source-dirs: .. ../ffi ../pure ../attoparsec-iso8601
14+ hs-source-dirs: ..
29− c-sources: ../cbits/unescape_string.c
30− build-depends:
31− attoparsec,
32− base,
33− base-compat,
34− containers,
35− deepseq,
36− dlist,
37− fail,
38− ghc-prim,
39− hashable,
40− mtl,
41− primitive,
42− scientific,
43− syb,
44− tagged,
45− template-haskell,
46− text,
47− th-abstraction,
48− time-compat,
49− time,
50− transformers,
51− unordered-containers,
52− uuid-types,
53− vector
54−
55− if !impl(ghc >= 8.6)
56− build-depends: contravariant
57−
58− if !impl(ghc >= 8.0)
59− -- `Data.Semigroup` is available in base only since GHC 8.0 / base 4.9
60− build-depends: semigroups,
61− transformers-compat
62−
63− if !impl(ghc >= 7.10)
64− -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8
65− build-depends: nats,
66− void
67−
68− include-dirs: ../include
69−
70− ghc-options: -O2 -Wall
71− cpp-options: -DGENERICS
72
15
73− exposed-modules:
16+ exposed-modules:
74− Data.Aeson
75− Data.Aeson.Encoding
76− Data.Aeson.Encoding.Builder
77− Data.Aeson.Encoding.Internal
78− Data.Aeson.Internal
79− Data.Aeson.Internal.Functions
80− Data.Aeson.Internal.Time
81− Data.Aeson.Parser
82− Data.Aeson.Parser.Internal
83− Data.Aeson.Parser.Time
17+ Data.Aeson
84− Data.Aeson.Parser.Unescape
18+ Data.Aeson.Encode
85− Data.Aeson.Parser.UnescapeFFI
19+ Data.Aeson.Parser
86− Data.Aeson.Parser.UnescapePure
20+ Data.Aeson.Types
87− Data.Aeson.TH
21+ Data.Aeson.TH
88− Data.Aeson.Text
89− Data.Aeson.Types
90− Data.Aeson.Types.Class
91− Data.Aeson.Types.FromJSON
92− Data.Aeson.Types.Generic
93− Data.Aeson.Types.Internal
94− Data.Aeson.Types.ToJSON
95− Data.Attoparsec.Time
96− Data.Attoparsec.Time.Internal
97
22
98− else
99−
100− build-depends: aeson
101−
102− reexported-modules:
103− Data.Aeson,
104− Data.Aeson.Encoding,
105− Data.Aeson.Parser.Internal,
106− Data.Aeson.Text,
107− Data.Aeson.TH,
108− Data.Aeson.Types
109−
110−executable aeson-benchmark-auto-compare
111− default-language: Haskell2010
112− main-is: AutoCompare.hs
113− hs-source-dirs: .
114− ghc-options: -Wall -O2 -rtsopts
115 other-modules:
23 other-modules:
116− Auto.T.D
24+ Data.Aeson.Encode.ByteString
117− Auto.T.BigRecord
25+ Data.Aeson.Functions
118− Auto.T.BigProduct
26+ Data.Aeson.Parser.Internal
119− Auto.T.BigSum
27+ Data.Aeson.Types.Class
120− Auto.G.D
28+ Data.Aeson.Types.Generic
121− Auto.G.BigRecord
29+ Data.Aeson.Types.Instances
122− Auto.G.BigProduct
30+ Data.Aeson.Types.Internal
123− Auto.G.BigSum
124− Options
125− build-depends:
126− aeson-benchmarks,
127− base,
128− criterion,
129− deepseq,
130− template-haskell
131
31
132−executable aeson-benchmark-escape
133− default-language: Haskell2010
134− main-is: Escape.hs
135− hs-source-dirs: ../examples .
136− ghc-options: -Wall -O2 -rtsopts
137− if flag(local-aeson)
138− build-depends:
139− aeson-benchmarks,
140− base,
141− base-compat,
142− bytestring,
143− criterion >= 1.0,
144− deepseq,
145− ghc-prim,
146− text
147− else
148− -- Disabled because of inaccessible internals
149− buildable: False
150−
151−executable aeson-benchmark-compare
152− default-language: Haskell2010
153− main-is: Compare.hs
154− hs-source-dirs: ../examples .
155− ghc-options: -Wall -O2 -rtsopts
156− other-modules:
157− Compare.BufferBuilder
158− Compare.JsonBench
159− Twitter
160− Twitter.Manual
161− Typed.Common
162− build-depends:
163− aeson-benchmarks,
164− base,
165− base-compat,
166− buffer-builder,
167− bytestring,
168− criterion >= 1.0,
169− deepseq,
170− ghc-prim,
171− text
172−
173− if impl(ghc < 8.4)
174− other-modules:
175− Compare.JsonBuilder
176− build-depends:
177− json-builder
178− if impl(ghc < 8.0)
179− build-depends:
180− semigroups
181−
182−executable aeson-benchmark-micro
183− default-language: Haskell2010
184− main-is: Micro.hs
185− hs-source-dirs: ../examples .
186− ghc-options: -Wall -O2 -rtsopts
187 build-depends:
32 build-depends:
188− aeson-benchmarks,
33+ attoparsec >= 0.13.0.0,
189− base,
34+ base == 4.*,
190− base-compat,
191− bytestring,
35+ bytestring >= 0.10.4.0,
192− criterion >= 1.0,
36+ containers,
193− deepseq,
194− ghc-prim,
195− text
196−
197−executable aeson-benchmark-typed
198− default-language: Haskell2010
199− main-is: Typed.hs
200− hs-source-dirs: ../examples .
201− ghc-options: -Wall -O2 -rtsopts
202− other-modules:
203− Twitter
204− Twitter.Generic
205− Twitter.Manual
206− Twitter.Options
207− Twitter.TH
208− Typed.Common
209− Typed.Generic
210− Typed.Manual
211− Typed.TH
212− build-depends:
213− aeson-benchmarks,
214− base,
215− base-compat,
216− criterion >= 1.0,
217 deepseq,
37 deepseq,
38+ dlist >= 0.2,
218− ghc-prim,
39+ ghc-prim >= 0.2,
40+ hashable >= 1.1.2.0,
41+ mtl,
42+ scientific >= 0.3.1 && < 0.4,
43+ syb,
44+ template-haskell >= 2.4,
219− text,
45+ text >= 1.1.1.0,
220− time
46+ transformers,
221−
47+ unordered-containers >= 0.2.3.0,
222− if flag(bytestring-builder)
48+ vector >= 0.7.1
49+
50+ if flag(old-locale)
223− build-depends: bytestring >= 0.9 && < 0.10.4,
51+ build-depends: time < 1.5, old-locale
224− bytestring-builder >= 0.10.4 && < 1
225 else
52 else
226− build-depends: bytestring >= 0.10.4
53+ build-depends: time >= 1.5
227− if impl(ghc < 8.0)
54+
228− build-depends: semigroups
55+ ghc-options: -O2 -Wall
56+ cpp-options: -DGENERICS
229
57
230executable aeson-benchmark-compare-with-json
58executable aeson-benchmark-compare-with-json
231− default-language: Haskell2010
232 main-is: CompareWithJSON.hs
59 main-is: CompareWithJSON.hs
233 ghc-options: -Wall -O2 -rtsopts
60 ghc-options: -Wall -O2 -rtsopts
234 build-depends:
61 build-depends:
235 aeson-benchmarks,
62 aeson-benchmarks,
236 base,
63 base,
237− base-compat,
238 blaze-builder,
64 blaze-builder,
239 bytestring,
65 bytestring,
240 criterion,
66 criterion,
@@ -243,103 +69,31 @@ executable aeson-benchmark-compare-with-json
243 text
69 text
244
70
245executable aeson-benchmark-aeson-encode
71executable aeson-benchmark-aeson-encode
246− default-language: Haskell2010
247 main-is: AesonEncode.hs
72 main-is: AesonEncode.hs
248 ghc-options: -Wall -O2 -rtsopts
73 ghc-options: -Wall -O2 -rtsopts
249 build-depends:
74 build-depends:
250 aeson-benchmarks,
75 aeson-benchmarks,
251 attoparsec,
76 attoparsec,
252 base,
77 base,
253− base-compat,
254 bytestring,
78 bytestring,
255 deepseq,
79 deepseq,
256 time
80 time
257
81
258executable aeson-benchmark-aeson-parse
82executable aeson-benchmark-aeson-parse
259− default-language: Haskell2010
260 main-is: AesonParse.hs
83 main-is: AesonParse.hs
261 ghc-options: -Wall -O2 -rtsopts
84 ghc-options: -Wall -O2 -rtsopts
262 build-depends:
85 build-depends:
263 aeson-benchmarks,
86 aeson-benchmarks,
264 attoparsec,
87 attoparsec,
265 base,
88 base,
266− base-compat,
267 bytestring,
89 bytestring,
268 time
90 time
269
91
270executable aeson-benchmark-json-parse
92executable aeson-benchmark-json-parse
271− default-language: Haskell2010
272 main-is: JsonParse.hs
93 main-is: JsonParse.hs
273 ghc-options: -Wall -O2 -rtsopts
94 ghc-options: -Wall -O2 -rtsopts
274 build-depends:
95 build-depends:
275 base,
96 base,
276− base-compat,
277 deepseq,
97 deepseq,
278 json,
98 json,
279 time
99 time
280−
281−executable aeson-benchmark-dates
282− default-language: Haskell2010
283− main-is: Dates.hs
284− ghc-options: -Wall -O2 -rtsopts
285− build-depends:
286− base,
287− base-compat,
288− bytestring,
289− criterion,
290− deepseq,
291− aeson-benchmarks,
292− text,
293− time
294− if impl(ghc >= 8.2)
295− ghc-options: -Wno-simplifiable-class-constraints
296−
297−executable aeson-benchmark-map
298− default-language: Haskell2010
299− main-is: AesonMap.hs
300− ghc-options: -Wall -O2 -rtsopts
301− build-depends:
302− aeson-benchmarks,
303− base,
304− base-compat,
305− criterion >= 1.0,
306− bytestring,
307− containers,
308− deepseq,
309− hashable,
310− tagged,
311− text,
312− unordered-containers
313−
314−executable aeson-benchmark-foldable
315− default-language: Haskell2010
316− main-is: AesonFoldable.hs
317− ghc-options: -Wall -O2 -rtsopts
318− build-depends:
319− aeson-benchmarks,
320− base,
321− base-compat,
322− criterion >= 1.0,
323− bytestring,
324− containers,
325− deepseq,
326− hashable,
327− tagged,
328− text,
329− unordered-containers,
330− vector
331−
332−executable aeson-issue-673
333− default-language: Haskell2010
334− main-is: Issue673.hs
335− ghc-options: -Wall -O1 -rtsopts
336− build-depends:
337− aeson-benchmarks,
338− attoparsec,
339− base,
340− bytestring,
341− scientific,
342− base-compat,
343− criterion >= 1.0
344− if impl(ghc < 8.0)
345− build-depends: semigroups
benchmarks/json-data/buffer-builder.jsondeleted−4322

This diff is too big to show here.

benchmarks/json-data/dates-fract.jsondeleted−1

This diff is too big to show here.

benchmarks/json-data/dates.jsondeleted−1

This diff is too big to show here.

benchmarks/json-data/jp10.json+1−1

This diff is too big to show here.

benchmarks/json-data/jp100.json+1−1

This diff is too big to show here.

benchmarks/json-data/jp50.json+1−1

This diff is too big to show here.

benchmarks/json-data/twitter1.json+1−1

This diff is too big to show here.

benchmarks/json-data/twitter10.json+1−1

This diff is too big to show here.

benchmarks/json-data/twitter100.json+1−1

This diff is too big to show here.

benchmarks/json-data/twitter20.json+1−1

This diff is too big to show here.

benchmarks/json-data/twitter50.json+1−1

This diff is too big to show here.

cabal.projectdeleted−5

This diff is too big to show here.

cbits/unescape_string.cdeleted−149

This diff is too big to show here.

changelog.md+70−584

This diff is too big to show here.

examples/Generic.hs+8−7

This diff is too big to show here.

examples/GenericSYB.hsnew file+30

This diff is too big to show here.

examples/Simplest.hs+1−12

This diff is too big to show here.

examples/TemplateHaskell.hs+3−6

This diff is too big to show here.

examples/Twitter.hsdeleted−80

This diff is too big to show here.

examples/Twitter/Generic.hsdeleted−44

This diff is too big to show here.

examples/Twitter/Manual.hsdeleted−146

This diff is too big to show here.

examples/Twitter/Options.hsdeleted−10

This diff is too big to show here.

examples/Twitter/TH.hsdeleted−25

This diff is too big to show here.

examples/aeson-examples.cabaldeleted−32

This diff is too big to show here.

ffi/Data/Aeson/Parser/UnescapeFFI.hsdeleted−52

This diff is too big to show here.

include/incoherent-compat.hdeleted−7

This diff is too big to show here.

include/overlapping-compat.hdeleted−8

This diff is too big to show here.

pure/Data/Aeson/Parser/UnescapePure.hsdeleted−254

This diff is too big to show here.

run-hlint.shdeleted−7

This diff is too big to show here.

stack-bench.yamldeleted−12

This diff is too big to show here.

stack-ffi-unescape.yamldeleted−9

This diff is too big to show here.

stack-lts12.yamldeleted−15

This diff is too big to show here.

stack-nightly.yamldeleted−11

This diff is too big to show here.

tests/DataFamilies/Encoders.hsdeleted−239

This diff is too big to show here.

tests/DataFamilies/Instances.hsdeleted−43

This diff is too big to show here.

tests/DataFamilies/Properties.hsdeleted−141

This diff is too big to show here.

tests/DataFamilies/Types.hsdeleted−54

This diff is too big to show here.

tests/Encoders.hs+16−360

This diff is too big to show here.

tests/ErrorMessages.hsdeleted−224

This diff is too big to show here.

tests/Functions.hs+1−9

This diff is too big to show here.

tests/Instances.hs+42−65

This diff is too big to show here.

tests/JSONTestSuite/LICENSEdeleted−21

This diff is too big to show here.

tests/JSONTestSuite/README.mddeleted−50

This diff is too big to show here.

tests/JSONTestSuite/parsers/test-AppleJSONSerialization/bin/test-AppleJSONSerializationdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization.xcodeproj/project.pbxprojdeleted−260

This diff is too big to show here.

tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test-AppleJSONSerialization.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization/main.swiftdeleted−34

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Bash_JSON/JSON.shdeleted−208

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/bin/test_Freddydeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy.xcodeproj/project.pbxprojdeleted−300

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy.xcodeproj/project.xcworkspace/xcshareddata/test_Freddy.xcscmblueprintdeleted−30

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_Freddy.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSON.swiftdeleted−95

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSONDecodable.swiftdeleted−177

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSONEncodable.swiftdeleted−83

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSONEncodingDetector.swiftdeleted−110

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSONLiteralConvertible.swiftdeleted−130

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSONParser.swiftdeleted−907

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSONParsing.swiftdeleted−126

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSONSerializing.swiftdeleted−43

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/JSONSubscripting.swiftdeleted−705

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20160830/test_Freddy/main.swiftdeleted−37

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/bin/test_Freddydeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy.xcodeproj/project.pbxprojdeleted−300

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy.xcodeproj/project.xcworkspace/xcshareddata/test_Freddy.xcscmblueprintdeleted−30

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_Freddy.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSON.swiftdeleted−98

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSONDecodable.swiftdeleted−186

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSONEncodable.swiftdeleted−83

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSONEncodingDetector.swiftdeleted−110

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSONLiteralConvertible.swiftdeleted−134

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSONParser.swiftdeleted−918

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSONParsing.swiftdeleted−126

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSONSerializing.swiftdeleted−54

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/JSONSubscripting.swiftdeleted−613

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_20161018/test_Freddy/main.swiftdeleted−40

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/bin/test_Freddy_2_1_0deleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy.xcodeproj/project.pbxprojdeleted−300

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy.xcodeproj/project.xcworkspace/xcshareddata/test_Freddy.xcscmblueprintdeleted−30

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_Freddy.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSON.swiftdeleted−95

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSONDecodable.swiftdeleted−151

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSONEncodable.swiftdeleted−83

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSONEncodingDetector.swiftdeleted−110

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSONLiteralConvertible.swiftdeleted−130

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSONParser.swiftdeleted−903

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSONParsing.swiftdeleted−126

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSONSerializing.swiftdeleted−43

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/JSONSubscripting.swiftdeleted−643

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Freddy_2_1_0/test_Freddy/main.swiftdeleted−37

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_JSONKit/JSONKit.hdeleted−251

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_JSONKit/JSONKit.mdeleted−3065

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_JSONKit/bin/test-JSONKitdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_JSONKit/test-JSONKit.xcodeproj/project.pbxprojdeleted−252

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_JSONKit/test-JSONKit.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_JSONKit/test-JSONKit.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_JSONKit/test-JSONKit.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test-JSONKit.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_JSONKit/test-JSONKit.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_JSONKit/test-JSONKit/main.mdeleted−73

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Json.NET/Program.csdeleted−46

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Json.NET/bin/Release/netcoreapp1.0/publish/Newtonsoft.Json.dlldeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Json.NET/bin/Release/netcoreapp1.0/publish/System.Runtime.Serialization.Primitives.dlldeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Json.NET/bin/Release/netcoreapp1.0/publish/test_Json.NET.deps.jsondeleted−49

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Json.NET/bin/Release/netcoreapp1.0/publish/test_Json.NET.dlldeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Json.NET/bin/Release/netcoreapp1.0/publish/test_Json.NET.pdbdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Json.NET/bin/Release/netcoreapp1.0/publish/test_Json.NET.runtimeconfig.jsondeleted−8

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Json.NET/project.jsondeleted−21

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Json.NET/project.lock.jsondeleted−6741

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Lua_JSON/JSON.luadeleted−1451

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Lua_JSON/test_JSON.luadeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/bin/test_ObjCNSJSONSerializerdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer.xcodeproj/project.pbxprojdeleted−246

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_ObjCNSJSONSerializer.xcschemedeleted−97

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer/a.outdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer/a.out.dSYM/Contents/Info.plistdeleted−20

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer/a.out.dSYM/Contents/Resources/DWARF/a.outdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer/findings_dir/plot_datadeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ObjCNSJSONSerializer/test_ObjCNSJSONSerializer/main.mdeleted−32

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/Accessors.swiftdeleted−255

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/DecimalNumber.swiftdeleted−236

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/Decoder.swiftdeleted−294

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/Encoder.swiftdeleted−167

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/JSON.swiftdeleted−170

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/JSONError.swiftdeleted−1619

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/JSONObject.swiftdeleted−215

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/ObjectiveC.swiftdeleted−233

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/Parser.swiftdeleted−674

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/bin/test_PMJSONdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/test_PMJSON.xcodeproj/project.pbxprojdeleted−296

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/test_PMJSON.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/test_PMJSON.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/test_PMJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_PMJSON.xcschemedeleted−97

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/test_PMJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_1_0/test_PMJSON/main.swiftdeleted−46

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/Accessors.swiftdeleted−255

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/DecimalNumber.swiftdeleted−236

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/Decoder.swiftdeleted−502

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/Encoder.swiftdeleted−215

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/JSON.swiftdeleted−170

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/JSONError.swiftdeleted−1619

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/JSONObject.swiftdeleted−215

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/ObjectiveC.swiftdeleted−331

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/Parser.swiftdeleted−745

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/bin/test_PMJSONdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/test_PMJSON.xcodeproj/project.pbxprojdeleted−296

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/test_PMJSON.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/test_PMJSON.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/test_PMJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_PMJSON.xcschemedeleted−97

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/test_PMJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_PMJSON_1_2_0/test_PMJSON/main.swiftdeleted−46

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4.hdeleted−35

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4Parser.hdeleted−248

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4Parser.mdeleted−287

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamParser.hdeleted−131

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamParser.mdeleted−317

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamParserState.hdeleted−82

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamParserState.mdeleted−355

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamTokeniser.hdeleted−40

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamTokeniser.mdeleted−395

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamWriter.hdeleted−210

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamWriter.mdeleted−358

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamWriterState.hdeleted−69

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4StreamWriterState.mdeleted−147

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4Writer.hdeleted−103

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/SBJson4Writer.mdeleted−102

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/bin/test_SBJSONdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_SBJSON/test_SBJSON.xcodeproj/project.pbxprojdeleted−290

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/test_SBJSON.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/test_SBJSON.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_SBJSON/test_SBJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcdebugger/Breakpoints_v2.xcbkptlistdeleted−5

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/test_SBJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_SBJSON.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/test_SBJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_SBJSON/test_SBJSON/main.mdeleted−38

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSON.xcodeproj/project.pbxprojdeleted−361

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSON.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSON.xcodeproj/project.xcworkspace/xcshareddata/STJSON.xcscmblueprintdeleted−30

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSON.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_STJSON/STJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/STJSON.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/STJSONTests.xcschemedeleted−56

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−32

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSON/STJSONParser.swiftdeleted−663

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSON/main.swiftdeleted−47

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSONTests/Info.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/STJSONTests/STJSONTests.swiftdeleted−92

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_STJSON/bin/STJSONdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Info.plistdeleted−563

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/MacOS/Squeakdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/English.lproj/Localizable.stringsdeleted−9

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/English.lproj/MainMenu.nibdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/Squeak.icnsdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/SqueakChanges.icnsdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/SqueakGeneric.icnsdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/SqueakImage.icnsdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/SqueakPlugin.icnsdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/SqueakProject.icnsdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/SqueakScript.icnsdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak.app/Contents/Resources/SqueakSources.icnsdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/Squeak5.1-16549-32bit.imagedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_Squeak_JSON_tonyg/test_JSON.stdeleted−9

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_TouchJSON/bin/test_TouchJSONdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_TouchJSON/test_TouchJSON.xcodeproj/project.pbxprojdeleted−262

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_TouchJSON/test_TouchJSON.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_TouchJSON/test_TouchJSON.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_TouchJSON/test_TouchJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_TouchJSON.xcschemedeleted−97

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_TouchJSON/test_TouchJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_TouchJSON/test_TouchJSON/CJSONDeserializer.hdeleted−96

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_TouchJSON/test_TouchJSON/CJSONDeserializer.mdeleted−1240

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_TouchJSON/test_TouchJSON/main.mdeleted−25

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_cJSON/bin/test-cJSONdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_cJSON/cJSON.cdeleted−754

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_cJSON/cJSON.hdeleted−153

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_cJSON/test-cJSON.xcodeproj/project.pbxprojdeleted−257

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_cJSON/test-cJSON.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_cJSON/test-cJSON.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_cJSON/test-cJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcdebugger/Breakpoints_v2.xcbkptlistdeleted−5

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_cJSON/test-cJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test-cJSON.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_cJSON/test-cJSON.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_cJSON/test-cJSON/main.cdeleted−69

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/bin/test_ccandeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/common.hdeleted−18

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_10.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_101.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_11.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_12.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_125.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_127.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_13.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_136.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_137.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_139.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_14.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_140.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_145.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_147.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_149.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_15.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_150.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_151.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_153.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_154.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_155.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_156.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_157.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_158.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_159.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_16.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_160.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_161.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_162.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_163.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_164.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_165.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_169.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_17.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_171.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_172.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_173.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_175.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_176.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_177.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_178.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_179.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_18.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_180.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_181.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_183.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_184.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_185.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_186.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_187.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_188.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_189.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_19.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_190.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_191.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_192.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_193.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_194.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_195.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_197.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_198.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_199.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_2.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_20.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_200.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_201.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_202.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_203.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_204.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_205.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_206.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_207.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_208.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_209.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_21.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_210.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_211.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_212.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_213.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_214.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_216.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_217.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_218.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_219.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_22.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_220.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_221.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_222.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_223.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_23.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_24.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_25.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_26.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_27.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_28.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_29.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_3.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_30.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_31.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_32.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_33.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_34.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_35.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_36.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_37.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_4.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_40.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_44.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_46.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_5.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_54.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_55.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_59.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_6.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_63.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_64.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_66.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_69.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_7.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_77.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_78.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_79.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_80.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_81.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_82.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_83.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_85.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_86.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_87.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_9.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/n_91.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_100.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_102.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_103.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_104.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_105.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_106.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_107.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_108.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_109.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_110.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_111.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_112.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_113.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_114.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_115.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_116.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_117.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_118.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_119.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_120.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_121.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_122.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_123.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_124.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_126.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_128.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_129.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_130.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_131.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_132.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_133.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_134.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_135.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_138.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_141.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_142.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_143.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_144.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_146.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_148.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_152.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_166.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_167.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_168.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_170.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_174.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_182.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_196.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_215.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_38.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_39.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_41.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_42.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_43.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_45.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_47.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_48.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_49.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_50.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_51.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_52.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_53.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_56.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_57.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_58.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_60.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_61.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_62.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_65.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_67.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_68.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_70.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_71.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_72.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_73.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_74.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_75.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_76.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_84.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_88.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_89.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_90.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_92.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_93.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_94.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_95.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_96.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_97.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_98.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/nst_files/y_99.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/run-construction.cdeleted−191

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/run-decode-encode.cdeleted−77

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/run-stringify.cdeleted−108

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/run-validate.cdeleted−49

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/test-stringsdeleted−224

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/test-strings-reencodeddeleted−90

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/_test/x.pydeleted−21

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/json.cdeleted−1381

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/json/json.hdeleted−117

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/test_ccan/test_ccan.xcodeproj/project.pbxprojdeleted−262

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/test_ccan/test_ccan.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/test_ccan/test_ccan.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_ccan_json/test_ccan/test_ccan.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_ccan.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/test_ccan/test_ccan.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_ccan_json/test_ccan/test_ccan/main.cdeleted−44

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_dkjson.luadeleted−25

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_go/test_jsondeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_go/test_json.godeleted−30

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_haskell-aeson/.gitignoredeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_haskell-aeson/package.yamldeleted−12

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_haskell-aeson/src/Main.hsdeleted−29

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_haskell-aeson/stack.yamldeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_haskell-aeson/testaesondeleted−8

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_haskell-aeson/testaeson.cabaldeleted−21

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/bin/test_janssondeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jansson/dump.cdeleted−467

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/error.cdeleted−63

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/hashtable.cdeleted−356

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/hashtable.hdeleted−184

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/hashtable_seed.cdeleted−277

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/jansson.hdeleted−298

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/jansson_config.hdeleted−43

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/jansson_private.hdeleted−109

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/load.cdeleted−1110

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/lookup3.hdeleted−381

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/memory.cdeleted−69

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/pack_unpack.cdeleted−871

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/strbuffer.cdeleted−111

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/strbuffer.hdeleted−34

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/strconv.cdeleted−145

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/test_jansson.xcodeproj/project.pbxprojdeleted−309

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/test_jansson.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/test_jansson.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jansson/test_jansson.xcodeproj/xcuserdata/nst.xcuserdatad/xcdebugger/Breakpoints_v2.xcbkptlistdeleted−5

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/test_jansson.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_jansson.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/test_jansson.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/test_jansson/main.cdeleted−208

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/utf.cdeleted−187

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/utf.hdeleted−27

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jansson/value.cdeleted−1048

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_com_leastfixedpoint_json_1_0/META-INF/MANIFEST.MFdeleted−3

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_com_leastfixedpoint_json_1_0/README.txtdeleted−5

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_com_leastfixedpoint_json_1_0/TestJSONParsing.classdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_com_leastfixedpoint_json_1_0/TestJSONParsing.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_com_leastfixedpoint_json_1_0/TestJSONParsing.javadeleted−40

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_com_leastfixedpoint_json_1_0/com.leastfixedpoint.json-1.0.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_gson_2_7/META-INF/MANIFEST.MFdeleted−3

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_gson_2_7/README.txtdeleted−5

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_gson_2_7/TestJSONParsing.classdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_gson_2_7/TestJSONParsing.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_gson_2_7/TestJSONParsing.javadeleted−51

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_gson_2_7/gson-2.7.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_jackson_2_8_4/META-INF/MANIFEST.MFdeleted−3

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_jackson_2_8_4/README.txtdeleted−5

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_jackson_2_8_4/TestJSONParsing.classdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_jackson_2_8_4/TestJSONParsing.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_jackson_2_8_4/TestJSONParsing.javadeleted−48

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_jackson_2_8_4/jackson-annotations-2.2.3.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_jackson_2_8_4/jackson-core-2.8.4.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_jackson_2_8_4/jackson-databind-2.3.1.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_nanojson_1_0/META-INF/MANIFEST.MFdeleted−3

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_nanojson_1_0/README.txtdeleted−5

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_nanojson_1_0/TestJSONParsing.classdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_nanojson_1_0/TestJSONParsing.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_nanojson_1_0/TestJSONParsing.javadeleted−45

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_nanojson_1_0/nanojson-1.0.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_simple_json_1_1_1/META-INF/MANIFEST.MFdeleted−3

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_simple_json_1_1_1/README.txtdeleted−3

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_simple_json_1_1_1/TestJSONParsing.classdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_simple_json_1_1_1/TestJSONParsing.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_java_simple_json_1_1_1/TestJSONParsing.javadeleted−43

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_java_simple_json_1_1_1/json-simple-1.1.1.jardeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jsmn/bin/test_jsmndeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jsmn/jsmn.cdeleted−311

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsmn/jsmn.hdeleted−76

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsmn/test_jsmn/test_jsmn.xcodeproj/project.pbxprojdeleted−253

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsmn/test_jsmn/test_jsmn.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsmn/test_jsmn/test_jsmn.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jsmn/test_jsmn/test_jsmn.xcodeproj/xcuserdata/nst.xcuserdatad/xcdebugger/Breakpoints_v2.xcbkptlistdeleted−23

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsmn/test_jsmn/test_jsmn.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_jsmn.xcschemedeleted−101

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsmn/test_jsmn/test_jsmn.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsmn/test_jsmn/test_jsmn/main.cdeleted−50

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-jq.pydeleted−34

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-parser/bin/test_json-parserdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-parser/test_json-parser.xcodeproj/project.pbxprojdeleted−258

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-parser/test_json-parser.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-parser/test_json-parser.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-parser/test_json-parser.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/test_json-parser.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-parser/test_json-parser.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-parser/test_json-parser/json.cdeleted−1011

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-parser/test_json-parser/json.hdeleted−283

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-parser/test_json-parser/main.cdeleted−66

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust-serde_json/rj/.gitignoredeleted−2

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust-serde_json/rj/Cargo.tomldeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust-serde_json/rj/READMEdeleted−2

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust-serde_json/rj/src/main.rsdeleted−30

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/Cargo.lockdeleted−14

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/Cargo.tomldeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/READMEdeleted−2

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/src/main.rsdeleted−42

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.cargo-lockdeleted

No changes to the content.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/json-74a82b4ec4439e90/dep-lib-jsondeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/json-74a82b4ec4439e90/lib-jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/json-74a82b4ec4439e90/lib-json.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-b5d63a9d8da2968e/bin-tjdeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-b5d63a9d8da2968e/bin-tj.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-b5d63a9d8da2968e/dep-bin-tjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-bb890ae6f101bb25/bin-tjdeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-bb890ae6f101bb25/bin-tj.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-bb890ae6f101bb25/dep-bin-tjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-bf24d0bdc8d0f4d6/bin-tjdeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-bf24d0bdc8d0f4d6/bin-tj.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/.fingerprint/tj-bf24d0bdc8d0f4d6/dep-bin-tjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/deps/libjson-6bbf4c11dd6d7c25.rlibdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/tjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/tj.dSYM/Contents/Info.plistdeleted−20

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rust/target/debug/tj.dSYM/Contents/Resources/DWARF/tjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/Cargo.lockdeleted−14

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/Cargo.tomldeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/READMEdeleted−2

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/src/main.rsdeleted−32

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.cargo-lockdeleted

No changes to the content.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rj-8f8b750d20f3bf10/bin-rjdeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rj-8f8b750d20f3bf10/bin-rj.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rj-8f8b750d20f3bf10/dep-bin-rjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rj-da0f8f63b87cf531/bin-rjdeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rj-da0f8f63b87cf531/bin-rj.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rj-da0f8f63b87cf531/dep-bin-rjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rustc-serialize-80c565222c5ccdbb/dep-lib-rustc-serializedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rustc-serialize-80c565222c5ccdbb/lib-rustc-serializedeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/.fingerprint/rustc-serialize-80c565222c5ccdbb/lib-rustc-serialize.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/deps/librustc_serialize-3561541d79c18212.rlibdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/rjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/rj.dSYM/Contents/Info.plistdeleted−20

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json-rustc_serialize/rj/target/debug/rj.dSYM/Contents/Resources/DWARF/rjdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_json.crdeleted−19

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json.jsdeleted−13

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json.phpdeleted−21

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json.pldeleted−32

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json.pydeleted−39

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json.rbdeleted−23

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker/bin/jsonCheckerdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jsonChecker/jsonChecker/JSON_checker.cdeleted−400

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker/jsonChecker/JSON_checker.hdeleted−13

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker/jsonChecker/jsonChecker.xcodeproj/project.pbxprojdeleted−253

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker/jsonChecker/jsonChecker.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker/jsonChecker/jsonChecker.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jsonChecker/jsonChecker/jsonChecker.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/jsonChecker.xcschemedeleted−91

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker/jsonChecker/jsonChecker.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker/jsonChecker/jsonChecker/main.cdeleted−53

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker2/FSM.rtfdeleted−103

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker2/bin/jsonChecker2deleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jsonChecker2/jsonChecker2/JSON_checker.cdeleted−402

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker2/jsonChecker2/JSON_checker.hdeleted−13

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker2/jsonChecker2/jsonChecker/main.cdeleted−53

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker2/jsonChecker2/jsonChecker2.xcodeproj/project.pbxprojdeleted−253

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker2/jsonChecker2/jsonChecker2.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker2/jsonChecker2/jsonChecker2.xcodeproj/project.xcworkspace/xcuserdata/nst.xcuserdatad/UserInterfaceState.xcuserstatedeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test_jsonChecker2/jsonChecker2/jsonChecker2.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/jsonChecker.xcschemedeleted−97

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonChecker2/jsonChecker2/jsonChecker2.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json_re.rbdeleted−33

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_json_xs.pldeleted−28

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_jsonlite.rdeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_oj_compat.rbdeleted−25

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_oj_strict.rbdeleted−25

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_qt/build.shdeleted−4

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_qt/main.cppdeleted−25

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_qt/test_qt.prodeleted−12

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_rjson.rdeleted−7

This diff is too big to show here.

tests/JSONTestSuite/parsers/test_yajl.rbdeleted−24

This diff is too big to show here.

tests/JSONTestSuite/results/logs.txtdeleted−2048

This diff is too big to show here.

tests/JSONTestSuite/results/parsing.htmldeleted−2816

This diff is too big to show here.

tests/JSONTestSuite/results/parsing_pruned.htmldeleted−2661

This diff is too big to show here.

tests/JSONTestSuite/results/pruned_results.pngdeleted

Binary file not shown.

tests/JSONTestSuite/results/style.cssdeleted−89

This diff is too big to show here.

tests/JSONTestSuite/results/transform.htmldeleted−1492

This diff is too big to show here.

tests/JSONTestSuite/run_tests.pydeleted−673

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_object_key_lone_2nd_surrogate.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_1st_surrogate_but_2nd_missing.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_1st_valid_surrogate_2nd_invalid.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_UTF-16LE_with_BOM.jsondeleted

Binary file not shown.

tests/JSONTestSuite/test_parsing/i_string_UTF-8_invalid_sequence.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_incomplete_surrogate_and_escape_valid.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_incomplete_surrogate_pair.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_incomplete_surrogates_escape_valid.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_invalid_lonely_surrogate.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_invalid_surrogate.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_inverted_surrogates_U+1D11E.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_lone_second_surrogate.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_not_in_unicode_range.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_truncated-utf-8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_unicode_U+10FFFE_nonchar.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_unicode_U+1FFFE_nonchar.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_unicode_U+FDD0_nonchar.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_string_unicode_U+FFFE_nonchar.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_structure_500_nested_arrays.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/i_structure_UTF-8_BOM_empty_object.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_1_true_without_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_a_invalid_utf8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_colon_instead_of_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_comma_after_close.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_comma_and_number.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_double_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_double_extra_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_extra_close.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_extra_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_incomplete.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_incomplete_invalid_value.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_inner_array_no_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_invalid_utf8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_items_separated_by_semicolon.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_just_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_just_minus.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_missing_value.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_newlines_unclosed.jsondeleted−3

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_number_and_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_number_and_several_commas.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_spaces_vertical_tab_formfeed.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_star_inside.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_unclosed.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_unclosed_trailing_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_unclosed_with_new_lines.jsondeleted−3

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_array_unclosed_with_object_inside.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_incomplete_false.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_incomplete_null.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_incomplete_true.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_++.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_+1.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_+Inf.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_-01.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_-1.0..jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_-2..jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_-NaN.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_.-1.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_.2e-3.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_0.1.2.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_0.3e+.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_0.3e.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_0.e1.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_0_capital_E+.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_0_capital_E.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_0e+.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_0e.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_1.0e+.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_1.0e-.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_1.0e.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_1_000.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_1eE2.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_2.e+3.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_2.e-3.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_2.e3.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_9.e+.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_Inf.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_NaN.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_U+FF11_fullwidth_digit_one.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_expression.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_hex_1_digit.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_hex_2_digits.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_infinity.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_invalid+-.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_invalid-negative-real.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_invalid-utf-8-in-bigger-int.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_invalid-utf-8-in-exponent.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_invalid-utf-8-in-int.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_minus_infinity.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_minus_sign_with_trailing_garbage.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_minus_space_1.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_neg_int_starting_with_zero.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_neg_real_without_int_part.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_neg_with_garbage_at_end.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_real_garbage_after_e.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_real_with_invalid_utf8_after_e.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_real_without_fractional_part.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_starting_with_dot.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_then_00.jsondeleted

Binary file not shown.

tests/JSONTestSuite/test_parsing/n_number_with_alpha.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_with_alpha_char.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_number_with_leading_zero.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_bad_value.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_bracket_key.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_comma_instead_of_colon.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_double_colon.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_emoji.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_garbage_at_end.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_key_with_single_quotes.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_missing_colon.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_missing_key.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_missing_semicolon.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_missing_value.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_no-colon.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_non_string_key.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_non_string_key_but_huge_number_instead.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_pi_in_key_and_trailing_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_repeated_null_null.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_several_trailing_commas.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_single_quote.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_trailing_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_trailing_comment.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_trailing_comment_open.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_trailing_comment_slash_open.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_trailing_comment_slash_open_incomplete.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_two_commas_in_a_row.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_unquoted_key.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_unterminated-value.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_with_single_string.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_object_with_trailing_garbage.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_single_space.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape u.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape u1.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape u1x.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_1_surrogate_then_escape.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_UTF8_surrogate_U+D800.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_accentuated_char_no_quotes.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_backslash_00.jsondeleted

Binary file not shown.

tests/JSONTestSuite/test_parsing/n_string_escape_x.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_escaped_backslash_bad.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_escaped_ctrl_char_tab.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_escaped_emoji.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_incomplete_escape.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_incomplete_escaped_character.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_incomplete_surrogate.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_incomplete_surrogate_escape_invalid.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_invalid-utf-8-in-escape.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_invalid_backslash_esc.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_invalid_unicode_escape.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_invalid_utf-8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_invalid_utf8_after_escape.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_iso_latin_1.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_leading_uescaped_thinspace.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_lone_utf8_continuation_byte.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_no_quotes_with_bad_escape.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_overlong_sequence_2_bytes.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_overlong_sequence_6_bytes.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_overlong_sequence_6_bytes_null.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_single_doublequote.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_single_quote.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_single_string_no_double_quotes.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_start_escape_unclosed.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_unescaped_crtl_char.jsondeleted

Binary file not shown.

tests/JSONTestSuite/test_parsing/n_string_unescaped_newline.jsondeleted−2

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_unescaped_tab.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_unicode_CapitalU.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_string_with_trailing_garbage.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_..jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_100000_opening_arrays.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_U+2060_word_joined.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_UTF8_BOM_no_data.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_array_trailing_garbage.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_array_with_extra_array_close.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_array_with_unclosed_string.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_ascii-unicode-identifier.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_capitalized_True.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_close_unopened_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_comma_instead_of_closing_brace.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_double_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_end_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_incomplete_UTF8_BOM.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_lone-invalid-utf-8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_lone-open-bracket.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_no_data.jsondeleted

No changes to the content.

tests/JSONTestSuite/test_parsing/n_structure_null-byte-outside-string.jsondeleted

Binary file not shown.

tests/JSONTestSuite/test_parsing/n_structure_null.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_number_with_trailing_garbage.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_object_followed_by_closing_object.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_object_unclosed_no_value.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_object_with_comment.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_object_with_trailing_garbage.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_array_apostrophe.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_array_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_array_object.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_array_open_object.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_array_open_string.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_array_string.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_object.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_object_close_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_object_comma.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_object_open_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_object_open_string.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_object_string_with_apostrophes.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_open_open.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_single_point.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_single_star.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_trailing_#.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_uescaped_LF_before_string.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_unclosed_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_unclosed_array_partial_null.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_unclosed_array_unfinished_false.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_unclosed_array_unfinished_true.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_unclosed_object.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_unicode-identifier.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_whitespace_U+2060_word_joiner.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/n_structure_whitespace_formfeed.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_arraysWithSpaces.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_empty-string.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_empty.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_ending_with_newline.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_false.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_heterogeneous.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_null.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_with_1_and_newline.jsondeleted−2

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_with_leading_space.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_with_several_null.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_array_with_trailing_space.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_0e+1.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_0e1.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_after_space.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_double_close_to_zero.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_double_huge_neg_exp.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_huge_exp.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_int_with_exp.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_minus_zero.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_neg_int_huge_exp.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_negative_int.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_negative_one.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_negative_zero.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_pos_double_huge_exp.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_capital_e.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_capital_e_neg_exp.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_capital_e_pos_exp.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_exponent.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_fraction_exponent.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_neg_exp.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_neg_overflow.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_pos_exponent.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_pos_overflow.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_real_underflow.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_simple_int.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_simple_real.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_too_big_neg_int.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_too_big_pos_int.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_number_very_big_negative_int.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_basic.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_duplicated_key.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_duplicated_key_and_value.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_empty.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_empty_key.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_escaped_null_in_key.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_extreme_numbers.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_long_strings.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_simple.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_string_unicode.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_object_with_newlines.jsondeleted−3

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_1_2_3_bytes_UTF-8_sequences.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_accepted_surrogate_pair.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_accepted_surrogate_pairs.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_allowed_escapes.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_backslash_and_u_escaped_zero.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_backslash_doublequotes.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_comments.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_double_escape_a.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_double_escape_n.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_escaped_control_character.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_escaped_noncharacter.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_in_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_in_array_with_leading_space.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_last_surrogates_1_and_2.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_newline_uescaped.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_nonCharacterInUTF-8_U+10FFFF.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_nonCharacterInUTF-8_U+1FFFF.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_nonCharacterInUTF-8_U+FFFF.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_null_escape.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_one-byte-utf-8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_pi.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_simple_ascii.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_space.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_surrogates_U+1D11E_MUSICAL_SYMBOL_G_CLEF.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_three-byte-utf-8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_two-byte-utf-8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_u+2028_line_sep.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_u+2029_par_sep.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_uEscape.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_unescaped_char_delete.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_unicode.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_unicodeEscapedBackslash.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_unicode_2.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_unicode_U+200B_ZERO_WIDTH_SPACE.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_unicode_U+2064_invisible_plus.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_unicode_escaped_double_quote.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_utf16BE_no_BOM.jsondeleted

Binary file not shown.

tests/JSONTestSuite/test_parsing/y_string_utf16LE_no_BOM.jsondeleted

Binary file not shown.

tests/JSONTestSuite/test_parsing/y_string_utf8.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_string_with_del_character.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_lonely_false.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_lonely_int.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_lonely_negative_real.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_lonely_null.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_lonely_string.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_lonely_true.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_string_empty.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_trailing_newline.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_true_in_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_parsing/y_structure_whitespace_array.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/number_1.0.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/number_1.000000000000000005.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/number_1000000000000000.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/number_10000000000000000999.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/number_1e-999.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/number_1e6.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/object_key_nfc_nfd.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/object_key_nfd_nfc.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/object_same_key_different_values.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/object_same_key_same_value.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/object_same_key_unclear_values.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/string_1_escaped_invalid_codepoint.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/string_1_invalid_codepoint.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/string_2_escaped_invalid_codepoints.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/string_2_invalid_codepoints.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/string_3_escaped_invalid_codepoints.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/string_3_invalid_codepoints.jsondeleted−1

This diff is too big to show here.

tests/JSONTestSuite/test_transform/string_with_escaped_NULL.jsondeleted−1

This diff is too big to show here.

tests/Options.hs+1−43

This diff is too big to show here.

tests/PropUtils.hsdeleted−208

This diff is too big to show here.

tests/Properties.hs+230−22

This diff is too big to show here.

tests/Properties/ZonedTime.hsnew file+78

This diff is too big to show here.

tests/PropertyGeneric.hsdeleted−116

This diff is too big to show here.

tests/PropertyKeys.hsdeleted−40

This diff is too big to show here.

tests/PropertyRTFunctors.hsdeleted−51

This diff is too big to show here.

tests/PropertyRoundTrip.hsdeleted−74

This diff is too big to show here.

tests/PropertyTH.hsdeleted−130

This diff is too big to show here.

tests/SerializationFormatSpec.hsdeleted−294

This diff is too big to show here.

tests/Tests.hsdeleted−16

This diff is too big to show here.

tests/Types.hs+6−107

This diff is too big to show here.

tests/UnitTests.hsdeleted−760

This diff is too big to show here.

tests/UnitTests/NullaryConstructors.hsdeleted−68

This diff is too big to show here.

tests/golden/generic.expecteddeleted−48

This diff is too big to show here.

tests/golden/simple.expecteddeleted−22

This diff is too big to show here.

travis/cabal_macros.hdeleted−448

This diff is too big to show here.

travis/install.shdeleted−58

This diff is too big to show here.

travis/script.shdeleted−29

This diff is too big to show here.