on 4b78229 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
.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+36−200
@@ -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-2015 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
@@ -31,24 +30,16 @@ module Data.Aeson
31
30
32 -- * Encoding and decoding
31 -- * Encoding and decoding
33 -- $encoding_and_decoding
32 -- $encoding_and_decoding
34−
35− -- ** Direct encoding
36− -- $encoding
37 decode
33 decode
38 , decode'
34 , decode'
39 , eitherDecode
35 , eitherDecode
40 , eitherDecode'
36 , eitherDecode'
41 , encode
37 , encode
42− , encodeFile
43 -- ** Variants for strict bytestrings
38 -- ** Variants for strict bytestrings
44 , decodeStrict
39 , decodeStrict
45− , decodeFileStrict
46 , decodeStrict'
40 , decodeStrict'
47− , decodeFileStrict'
48 , eitherDecodeStrict
41 , eitherDecodeStrict
49− , eitherDecodeFileStrict
50 , eitherDecodeStrict'
42 , eitherDecodeStrict'
51− , eitherDecodeFileStrict'
52 -- * Core JSON types
43 -- * Core JSON types
53 , Value(..)
44 , Value(..)
54 , Encoding
45 , Encoding
@@ -63,106 +54,40 @@ module Data.Aeson
63 , fromJSON
54 , fromJSON
64 , ToJSON(..)
55 , ToJSON(..)
65 , KeyValue(..)
56 , 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 , Series
133− , pairs
72+ , series
134 , foldable
73 , foldable
135 , (.:)
74 , (.:)
136 , (.:?)
75 , (.:?)
137− , (.:!)
138 , (.!=)
76 , (.!=)
139 , object
77 , object
140 -- * Parsing
78 -- * Parsing
141 , json
79 , json
142 , json'
80 , json'
143− , parseIndexedJSON
144 ) where
81 ) where
145
82
146−import Prelude.Compat
83+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')
84+import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith,
85+ eitherDecodeWith, eitherDecodeStrictWith,
86+ jsonEOF, json, jsonEOF', json')
151import Data.Aeson.Types
87import Data.Aeson.Types
152−import Data.Aeson.Types.Internal (JSONPath, formatError, (<?>))
153import qualified Data.ByteString as B
88import qualified Data.ByteString as B
154import qualified Data.ByteString.Lazy as L
89import qualified Data.ByteString.Lazy as L
155
90
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'.
91-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
167-- If this fails due to incomplete or invalid input, 'Nothing' is
92-- If this fails due to incomplete or invalid input, 'Nothing' is
168-- returned.
93-- returned.
@@ -189,24 +114,15 @@ decodeStrict :: (FromJSON a) => B.ByteString -> Maybe a
189decodeStrict = decodeStrictWith jsonEOF fromJSON
114decodeStrict = decodeStrictWith jsonEOF fromJSON
190{-# INLINE decodeStrict #-}
115{-# INLINE decodeStrict #-}
191
116
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'.
117-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
205-- If this fails due to incomplete or invalid input, 'Nothing' is
118-- If this fails due to incomplete or invalid input, 'Nothing' is
206-- returned.
119-- returned.
207--
120--
208-- The input must consist solely of a JSON document, with no trailing
121-- The input must consist solely of a JSON document, with no trailing
209−-- data except for whitespace.
122+-- data except for whitespace. This restriction is necessary to ensure
123+-- that if data is being lazily read from a file handle, the file
124+-- handle will be closed in a timely fashion once the document has
125+-- been parsed.
210--
126--
211-- This function parses and performs conversion immediately. See
127-- This function parses and performs conversion immediately. See
212-- 'json'' for details.
128-- 'json'' for details.
@@ -214,7 +130,7 @@ decode' :: (FromJSON a) => L.ByteString -> Maybe a
214decode' = decodeWith jsonEOF' fromJSON
130decode' = decodeWith jsonEOF' fromJSON
215{-# INLINE decode' #-}
131{-# INLINE decode' #-}
216
132
217−-- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.
133+-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
218-- If this fails due to incomplete or invalid input, 'Nothing' is
134-- If this fails due to incomplete or invalid input, 'Nothing' is
219-- returned.
135-- returned.
220--
136--
@@ -227,56 +143,30 @@ decodeStrict' :: (FromJSON a) => B.ByteString -> Maybe a
227decodeStrict' = decodeStrictWith jsonEOF' fromJSON
143decodeStrict' = decodeStrictWith jsonEOF' fromJSON
228{-# INLINE decodeStrict' #-}
144{-# INLINE decodeStrict' #-}
229
145
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−
242eitherFormatError :: Either (JSONPath, String) a -> Either String a
146eitherFormatError :: Either (JSONPath, String) a -> Either String a
243eitherFormatError = either (Left . uncurry formatError) Right
147eitherFormatError = either (Left . uncurry formatError) Right
244{-# INLINE eitherFormatError #-}
148{-# INLINE eitherFormatError #-}
245
149
246-- | Like 'decode' but returns an error message when decoding fails.
150-- | Like 'decode' but returns an error message when decoding fails.
247eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
151eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
248−eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
152+eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF fromJSON
249{-# INLINE eitherDecode #-}
153{-# INLINE eitherDecode #-}
250
154
251-- | Like 'decodeStrict' but returns an error message when decoding fails.
155-- | Like 'decodeStrict' but returns an error message when decoding fails.
252eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
156eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
253−eitherDecodeStrict =
254− eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON
157+eitherDecodeStrict = eitherFormatError . eitherDecodeStrictWith jsonEOF fromJSON
255{-# INLINE eitherDecodeStrict #-}
158{-# INLINE eitherDecodeStrict #-}
256
159
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.
160-- | Like 'decode'' but returns an error message when decoding fails.
264eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
161eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
265−eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' ifromJSON
162+eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' fromJSON
266{-# INLINE eitherDecode' #-}
163{-# INLINE eitherDecode' #-}
267
164
268-- | Like 'decodeStrict'' but returns an error message when decoding fails.
165-- | Like 'decodeStrict'' but returns an error message when decoding fails.
269eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
166eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
270−eitherDecodeStrict' =
271− eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON
167+eitherDecodeStrict' = eitherFormatError . eitherDecodeStrictWith jsonEOF' fromJSON
272{-# INLINE eitherDecodeStrict' #-}
168{-# INLINE eitherDecodeStrict' #-}
273
169
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
170-- $use
281--
171--
282-- This section contains basic information on the different ways to
172-- This section contains basic information on the different ways to
@@ -307,17 +197,8 @@ eitherDecodeFileStrict' =
307-- 'FromJSON' and 'ToJSON' instances for which the compiler will
197-- 'FromJSON' and 'ToJSON' instances for which the compiler will
308-- generate sensible default implementations.
198-- generate sensible default implementations.
309--
199--
310−-- @
311−-- instance 'ToJSON' Person where
200+-- > instance ToJSON Person
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
201+-- > instance FromJSON Person
319−-- \-- No need to provide a 'parseJSON' implementation.
320−-- @
321--
202--
322-- We can now encode a value like so:
203-- We can now encode a value like so:
323--
204--
@@ -346,28 +227,27 @@ eitherDecodeFileStrict' =
346-- > {-# LANGUAGE OverloadedStrings #-}
227-- > {-# LANGUAGE OverloadedStrings #-}
347-- >
228-- >
348-- > instance FromJSON Person where
229-- > instance FromJSON Person where
349−-- > parseJSON = withObject "Person" $ \v -> Person
230+-- > parseJSON (Object v) = Person <$>
350−-- > <$> v .: "name"
231+-- > v .: "name" <*>
351−-- > <*> v .: "age"
232+-- > v .: "age"
233+-- > -- A non-Object value is of the wrong type, so fail.
234+-- > parseJSON _ = empty
352--
235--
353-- We can now parse the JSON data like so:
236-- We can now parse the JSON data like so:
354--
237--
355-- > >>> decode "{\"name\":\"Joe\",\"age\":12}" :: Maybe Person
238-- > >>> decode "{\"name\":\"Joe\",\"age\":12}" :: Maybe Person
356-- > Just (Person {name = "Joe", age = 12})
239-- > Just (Person {name = "Joe", age = 12})
357--
240--
358−-- To encode data, we need to define a 'ToJSON' instance. Let's begin
241+-- To encode data, we need to define a 'ToJSON' instance:
359−-- with an instance written entirely by hand.
360−--
361−-- @
362−-- instance ToJSON Person where
363−-- \-- this generates a 'Value'
364−-- 'toJSON' (Person name age) =
365−-- 'object' [\"name\" '.=' name, \"age\" '.=' age]
366--
242--
243+-- > instance ToJSON Person where
244+-- > -- this generates a Value
245+-- > toJSON (Person name age) =
246+-- > object ["name" .= name, "age" .= age]
247+-- >
367−-- \-- this encodes directly to a bytestring Builder
248+-- > -- this encodes directly to a ByteString Builder
368−-- 'toEncoding' (Person name age) =
249+-- > toEncoding (Person name age) =
369−-- 'pairs' (\"name\" '.=' 'name' '<>' \"age\" '.=' age)
250+-- > series $ "name" .= name <> "age" .= age
370−-- @
371--
251--
372-- We can now encode a value like so:
252-- We can now encode a value like so:
373--
253--
@@ -438,7 +318,7 @@ eitherDecodeFileStrict' =
438-- The 'Object' type contains JSON objects:
318-- The 'Object' type contains JSON objects:
439--
319--
440-- > λ> decode "{\"name\":\"Dave\",\"age\":2}" :: Maybe Object
320-- > λ> decode "{\"name\":\"Dave\",\"age\":2}" :: Maybe Object
441−-- > Just (fromList [("name",String "Dave"),("age",Number 2)])
321+-- > Just (fromList) [("name",String "Dave"),("age",Number 2)]
442--
322--
443-- You can extract values from it with a parser using 'parse',
323-- You can extract values from it with a parser using 'parse',
444-- 'parseEither' or, in this example, 'parseMaybe':
324-- 'parseEither' or, in this example, 'parseMaybe':
@@ -481,47 +361,3 @@ eitherDecodeFileStrict' =
481--
361--
482-- For convenience, the 'encode' and 'decode' functions combine both
362-- For convenience, the 'encode' and 'decode' functions combine both
483-- steps.
363-- steps.
484−
485−-- $encoding
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−--
515−-- To encode to a JSON \"object\", use the 'pairs' function.
516−--
517−-- @
518−-- 'toEncoding' (Person name age) =
519−-- 'pairs' (\"name\" '.=' 'name' '<>' \"age\" '.=' age)
520−-- @
521−--
522−-- Any container type that implements 'Foldable' can be encoded to a
523−-- JSON \"array\" using 'foldable'.
524−--
525−-- > > import Data.Sequence as Seq
526−-- > > encode (Seq.fromList [1,2,3])
527−-- > "[1,2,3]"
Data/Aeson/Encode.hs+82−17
@@ -1,31 +1,96 @@
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-2015 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
16 , encodeToTextBuilder
24 , encodeToTextBuilder
25+
26+ -- * Deprecated
27+ , fromValue
17 ) where
28 ) where
18
29
30+import Data.Aeson.Types (Value(..))
31+import Data.Monoid ((<>))
32+import Data.Scientific (FPFormat(..), Scientific, base10Exponent)
33+import Data.Text.Lazy.Builder
34+import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
35+import Numeric (showHex)
36+import qualified Data.HashMap.Strict as H
37+import qualified Data.Text as T
38+import qualified Data.Vector as V
39+
40+import Data.Aeson.Encode.ByteString (encode, encodeToBuilder)
41+
42+-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
43+-- embedded efficiently in a text-based protocol.
44+encodeToTextBuilder :: Value -> Builder
45+encodeToTextBuilder =
46+ go
47+ where
48+ go Null = {-# SCC "go/Null" #-} "null"
49+ go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"
50+ go (Number s) = {-# SCC "go/Number" #-} fromScientific s
51+ go (String s) = {-# SCC "go/String" #-} string s
52+ go (Array v)
53+ | V.null v = {-# SCC "go/Array" #-} "[]"
54+ | otherwise = {-# SCC "go/Array" #-}
55+ singleton '[' <>
56+ go (V.unsafeHead v) <>
57+ V.foldr f (singleton ']') (V.unsafeTail v)
58+ where f a z = singleton ',' <> go a <> z
59+ go (Object m) = {-# SCC "go/Object" #-}
60+ case H.toList m of
61+ (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs
62+ _ -> "{}"
63+ where f a z = singleton ',' <> one a <> z
64+ one (k,v) = string k <> singleton ':' <> go v
65+
66+{-# DEPRECATED fromValue "Use 'encodeToTextBuilder' instead" #-}
67+fromValue :: Value -> Builder
68+fromValue = encodeToTextBuilder
19
69
20−import Data.ByteString.Lazy (ByteString)
70+string :: T.Text -> Builder
21−import Data.Text.Lazy.Builder (Builder)
71+string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'
22−import qualified Data.Aeson as A
72+ where
23−import qualified Data.Aeson.Text as A
73+ quote q = case T.uncons t of
74+ Nothing -> fromText h
75+ Just (!c,t') -> fromText h <> escape c <> quote t'
76+ where (h,t) = {-# SCC "break" #-} T.break isEscape q
77+ isEscape c = c == '\"' ||
78+ c == '\\' ||
79+ c < '\x20'
80+ escape '\"' = "\\\""
81+ escape '\\' = "\\\\"
82+ escape '\n' = "\\n"
83+ escape '\r' = "\\r"
84+ escape '\t' = "\\t"
24
85
25−encode :: A.ToJSON a => a -> ByteString
86+ escape c
26−encode = A.encode
87+ | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
27−{-# DEPRECATED encode "Use encode from Data.Aeson" #-}
88+ | otherwise = singleton c
89+ where h = showHex (fromEnum c) ""
28
90
29−encodeToTextBuilder :: A.Value -> Builder
91+fromScientific :: Scientific -> Builder
30−encodeToTextBuilder = A.encodeToTextBuilder
92+fromScientific s = formatScientificBuilder format prec s
31−{-# DEPRECATED encodeToTextBuilder "Use encodeTotextBuilder from Data.Aeson.Text" #-}
93+ where
94+ (format, prec)
95+ | base10Exponent s < 0 = (Generic, Nothing)
96+ | otherwise = (Fixed, Just 0)
Data/Aeson/Encode/ByteString.hsnew file+138
@@ -0,0 +1,138 @@
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2+
3+-- |
4+-- Module: Data.Aeson.Encode.ByteString
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+ , null_
18+ , bool
19+ , array
20+ , emptyArray_
21+ , emptyObject_
22+ , object
23+ , text
24+ , unquoted
25+ , number
26+ , ascii2
27+ , ascii4
28+ , ascii5
29+ ) where
30+
31+import Data.Aeson.Types.Class (ToJSON(..))
32+import Data.Aeson.Types.Internal (Encoding(..), Value(..))
33+import Data.ByteString.Builder as B
34+import Data.ByteString.Builder.Prim as BP
35+import Data.ByteString.Builder.Scientific (scientificBuilder)
36+import Data.Char (ord)
37+import Data.Monoid ((<>))
38+import Data.Scientific (Scientific, base10Exponent, coefficient)
39+import Data.Word (Word8)
40+import qualified Data.ByteString.Lazy as L
41+import qualified Data.HashMap.Strict as HMS
42+import qualified Data.Text as T
43+import qualified Data.Text.Encoding as TE
44+import qualified Data.Vector as V
45+
46+-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
47+encode :: ToJSON a => a -> L.ByteString
48+encode = B.toLazyByteString . encodeToBuilder . toJSON
49+
50+-- | Encode a JSON value to a ByteString 'B.Builder'. Use this function if you
51+-- must prepend or append further bytes to the encoded JSON value.
52+encodeToBuilder :: Value -> Builder
53+encodeToBuilder Null = null_
54+encodeToBuilder (Bool b) = bool b
55+encodeToBuilder (Number n) = number n
56+encodeToBuilder (String s) = text s
57+encodeToBuilder (Array v) = array v
58+encodeToBuilder (Object m) = object m
59+
60+-- | Encode a JSON null.
61+null_ :: Builder
62+null_ = BP.primBounded (ascii4 ('n',('u',('l','l')))) ()
63+
64+-- | Encode a JSON boolean.
65+bool :: Bool -> Builder
66+bool = BP.primBounded (BP.condB id (ascii4 ('t',('r',('u','e'))))
67+ (ascii5 ('f',('a',('l',('s','e'))))))
68+
69+-- | Encode a JSON array.
70+array :: V.Vector Value -> Builder
71+array v
72+ | V.null v = B.char8 '[' <> B.char8 ']'
73+ | otherwise = B.char8 '[' <>
74+ encodeToBuilder (V.unsafeHead v) <>
75+ V.foldr withComma (B.char8 ']') (V.unsafeTail v)
76+ where
77+ withComma a z = B.char8 ',' <> encodeToBuilder a <> z
78+
79+-- Encode a JSON object.
80+object :: HMS.HashMap T.Text Value -> Builder
81+object m = case HMS.toList m of
82+ (x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs
83+ _ -> B.char8 '{' <> B.char8 '}'
84+ where
85+ withComma a z = B.char8 ',' <> one a <> z
86+ one (k,v) = text k <> B.char8 ':' <> encodeToBuilder v
87+
88+-- | Encode a JSON string.
89+text :: T.Text -> Builder
90+text t = B.char8 '"' <> unquoted t <> B.char8 '"'
91+
92+-- | Encode a JSON string, without enclosing quotes.
93+unquoted :: T.Text -> Builder
94+unquoted t = TE.encodeUtf8BuilderEscaped escapeAscii t
95+ where
96+ escapeAscii :: BP.BoundedPrim Word8
97+ escapeAscii =
98+ BP.condB (== c2w '\\' ) (ascii2 ('\\','\\')) $
99+ BP.condB (== c2w '\"' ) (ascii2 ('\\','"' )) $
100+ BP.condB (>= c2w '\x20') (BP.liftFixedToBounded BP.word8) $
101+ BP.condB (== c2w '\n' ) (ascii2 ('\\','n' )) $
102+ BP.condB (== c2w '\r' ) (ascii2 ('\\','r' )) $
103+ BP.condB (== c2w '\t' ) (ascii2 ('\\','t' )) $
104+ (BP.liftFixedToBounded hexEscape) -- fallback for chars < 0x20
105+
106+ c2w = fromIntegral . ord
107+
108+ hexEscape :: BP.FixedPrim Word8
109+ hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<
110+ BP.char8 >*< BP.char8 >*< BP.word16HexFixed
111+
112+-- | Encode a JSON number.
113+number :: Scientific -> Builder
114+number s
115+ | e < 0 = scientificBuilder s
116+ | otherwise = B.integerDec (coefficient s * 10 ^ e)
117+ where
118+ e = base10Exponent s
119+
120+emptyArray_ :: Encoding
121+emptyArray_ = Encoding (BP.primBounded (ascii2 ('[',']')) ())
122+
123+emptyObject_ :: Encoding
124+emptyObject_ = Encoding (BP.primBounded (ascii2 ('{','}')) ())
125+
126+ascii2 :: (Char, Char) -> BP.BoundedPrim a
127+ascii2 cs = BP.liftFixedToBounded $ (const cs) BP.>$< BP.char7 >*< BP.char7
128+{-# INLINE ascii2 #-}
129+
130+ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a
131+ascii4 cs = BP.liftFixedToBounded $ (const cs) >$<
132+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
133+{-# INLINE ascii4 #-}
134+
135+ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a
136+ascii5 cs = BP.liftFixedToBounded $ (const cs) >$<
137+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
138+{-# INLINE ascii5 #-}
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-2015 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-2015 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+197−359
@@ -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-2015 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 (JSONPath, 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--
151--
216−-- 'jsonLast' keeps the last occurence of each key, using
152+-- In particular, be careful in using this function if you think your
217−-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.
153+-- code might interoperate with Javascript. A na&#xef;ve Javascript
218−--
154+-- library that parses JSON data using @eval@ is vulnerable to attack
219−-- @
155+-- unless the encoded data represents an object or an array. JSON
220−-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))
156+-- implementations in other languages conform to that same restriction
221−-- @
157+-- to preserve interoperability and security.
222−--
158+value :: Parser Value
223−-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using
159+value = do
224−-- 'fromListAccum'.
225−--
226−-- @
227−-- 'jsonAccum' = 'jsonWith' ('Right' . 'fromListAccum')
228−-- @
229−--
230−-- 'jsonNoDup' fails if any object contains duplicate keys, using 'parseListNoDup'.
231−--
232−-- @
233−-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'
234−-- @
235−jsonWith :: ([(Text, Value)] -> Either String Object) -> Parser Value
236−jsonWith mkObject = fix $ \value_ -> do
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
172
255−-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve
256−-- key-value pairs with the same keys.
257−jsonAccum :: Parser Value
258−jsonAccum = jsonWith (Right . fromListAccum)
259−
260−-- | Variant of 'json' which fails if any object contains duplicate keys.
261−jsonNoDup :: Parser Value
262−jsonNoDup = jsonWith parseListNoDup
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 =
@@ -378,32 +287,27 @@ decodeWith p to s =
378decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
287decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
379 -> Maybe a
288 -> Maybe a
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 _ -> 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 (JSONPath, 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 path msg -> Left (path, 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 (JSONPath, 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 path msg -> Left (path, 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+377−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-2015 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, (&&) , not)
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) )
99+import Data.List ( (++), foldl, foldl', intercalate
132−import Data.List (foldl', genericLength, intercalate, partition, union)
100+ , length, map, zip, genericLength, all, partition
133−import Data.List.NonEmpty ((<|), NonEmpty((:|)))
101+ )
134−import Data.Map (Map)
102+import Data.Maybe ( Maybe(Nothing, Just), catMaybes )
135−import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
103+import Prelude ( String, (-), Integer, fromIntegral, error )
136−import qualified Data.Monoid as Monoid
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,274 @@ 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
453− info@ConstructorInfo { constructorName = conName
454− , constructorVariant = RecordConstructor fields
455− , constructorFields = argTys } =
456− case (unwrapUnaryRecords opts, not multiCons, argTys) of
284+encodeArgs opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts,not multiCons,ts) of
457− (True,True,[_]) -> argsToValue target jc tvMap opts multiCons
285+ (True,True,[(_,st,ty)])-> encodeArgs opts multiCons (NormalC conName [(st,ty)])
458− (info{constructorVariant = NormalConstructor})
459− _ -> do
286+ _ -> do
460− argTys' <- mapM resolveTypeSynonyms argTys
287+ args <- mapM newName ["arg" ++ show n | (_, n) <- zip ts [1 :: Integer ..]]
461− args <- newNameList "arg" $ length argTys'
288+ let exp = [|object|] `appE` pairs
289+
462− let pairs | omitNothingFields opts = infixApp maybeFields
290+ pairs | omitNothingFields opts = infixApp maybeFields
463− [|(Monoid.<>)|]
291+ [|(++)|]
464− restFields
292+ restFields
465− | otherwise = mconcatE (map pureToPair argCons)
293+ | otherwise = listE $ map toPair argCons
466−
294+
467− argCons = zip3 (map varE args) argTys' fields
295+ argCons = zip args ts
468−
296+
469− maybeFields = mconcatE (map maybeToPair maybes)
297+ maybeFields = [|catMaybes|] `appE` listE (map maybeToPair maybes)
470−
298+
471− restFields = mconcatE (map pureToPair rest)
299+ restFields = listE $ map toPair rest
472−
300+
473− (maybes0, rest0) = partition isMaybe argCons
301+ (maybes, rest) = partition isMaybe argCons
474− (options, rest) = partition isOption rest0
302+
475− maybes = maybes0 ++ map optionToMaybe options
303+ isMaybe (_, (_, _, AppT (ConT t) _)) = t == ''Maybe
476−
304+ isMaybe _ = False
477− maybeToPair = toPairLifted True
305+
478− pureToPair = toPairLifted False
306+ maybeToPair (arg, (field, _, _)) =
479−
307+ infixApp (infixE (Just $ toFieldName field)
480− toPairLifted lifted (arg, argTy, field) =
308+ [|(.=)|]
481− let toValue = dispatchToJSON target jc conName tvMap argTy
309+ Nothing)
482− fieldName = fieldLabel opts field
310+ [|(<$>)|]
483− e arg' = pairE fieldName (toValue `appE` arg')
311+ (varE arg)
484− in if lifted
312+
485− then do
313+ toPair (arg, (field, _, _)) =
486− x <- newName "x"
314+ infixApp (toFieldName field)
487− [|maybe mempty|] `appE` lam1E (varP x) (e (varE x)) `appE` arg
315+ [|(.=)|]
488− else e arg
316+ (varE arg)
489−
317+
318+ toFieldName field = [|T.pack|] `appE` fieldLabelExp opts field
319+
490− match (conP conName $ map varP args)
320+ match (conP conName $ map varP args)
491− (normalB $ recordSumToValue target opts multiCons (null argTys) conName pairs)
321+ ( normalB
322+ $ if multiCons
323+ then case sumEncoding opts of
324+ TwoElemArray -> [|toJSON|] `appE` tupE [conStr opts conName, exp]
325+ TaggedObject{tagFieldName} ->
326+ [|object|] `appE`
327+ -- TODO: Maybe throw an error in case
328+ -- tagFieldName overwrites a field in pairs.
329+ infixApp (infixApp [|T.pack tagFieldName|]
330+ [|(.=)|]
331+ (conStr opts conName))
332+ [|(:)|]
333+ pairs
334+ ObjectWithSingleField ->
335+ [|object|] `appE` listE
336+ [ infixApp (conTxt opts conName) [|(.=)|] exp ]
337+ else exp
492− []
338+ ) []
493
339
494-- Infix constructors.
340-- Infix constructors.
495−argsToValue target jc tvMap opts multiCons
341+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"
342 al <- newName "argL"
501 ar <- newName "argR"
343 ar <- newName "argR"
502 match (infixP (varP al) conName (varP ar))
344 match (infixP (varP al) conName (varP ar))
503 ( normalB
345 ( normalB
504− $ opaqueSumToValue target opts multiCons False conName
346+ $ encodeSum opts multiCons conName
505− $ array target
506− [ dispatchToJSON target jc conName tvMap aTy
507− `appE` varE a
347+ $ [|toJSON|] `appE` listE [ [|toJSON|] `appE` varE a
508− | (a, aTy) <- [(al,alTy), (ar,arTy)]
348+ | a <- [al,ar]
509− ]
349+ ]
510 )
350 )
511 []
351 []
352+-- Existentially quantified constructors.
353+encodeArgs opts multiCons (ForallC _ _ con) =
354+ encodeArgs opts multiCons con
512
355
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
356
575--------------------------------------------------------------------------------
357--------------------------------------------------------------------------------
576-- FromJSON
358-- FromJSON
577--------------------------------------------------------------------------------
359--------------------------------------------------------------------------------
578
360
579−-- | Generates a 'FromJSON' instance declaration for the given data type or
361+-- | Generates a 'FromJSON' instance declaration for the given data type.
580−-- data family instance constructor.
581deriveFromJSON :: Options
362deriveFromJSON :: Options
582 -- ^ Encoding options.
363 -- ^ Encoding options.
583 -> Name
364 -> Name
584 -- ^ Name of the type for which to generate a 'FromJSON' instance
365 -- ^ Name of the type for which to generate a 'FromJSON' instance
585 -- declaration.
366 -- declaration.
586 -> Q [Dec]
367 -> Q [Dec]
587−deriveFromJSON = deriveFromJSONCommon fromJSONClass
368+deriveFromJSON opts name =
588−
369+ withType name $ \tvbs cons -> fmap (:[]) $ fromCons tvbs cons
589−-- | Generates a 'FromJSON1' instance declaration for the given data type or
370+ where
590−-- data family instance constructor.
371+ fromCons :: [TyVarBndr] -> [Con] -> Q Dec
591−deriveFromJSON1 :: Options
372+ fromCons tvbs cons =
592− -- ^ Encoding options.
373+ instanceD (applyCon ''FromJSON typeNames)
593− -> Name
374+ (classType `appT` instanceType)
594− -- ^ Name of the type for which to generate a 'FromJSON1' instance
375+ [ funD 'parseJSON
595− -- declaration.
376+ [ clause []
596− -> Q [Dec]
377+ (normalB $ consFromJSON name opts cons)
597−deriveFromJSON1 = deriveFromJSONCommon fromJSON1Class
378+ []
598−
379+ ]
599−-- | Generates a 'FromJSON2' instance declaration for the given data type or
380+ ]
600−-- data family instance constructor.
381+ where
601−deriveFromJSON2 :: Options
382+ classType = conT ''FromJSON
602− -- ^ Encoding options.
383+ typeNames = map tvbName tvbs
603− -> Name
384+ 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
385
619-- | Generates a lambda expression which parses the JSON encoding of the given
386-- | Generates a lambda expression which parses the JSON encoding of the given
620−-- data type or data family instance constructor.
387+-- data type.
621mkParseJSON :: Options -- ^ Encoding options.
388mkParseJSON :: Options -- ^ Encoding options.
622 -> Name -- ^ Name of the encoded type.
389 -> Name -- ^ Name of the encoded type.
623 -> Q Exp
390 -> Q Exp
624−mkParseJSON = mkParseJSONCommon fromJSONClass
391+mkParseJSON opts name =
625−
392+ 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
393
648-- | Helper function used by both 'deriveFromJSON' and 'mkParseJSON'. Generates
394-- | Helper function used by both 'deriveFromJSON' and 'mkParseJSON'. Generates
649-- code to parse the JSON encoding of a number of constructors. All constructors
395-- code to parse the JSON encoding of a number of constructors. All constructors
650-- must be from the same type.
396-- must be from the same type.
651−consFromJSON :: JSONClass
397+consFromJSON :: Name
652− -- ^ The FromJSON variant being derived.
653− -> Name
654 -- ^ Name of the type to which the constructors belong.
398 -- ^ Name of the type to which the constructors belong.
655 -> Options
399 -> Options
656 -- ^ Encoding options
400 -- ^ Encoding options
657− -> [Type]
401+ -> [Con]
658− -- ^ The types from the data type/data family instance declaration
659− -> [ConstructorInfo]
660 -- ^ Constructors for which to generate JSON parsing code.
402 -- ^ Constructors for which to generate JSON parsing code.
661 -> Q Exp
403 -> Q Exp
662
404
663−consFromJSON _ _ _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
405+consFromJSON _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
664− ++ "Not a single constructor given!"
406+ ++ "Not a single constructor given!"
665
407
666−consFromJSON jc tName opts instTys cons = do
408+consFromJSON tName opts [con] = do
667 value <- newName "value"
409 value <- newName "value"
668− pjs <- newNameList "_pj" $ arityInt jc
410+ 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
411
676− where
412+consFromJSON tName opts cons = do
677− checkExi tvMap con = checkExistentialContext jc tvMap
413+ 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) $
414+ lam1E (varP value) $ caseE (varE value) $
689− if allNullaryToStringTag opts && all isNullary cons
415+ if allNullaryToStringTag opts && all isNullary cons
690− then allNullaryMatches
416+ then allNullaryMatches
691− else mixedMatches tvMap
417+ else mixedMatches
692
418
419+ where
693 allNullaryMatches =
420 allNullaryMatches =
694 [ do txt <- newName "txt"
421 [ do txt <- newName "txt"
695 match (conP 'String [varP txt])
422 match (conP 'String [varP txt])
@@ -697,17 +424,18 @@ consFromJSON jc tName opts instTys cons = do
697 [ liftM2 (,) (normalG $
424 [ liftM2 (,) (normalG $
698 infixApp (varE txt)
425 infixApp (varE txt)
699 [|(==)|]
426 [|(==)|]
427+ ([|T.pack|] `appE`
700− (conTxt opts conName)
428+ conStringE opts conName)
701 )
429 )
702 ([|pure|] `appE` conE conName)
430 ([|pure|] `appE` conE conName)
703 | con <- cons
431 | con <- cons
704− , let conName = constructorName con
432+ , let conName = getConName con
705 ]
433 ]
706 ++
434 ++
707 [ liftM2 (,)
435 [ liftM2 (,)
708 (normalG [|otherwise|])
436 (normalG [|otherwise|])
709 ( [|noMatchFail|]
437 ( [|noMatchFail|]
710− `appE` litE (stringL $ show tName)
438+ `appE` (litE $ stringL $ show tName)
711 `appE` ([|T.unpack|] `appE` varE txt)
439 `appE` ([|T.unpack|] `appE` varE txt)
712 )
440 )
713 ]
441 ]
@@ -716,31 +444,30 @@ consFromJSON jc tName opts instTys cons = do
716 , do other <- newName "other"
444 , do other <- newName "other"
717 match (varP other)
445 match (varP other)
718 (normalB $ [|noStringFail|]
446 (normalB $ [|noStringFail|]
719− `appE` litE (stringL $ show tName)
447+ `appE` (litE $ stringL $ show tName)
720 `appE` ([|valueConName|] `appE` varE other)
448 `appE` ([|valueConName|] `appE` varE other)
721 )
449 )
722 []
450 []
723 ]
451 ]
724
452
725− mixedMatches tvMap =
453+ mixedMatches =
726 case sumEncoding opts of
454 case sumEncoding opts of
727 TaggedObject {tagFieldName, contentsFieldName} ->
455 TaggedObject {tagFieldName, contentsFieldName} ->
728− parseObject $ parseTaggedObject tvMap tagFieldName contentsFieldName
456+ parseObject $ parseTaggedObject tagFieldName contentsFieldName
729− UntaggedValue -> error "UntaggedValue: Should be handled already"
730 ObjectWithSingleField ->
457 ObjectWithSingleField ->
731− parseObject $ parseObjectWithSingleField tvMap
458+ parseObject $ parseObjectWithSingleField
732 TwoElemArray ->
459 TwoElemArray ->
733 [ do arr <- newName "array"
460 [ do arr <- newName "array"
734 match (conP 'Array [varP arr])
461 match (conP 'Array [varP arr])
735− (guardedB
462+ (guardedB $
736 [ liftM2 (,) (normalG $ infixApp ([|V.length|] `appE` varE arr)
463 [ liftM2 (,) (normalG $ infixApp ([|V.length|] `appE` varE arr)
737 [|(==)|]
464 [|(==)|]
738 (litE $ integerL 2))
465 (litE $ integerL 2))
739− (parse2ElemArray tvMap arr)
466+ (parse2ElemArray arr)
740 , liftM2 (,) (normalG [|otherwise|])
467 , liftM2 (,) (normalG [|otherwise|])
741− ([|not2ElemArray|]
468+ (([|not2ElemArray|]
742− `appE` litE (stringL $ show tName)
469+ `appE` (litE $ stringL $ show tName)
743− `appE` ([|V.length|] `appE` varE arr))
470+ `appE` ([|V.length|] `appE` varE arr)))
744 ]
471 ]
745 )
472 )
746 []
473 []
@@ -748,7 +475,7 @@ consFromJSON jc tName opts instTys cons = do
748 match (varP other)
475 match (varP other)
749 ( normalB
476 ( normalB
750 $ [|noArrayFail|]
477 $ [|noArrayFail|]
751− `appE` litE (stringL $ show tName)
478+ `appE` (litE $ stringL $ show tName)
752 `appE` ([|valueConName|] `appE` varE other)
479 `appE` ([|valueConName|] `appE` varE other)
753 )
480 )
754 []
481 []
@@ -761,47 +488,22 @@ consFromJSON jc tName opts instTys cons = do
761 match (varP other)
488 match (varP other)
762 ( normalB
489 ( normalB
763 $ [|noObjectFail|]
490 $ [|noObjectFail|]
764− `appE` litE (stringL $ show tName)
491+ `appE` (litE $ stringL $ show tName)
765 `appE` ([|valueConName|] `appE` varE other)
492 `appE` ([|valueConName|] `appE` varE other)
766 )
493 )
767 []
494 []
768 ]
495 ]
769
496
770− parseTaggedObject tvMap typFieldName valFieldName obj = do
497+ parseTaggedObject typFieldName valFieldName obj = do
771 conKey <- newName "conKey"
498 conKey <- newName "conKey"
772 doE [ bindS (varP conKey)
499 doE [ bindS (varP conKey)
773 (infixApp (varE obj)
500 (infixApp (varE obj)
774 [|(.:)|]
501 [|(.:)|]
775 ([|T.pack|] `appE` stringE typFieldName))
502 ([|T.pack|] `appE` stringE typFieldName))
776− , noBindS $ parseContents tvMap conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject
503+ , noBindS $ parseContents conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject
777 ]
504 ]
778
505
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
506+ parse2ElemArray arr = do
805 conKey <- newName "conKey"
507 conKey <- newName "conKey"
806 conVal <- newName "conVal"
508 conVal <- newName "conVal"
807 let letIx n ix =
509 let letIx n ix =
@@ -816,8 +518,7 @@ consFromJSON jc tName opts instTys cons = do
816 (caseE (varE conKey)
518 (caseE (varE conKey)
817 [ do txt <- newName "txt"
519 [ do txt <- newName "txt"
818 match (conP 'String [varP txt])
520 match (conP 'String [varP txt])
819− (normalB $ parseContents tvMap
521+ (normalB $ parseContents txt
820− txt
821 (Right conVal)
522 (Right conVal)
822 'conNotFoundFail2ElemArray
523 'conNotFoundFail2ElemArray
823 )
524 )
@@ -826,30 +527,30 @@ consFromJSON jc tName opts instTys cons = do
826 match (varP other)
527 match (varP other)
827 ( normalB
528 ( normalB
828 $ [|firstElemNoStringFail|]
529 $ [|firstElemNoStringFail|]
829− `appE` litE (stringL $ show tName)
530+ `appE` (litE $ stringL $ show tName)
830 `appE` ([|valueConName|] `appE` varE other)
531 `appE` ([|valueConName|] `appE` varE other)
831 )
532 )
832 []
533 []
833 ]
534 ]
834 )
535 )
835
536
836− parseObjectWithSingleField tvMap obj = do
537+ parseObjectWithSingleField obj = do
837 conKey <- newName "conKey"
538 conKey <- newName "conKey"
838 conVal <- newName "conVal"
539 conVal <- newName "conVal"
839 caseE ([e|H.toList|] `appE` varE obj)
540 caseE ([e|H.toList|] `appE` varE obj)
840 [ match (listP [tupP [varP conKey, varP conVal]])
541 [ match (listP [tupP [varP conKey, varP conVal]])
841− (normalB $ parseContents tvMap conKey (Right conVal) 'conNotFoundFailObjectSingleField)
542+ (normalB $ parseContents conKey (Right conVal) 'conNotFoundFailObjectSingleField)
842 []
543 []
843 , do other <- newName "other"
544 , do other <- newName "other"
844 match (varP other)
545 match (varP other)
845 (normalB $ [|wrongPairCountFail|]
546 (normalB $ [|wrongPairCountFail|]
846− `appE` litE (stringL $ show tName)
547+ `appE` (litE $ stringL $ show tName)
847 `appE` ([|show . length|] `appE` varE other)
548 `appE` ([|show . length|] `appE` varE other)
848 )
549 )
849 []
550 []
850 ]
551 ]
851
552
852− parseContents tvMap conKey contents errorFun =
553+ parseContents conKey contents errorFun =
853 caseE (varE conKey)
554 caseE (varE conKey)
854 [ match wildP
555 [ match wildP
855 ( guardedB $
556 ( guardedB $
@@ -857,8 +558,7 @@ consFromJSON jc tName opts instTys cons = do
857 [|(==)|]
558 [|(==)|]
858 ([|T.pack|] `appE`
559 ([|T.pack|] `appE`
859 conNameExp opts con)
560 conNameExp opts con)
860− e <- checkExi tvMap con $
861− parseArgs jc tvMap tName opts con contents
561+ e <- parseArgs tName opts con contents
862 return (g, e)
562 return (g, e)
863 | con <- cons
563 | con <- cons
864 ]
564 ]
@@ -866,12 +566,12 @@ consFromJSON jc tName opts instTys cons = do
866 [ liftM2 (,)
566 [ liftM2 (,)
867 (normalG [e|otherwise|])
567 (normalG [e|otherwise|])
868 ( varE errorFun
568 ( varE errorFun
869− `appE` litE (stringL $ show tName)
569+ `appE` (litE $ stringL $ show tName)
870 `appE` listE (map ( litE
570 `appE` listE (map ( litE
871 . stringL
571 . stringL
872 . constructorTagModifier opts
572 . constructorTagModifier opts
873 . nameBase
573 . nameBase
874− . constructorName
574+ . getConName
875 ) cons
575 ) cons
876 )
576 )
877 `appE` ([|T.unpack|] `appE` varE conKey)
577 `appE` ([|T.unpack|] `appE` varE conKey)
@@ -885,13 +585,13 @@ parseNullaryMatches :: Name -> Name -> [Q Match]
885parseNullaryMatches tName conName =
585parseNullaryMatches tName conName =
886 [ do arr <- newName "arr"
586 [ do arr <- newName "arr"
887 match (conP 'Array [varP arr])
587 match (conP 'Array [varP arr])
888− (guardedB
588+ (guardedB $
889 [ liftM2 (,) (normalG $ [|V.null|] `appE` varE arr)
589 [ liftM2 (,) (normalG $ [|V.null|] `appE` varE arr)
890 ([|pure|] `appE` conE conName)
590 ([|pure|] `appE` conE conName)
891 , liftM2 (,) (normalG [|otherwise|])
591 , liftM2 (,) (normalG [|otherwise|])
892 (parseTypeMismatch tName conName
592 (parseTypeMismatch tName conName
893 (litE $ stringL "an empty Array")
593 (litE $ stringL "an empty Array")
894− (infixApp (litE $ stringL "Array of length ")
594+ (infixApp (litE $ stringL $ "Array of length ")
895 [|(++)|]
595 [|(++)|]
896 ([|show . V.length|] `appE` varE arr)
596 ([|show . V.length|] `appE` varE arr)
897 )
597 )
@@ -902,60 +602,30 @@ parseNullaryMatches tName conName =
902 , matchFailed tName conName "Array"
602 , matchFailed tName conName "Array"
903 ]
603 ]
904
604
905−parseUnaryMatches :: JSONClass -> TyVarMap -> Type -> Name -> [Q Match]
605+parseUnaryMatches :: Name -> [Q Match]
906−parseUnaryMatches jc tvMap argTy conName =
606+parseUnaryMatches conName =
907 [ do arg <- newName "arg"
607 [ do arg <- newName "arg"
908 match (varP arg)
608 match (varP arg)
909 ( normalB $ infixApp (conE conName)
609 ( normalB $ infixApp (conE conName)
910 [|(<$>)|]
610 [|(<$>)|]
911− (dispatchParseJSON jc conName tvMap argTy
912− `appE` varE arg)
611+ ([|parseJSON|] `appE` varE arg)
913 )
612 )
914 []
613 []
915 ]
614 ]
916
615
917−parseRecord :: JSONClass
616+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 =
617+parseRecord opts tName conName ts obj =
928− (if rejectUnknownFields opts
929− then infixApp checkUnknownRecords [|(>>)|]
930− else id) $
931 foldl' (\a b -> infixApp a [|(<*>)|] b)
618 foldl' (\a b -> infixApp a [|(<*>)|] b)
932 (infixApp (conE conName) [|(<$>)|] x)
619 (infixApp (conE conName) [|(<$>)|] x)
933 xs
620 xs
934 where
621 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|]
622 x:xs = [ [|lookupField|]
952− `appE` dispatchParseJSON jc conName tvMap argTy
953− `appE` litE (stringL $ show tName)
623+ `appE` (litE $ stringL $ show tName)
954− `appE` litE (stringL $ constructorTagModifier opts $ nameBase conName)
624+ `appE` (litE $ stringL $ constructorTagModifier opts $ nameBase conName)
955− `appE` varE obj
625+ `appE` (varE obj)
956− `appE` ( [|T.pack|] `appE` stringE (fieldLabel opts field)
626+ `appE` ( [|T.pack|] `appE` fieldLabelExp opts field
957 )
627 )
958− | (field, argTy) <- zip fields argTys
628+ | (field, _, _) <- ts
959 ]
629 ]
960
630
961getValField :: Name -> String -> [MatchQ] -> Q Exp
631getValField :: Name -> String -> [MatchQ] -> Q Exp
@@ -964,112 +634,74 @@ getValField obj valFieldName matches = do
964 doE [ bindS (varP val) $ infixApp (varE obj)
634 doE [ bindS (varP val) $ infixApp (varE obj)
965 [|(.:)|]
635 [|(.:)|]
966 ([|T.pack|] `appE`
636 ([|T.pack|] `appE`
967− litE (stringL valFieldName))
637+ (litE $ stringL valFieldName))
968 , noBindS $ caseE (varE val) matches
638 , noBindS $ caseE (varE val) matches
969 ]
639 ]
970
640
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.
641-- | 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.
642+parseArgs :: Name -- ^ Name of the type to which the constructor belongs.
980 -> Options -- ^ Encoding options.
643 -> Options -- ^ Encoding options.
981− -> ConstructorInfo -- ^ Constructor for which to generate JSON parsing code.
644+ -> Con -- ^ Constructor for which to generate JSON parsing code.
982 -> Either (String, Name) Name -- ^ Left (valFieldName, objName) or
645 -> Either (String, Name) Name -- ^ Left (valFieldName, objName) or
983 -- Right valName
646 -- Right valName
984 -> Q Exp
647 -> Q Exp
985-- Nullary constructors.
648-- Nullary constructors.
986−parseArgs _ _ _ _
649+parseArgs tName _ (NormalC conName []) (Left (valFieldName, obj)) =
987− ConstructorInfo { constructorName = conName
650+ 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) =
651+parseArgs tName _ (NormalC conName []) (Right valName) =
997− caseE (varE valName) $ parseNullaryMatches tName conName
652+ caseE (varE valName) $ parseNullaryMatches tName conName
998
653
999-- Unary constructors.
654-- Unary constructors.
1000−parseArgs jc tvMap _ _
655+parseArgs _ _ (NormalC conName [_]) (Left (valFieldName, obj)) =
1001− ConstructorInfo { constructorName = conName
656+ getValField obj valFieldName $ parseUnaryMatches conName
1002− , constructorVariant = NormalConstructor
657+parseArgs _ _ (NormalC conName [_]) (Right valName) =
1003− , constructorFields = [argTy] }
1004− contents = do
1005− argTy' <- resolveTypeSynonyms argTy
1006− matchCases contents $ parseUnaryMatches jc tvMap argTy' conName
658+ caseE (varE valName) $ parseUnaryMatches conName
1007
659
1008-- Polyadic constructors.
660-- Polyadic constructors.
1009−parseArgs jc tvMap tName _
661+parseArgs tName _ (NormalC conName ts) (Left (valFieldName, obj)) =
1010− ConstructorInfo { constructorName = conName
662+ getValField obj valFieldName $ parseProduct tName conName $ genericLength ts
1011− , constructorVariant = NormalConstructor
663+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
664+ caseE (varE valName) $ parseProduct tName conName $ genericLength ts
1017
665
1018-- Records.
666-- Records.
1019−parseArgs jc tvMap tName opts
667+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
668+ parseRecord opts tName conName ts obj
1026−parseArgs jc tvMap tName opts
1027− info@ConstructorInfo { constructorName = conName
1028− , constructorVariant = RecordConstructor fields
1029− , constructorFields = argTys }
1030− (Right valName) =
1031− case (unwrapUnaryRecords opts,argTys) of
669+parseArgs tName opts (RecC conName ts) (Right valName) = case (unwrapUnaryRecords opts,ts) of
1032− (True,[_])-> parseArgs jc tvMap tName opts
670+ (True,[(_,st,ty)])-> parseArgs tName opts (NormalC conName [(st,ty)]) (Right valName)
1033− (info{constructorVariant = NormalConstructor})
1034− (Right valName)
1035− _ -> do
671+ _ -> do
1036− obj <- newName "recObj"
672+ obj <- newName "recObj"
1037− argTys' <- mapM resolveTypeSynonyms argTys
1038− caseE (varE valName)
673+ caseE (varE valName)
1039− [ match (conP 'Object [varP obj]) (normalB $
674+ [ 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"
675+ , matchFailed tName conName "Object"
1042− ]
676+ ]
1043
677
1044-- Infix constructors. Apart from syntax these are the same as
678-- Infix constructors. Apart from syntax these are the same as
1045-- polyadic constructors.
679-- polyadic constructors.
1046−parseArgs jc tvMap tName _
680+parseArgs tName _ (InfixC _ conName _) (Left (valFieldName, obj)) =
1047− ConstructorInfo { constructorName = conName
681+ getValField obj valFieldName $ parseProduct tName conName 2
1048− , constructorVariant = InfixConstructor
682+parseArgs tName _ (InfixC _ conName _) (Right valName) =
1049− , constructorFields = argTys }
683+ caseE (varE valName) $ parseProduct tName conName 2
1050− contents = do
684+
1051− argTys' <- mapM resolveTypeSynonyms argTys
685+-- Existentially quantified constructors. We ignore the quantifiers
1052− matchCases contents $ parseProduct jc tvMap argTys' tName conName 2
686+-- and proceed with the contained constructor.
687+parseArgs tName opts (ForallC _ _ con) contents =
688+ parseArgs tName opts con contents
1053
689
1054-- | Generates code to parse the JSON encoding of an n-ary
690-- | Generates code to parse the JSON encoding of an n-ary
1055-- constructor.
691-- 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.
692+parseProduct :: Name -- ^ Name of the type to which the constructor belongs.
1061 -> Name -- ^ 'Con'structor name.
693 -> Name -- ^ 'Con'structor name.
1062 -> Integer -- ^ 'Con'structor arity.
694 -> Integer -- ^ 'Con'structor arity.
1063 -> [Q Match]
695 -> [Q Match]
1064−parseProduct jc tvMap argTys tName conName numArgs =
696+parseProduct tName conName numArgs =
1065 [ do arr <- newName "arr"
697 [ do arr <- newName "arr"
1066 -- List of: "parseJSON (arr `V.unsafeIndex` <IX>)"
698 -- List of: "parseJSON (arr `V.unsafeIndex` <IX>)"
1067− let x:xs = [ dispatchParseJSON jc conName tvMap argTy
699+ let x:xs = [ [|parseJSON|]
1068 `appE`
700 `appE`
1069 infixApp (varE arr)
701 infixApp (varE arr)
1070 [|V.unsafeIndex|]
702 [|V.unsafeIndex|]
1071 (litE $ integerL ix)
703 (litE $ integerL ix)
1072− | (argTy, ix) <- zip argTys [0 .. numArgs - 1]
704+ | ix <- [0 .. numArgs - 1]
1073 ]
705 ]
1074 match (conP 'Array [varP arr])
706 match (conP 'Array [varP arr])
1075 (normalB $ condE ( infixApp ([|V.length|] `appE` varE arr)
707 (normalB $ condE ( infixApp ([|V.length|] `appE` varE arr)
@@ -1082,7 +714,7 @@ parseProduct jc tvMap argTys tName conName numArgs =
1082 )
714 )
1083 ( parseTypeMismatch tName conName
715 ( parseTypeMismatch tName conName
1084 (litE $ stringL $ "Array of length " ++ show numArgs)
716 (litE $ stringL $ "Array of length " ++ show numArgs)
1085− ( infixApp (litE $ stringL "Array of length ")
717+ ( infixApp (litE $ stringL $ "Array of length ")
1086 [|(++)|]
718 [|(++)|]
1087 ([|show . V.length|] `appE` varE arr)
719 ([|show . V.length|] `appE` varE arr)
1088 )
720 )
@@ -1092,6 +724,7 @@ parseProduct jc tvMap argTys tName conName numArgs =
1092 , matchFailed tName conName "Array"
724 , matchFailed tName conName "Array"
1093 ]
725 ]
1094
726
727+
1095--------------------------------------------------------------------------------
728--------------------------------------------------------------------------------
1096-- Parsing errors
729-- Parsing errors
1097--------------------------------------------------------------------------------
730--------------------------------------------------------------------------------
@@ -1116,27 +749,17 @@ parseTypeMismatch tName conName expected actual =
1116 , actual
749 , actual
1117 ]
750 ]
1118
751
1119−class LookupField a where
752+class (FromJSON a) => LookupField a where
1120− lookupField :: (Value -> Parser a) -> String -> String
1121− -> Object -> T.Text -> Parser a
753+ lookupField :: String -> String -> Object -> T.Text -> Parser a
1122
754
1123−instance OVERLAPPABLE_ LookupField a where
755+instance (FromJSON a) => LookupField a where
1124− lookupField = lookupFieldWith
756+ lookupField tName rec obj key =
757+ case H.lookup key obj of
758+ Nothing -> unknownFieldFail tName rec (T.unpack key)
759+ Just v -> parseJSON v
1125
760
1126−instance INCOHERENT_ LookupField (Maybe a) where
761+instance (FromJSON a) => LookupField (Maybe a) where
1127− lookupField pj _ _ = parseOptionalFieldWith pj
762+ 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
763
1141unknownFieldFail :: String -> String -> String -> Parser fail
764unknownFieldFail :: String -> String -> String -> Parser fail
1142unknownFieldFail tName rec key =
765unknownFieldFail tName rec key =
@@ -1183,596 +806,63 @@ conNotFoundFailTaggedObject t cs o =
1183 t (intercalate ", " cs) o
806 t (intercalate ", " cs) o
1184
807
1185parseTypeMismatch' :: String -> String -> String -> String -> Parser fail
808parseTypeMismatch' :: String -> String -> String -> String -> Parser fail
1186−parseTypeMismatch' conName tName expected actual =
809+parseTypeMismatch' tName conName expected actual =
1187 fail $ printf "When parsing the constructor %s of type %s expected %s but got %s."
810 fail $ printf "When parsing the constructor %s of type %s expected %s but got %s."
1188 conName tName expected actual
811 conName tName expected actual
1189
812
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
813
1327--------------------------------------------------------------------------------
814--------------------------------------------------------------------------------
1328-- Utility functions
815-- Utility functions
1329--------------------------------------------------------------------------------
816--------------------------------------------------------------------------------
1330
817
1331−-- For the given Types, generate an instance context and head.
818+-- | 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--
819--
1595−-- { a ~> (tj1, tjl1)
820+-- The given 'Name' must be from a type constructor. Furthermore, the
1596−-- , b ~> (tj2, tjl2) }
821+-- type constructor must be either a data type or a newtype. Any other
1597−--
822+-- value will result in an exception.
1598−-- where a and b are the last two type variables of the datatype, tj1 and tjl1 are
823+withType :: Name
1599−-- the function arguments of types (a -> Value) and ([a] -> Value), and tj2 and tjl2
824+ -> ([TyVarBndr] -> [Con] -> Q a)
1600−-- are the function arguments of types (b -> Value) and ([b] -> Value).
825+ -- ^ Function that generates the actual code. Will be applied
1601−type TyVarMap = Map Name (Name, Name)
826+ -- to the type variable binders and constructors extracted
1602−
827+ -- from the given 'Name'.
1603−-- | Returns True if a Type has kind *.
828+ -> Q a
1604−hasKindStar :: Type -> Bool
829+ -- ^ Resulting value in the 'Q'uasi monad.
1605−hasKindStar VarT{} = True
830+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
831+ info <- reify name
1664− return $ case info of
832+ case info of
1665−#if MIN_VERSION_template_haskell(2,11,0)
833+ TyConI dec ->
1666− FamilyI OpenTypeFamilyD{} _ -> True
834+ case dec of
1667−#else
835+ DataD _ _ tvbs cons _ -> f tvbs cons
1668− FamilyI (FamilyD TypeFam _ _ _) _ -> True
836+ NewtypeD _ _ tvbs con _ -> f tvbs [con]
1669−#endif
837+ other -> error $ "Data.Aeson.TH.withType: Unsupported type: "
1670− FamilyI ClosedTypeFamilyD{} _ -> True
838+ ++ show other
1671− _ -> False
839+ _ -> error "Data.Aeson.TH.withType: I need the name of a type."
1672−isTyFamily _ = return False
840+
1673−
841+-- | Extracts the name from a constructor.
1674−-- | Peel off a kind signature from a Type (if it has one).
842+getConName :: Con -> Name
1675−unSigT :: Type -> Type
843+getConName (NormalC name _) = name
1676−unSigT (SigT t _) = t
844+getConName (RecC name _) = name
1677−unSigT t = t
845+getConName (InfixC _ name _) = name
1678−
846+getConName (ForallC _ _ con) = getConName con
1679−-- | Are all of the items in a list (which have an ordering) distinct?
847+
1680−--
848+-- | Extracts the name from a type variable binder.
1681−-- This uses Set (as opposed to nub) for better asymptotic time complexity.
849+tvbName :: TyVarBndr -> Name
1682−allDistinct :: Ord a => [a] -> Bool
850+tvbName (PlainTV name ) = name
1683−allDistinct = allDistinct' Set.empty
851+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
852
1763-- | Makes a string literal expression from a constructor's name.
853-- | Makes a string literal expression from a constructor's name.
1764−conNameExp :: Options -> ConstructorInfo -> Q Exp
854+conNameExp :: Options -> Con -> Q Exp
1765conNameExp opts = litE
855conNameExp opts = litE
1766 . stringL
856 . stringL
1767 . constructorTagModifier opts
857 . constructorTagModifier opts
1768 . nameBase
858 . nameBase
1769− . constructorName
859+ . getConName
1770
860
1771−-- | Extracts a record field label.
861+-- | Creates a string literal expression from a record field label.
1772−fieldLabel :: Options -- ^ Encoding options
862+fieldLabelExp :: Options -- ^ Encoding options
1773− -> Name
863+ -> Name
1774− -> String
864+ -> Q Exp
1775−fieldLabel opts = fieldLabelModifier opts . nameBase
865+fieldLabelExp opts = litE . stringL . fieldLabelModifier opts . nameBase
1776
866
1777-- | The name of the outermost 'Value' constructor.
867-- | The name of the outermost 'Value' constructor.
1778valueConName :: Value -> String
868valueConName :: Value -> String
@@ -1783,209 +873,11 @@ valueConName (Number _) = "Number"
1783valueConName (Bool _) = "Boolean"
873valueConName (Bool _) = "Boolean"
1784valueConName Null = "Null"
874valueConName Null = "Null"
1785
875
1786−applyCon :: Name -> Name -> Pred
876+applyCon :: Name -> [Name] -> Q [Pred]
1787−applyCon con t =
877+applyCon con typeNames = return (map apply typeNames)
878+ where apply t =
1788#if MIN_VERSION_template_haskell(2,10,0)
879#if MIN_VERSION_template_haskell(2,10,0)
1789 AppT (ConT con) (VarT t)
880 AppT (ConT con) (VarT t)
1790#else
881#else
1791 ClassP con [VarT t]
882 ClassP con [VarT t]
1792#endif
883#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+10−100
@@ -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-2015 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,7 +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
17 , fromEncoding
20 , Series
18 , Series
21 , Array
19 , Array
@@ -26,7 +24,6 @@ module Data.Aeson.Types
26 -- * Convenience types and functions
24 -- * Convenience types and functions
27 , DotNetTime(..)
25 , DotNetTime(..)
28 , typeMismatch
26 , typeMismatch
29− , unexpected
30 -- * Type conversion
27 -- * Type conversion
31 , Parser
28 , Parser
32 , Result(..)
29 , Result(..)
@@ -38,125 +35,38 @@ module Data.Aeson.Types
38 , ToJSON(..)
35 , ToJSON(..)
39 , KeyValue(..)
36 , KeyValue(..)
40 , modifyFailure
37 , modifyFailure
41− , prependFailure
38+ , JSONPath
42− , parserThrowError
39+ , formatError
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
40
74 -- ** Generic JSON classes
41 -- ** Generic JSON classes
75 , GFromJSON(..)
42 , GFromJSON(..)
76− , FromArgs(..)
77− , GToJSON
43+ , GToJSON(..)
78− , GToEncoding
79− , ToArgs(..)
80− , Zero
81− , One
82 , genericToJSON
44 , genericToJSON
83− , genericLiftToJSON
84− , genericToEncoding
85− , genericLiftToEncoding
86 , genericParseJSON
45 , genericParseJSON
87− , genericLiftParseJSON
88
46
89 -- * Inspecting @'Value's@
47 -- * Inspecting @'Value's@
90 , withObject
48 , withObject
91 , withText
49 , withText
92 , withArray
50 , withArray
51+ , withNumber
93 , withScientific
52 , withScientific
94 , withBool
53 , withBool
95− , withEmbeddedJSON
96
54
97− , pairs
55+ , series
98 , foldable
56 , foldable
99 , (.:)
57 , (.:)
100 , (.:?)
58 , (.:?)
101− , (.:!)
102 , (.!=)
59 , (.!=)
103 , object
60 , object
104− , parseField
105− , parseFieldMaybe
106− , parseFieldMaybe'
107− , explicitParseField
108− , explicitParseFieldMaybe
109− , explicitParseFieldMaybe'
110−
111− , listEncoding
112− , listValue
113− , listParser
114
61
115 -- * Generic and TH encoding configuration
62 -- * Generic and TH encoding configuration
116− , Options
63+ , 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(..)
64 , SumEncoding(..)
131 , camelTo
65 , camelTo
132− , camelTo2
133 , defaultOptions
66 , defaultOptions
134 , defaultTaggedObject
67 , 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
68 ) where
148
69
149−import Prelude.Compat
70+import Data.Aeson.Types.Generic ()
150−
151−import Data.Aeson.Encoding (Encoding, unsafeToEncoding, fromEncoding, Series, pairs)
152−import Data.Aeson.Types.Class
71+import Data.Aeson.Types.Instances
153import Data.Aeson.Types.Internal
72import 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+171−83
@@ -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
@@ -23,87 +16,182 @@ module Data.Aeson.Types.Class
23 -- * Core JSON classes
16 -- * Core JSON classes
24 FromJSON(..)
17 FromJSON(..)
25 , ToJSON(..)
18 , 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
19 -- * Generic JSON classes
38 , GFromJSON(..)
20 , GFromJSON(..)
39− , FromArgs(..)
40− , GToJSON
21+ , GToJSON(..)
41− , GToEncoding
42− , ToArgs(..)
43− , Zero
44− , One
45 , genericToJSON
22 , genericToJSON
46− , genericLiftToJSON
47 , genericToEncoding
23 , genericToEncoding
48− , genericLiftToEncoding
49 , genericParseJSON
24 , 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
25 -- * Object key-value pairs
67 , KeyValue(..)
26 , 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
27 ) where
99
28
29+import Data.Text (Text)
30+import Data.Aeson.Types.Internal
31+import GHC.Generics
32+
33+-- | Class of generic representation types ('Rep') that can be converted to JSON.
34+class GToJSON f where
35+ -- | This method (applied to 'defaultOptions') is used as the
36+ -- default generic implementation of 'toJSON'.
37+ gToJSON :: Options -> f a -> Value
38+
39+ -- | This method (applied to 'defaultOptions') is used as the
40+ -- default generic implementation of 'toEncoding'.
41+ gToEncoding :: Options -> f a -> Encoding
42+
43+-- | Class of generic representation types ('Rep') that can be converted from JSON.
44+class GFromJSON f where
45+ -- | This method (applied to 'defaultOptions') is used as the
46+ -- default generic implementation of 'parseJSON'.
47+ gParseJSON :: Options -> Value -> Parser (f a)
48+
49+-- | A configurable generic JSON creator. This function applied to
50+-- 'defaultOptions' is used as the default for 'toJSON' when the type
51+-- is an instance of 'Generic'.
52+genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value
53+genericToJSON opts = gToJSON opts . from
54+
55+-- | A configurable generic JSON encoder. This function applied to
56+-- 'defaultOptions' is used as the default for 'toEncoding' when the type
57+-- is an instance of 'Generic'.
58+genericToEncoding :: (Generic a, GToJSON (Rep a)) => Options -> a -> Encoding
59+genericToEncoding opts = gToEncoding opts . from
60+
61+-- | A configurable generic JSON decoder. This function applied to
62+-- 'defaultOptions' is used as the default for 'parseJSON' when the
63+-- type is an instance of 'Generic'.
64+genericParseJSON :: (Generic a, GFromJSON (Rep a)) => Options -> Value -> Parser a
65+genericParseJSON opts = fmap to . gParseJSON opts
66+
67+-- | A type that can be converted to JSON.
68+--
69+-- An example type and instance:
70+--
71+-- @{-\# LANGUAGE OverloadedStrings #-}
72+--
73+-- data Coord = Coord { x :: Double, y :: Double }
74+--
75+-- instance ToJSON Coord where
76+-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
77+-- @
78+--
79+-- Note the use of the @OverloadedStrings@ language extension which enables
80+-- 'Text' values to be written as string literals.
81+--
82+-- Instead of manually writing your 'ToJSON' instance, there are three options
83+-- to do it automatically:
84+--
85+-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
86+-- instance at compile time. The generated instance is optimized for your type
87+-- so will probably be more efficient than the following two options:
88+--
89+-- * The compiler can provide default generic implementations for 'toJSON' and
90+-- 'toEncoding'.
91+--
92+-- To use the second, simply add a @deriving 'Generic'@ clause to your
93+-- datatype and declare a 'ToJSON' instance for your datatype without giving
94+-- definitions for 'toJSON' or 'toEncoding'.
95+--
96+-- For example, the previous example can be simplified to just:
97+--
98+-- @{-\# LANGUAGE DeriveGeneric \#-}
99+--
100+-- import GHC.Generics
101+--
102+-- data Coord = Coord { x :: Double, y :: Double } deriving Generic
103+--
104+-- instance ToJSON Coord
105+-- @
106+--
107+-- Note that, instead of using @DefaultSignatures@, it's also possible
108+-- to parameterize the generic encoding using 'genericToJSON' applied
109+-- to your encoding/decoding 'Options':
110+--
111+-- @
112+-- instance ToJSON Coord where
113+-- toJSON = 'genericToJSON' 'defaultOptions'
114+-- toEncoding = 'genericToEncoding' 'defaultOptions'
115+-- @
116+class ToJSON a where
117+ toJSON :: a -> Value
118+
119+ default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value
120+ toJSON = genericToJSON defaultOptions
121+
122+ toEncoding :: a -> Encoding
123+
124+ default toEncoding :: (Generic a, GToJSON (Rep a)) => a -> Encoding
125+ toEncoding = genericToEncoding defaultOptions
126+
127+-- | A type that can be converted from JSON, with the possibility of
128+-- failure.
129+--
130+-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a
131+-- conversion fail, e.g. if an 'Object' is missing a required key, or
132+-- the value is of the wrong type.
133+--
134+-- An example type and instance:
135+--
136+-- @
137+-- {-\# LANGUAGE OverloadedStrings #-}
138+--
139+-- data Coord = Coord { x :: Double, y :: Double }
140+--
141+-- instance FromJSON Coord where
142+-- parseJSON ('Object' v) = Coord '<$>'
143+-- v '.:' \"x\" '<*>'
144+-- v '.:' \"y\"
145+--
146+-- \-- A non-'Object' value is of the wrong type, so use 'mzero' to fail.
147+-- parseJSON _ = 'mzero'
148+-- @
149+--
150+-- Note the use of the @OverloadedStrings@ language extension which enables
151+-- 'Text' values to be written as string literals.
152+--
153+-- Instead of manually writing your 'FromJSON' instance, there are two options
154+-- to do it automatically:
155+--
156+-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
157+-- instance at compile time. The generated instance is optimized for your type
158+-- so will probably be more efficient than the following two options:
159+--
160+-- * The compiler can provide a default generic implementation for
161+-- 'parseJSON'.
162+--
163+-- To use the second, simply add a @deriving 'Generic'@ clause to your
164+-- datatype and declare a 'FromJSON' instance for your datatype without giving
165+-- a definition for 'parseJSON'.
166+--
167+-- For example, the previous example can be simplified to just:
168+--
169+-- @
170+-- {-\# LANGUAGE DeriveGeneric \#-}
171+--
172+-- import GHC.Generics
173+--
174+-- data Coord = Coord { x :: Double, y :: Double } deriving Generic
175+--
176+-- instance FromJSON Coord
177+-- @
178+--
179+-- Note that, instead of using @DefaultSignatures@, it's also possible
180+-- to parameterize the generic decoding using 'genericParseJSON' applied
181+-- to your encoding/decoding 'Options':
182+--
183+-- @
184+-- instance FromJSON Coord where
185+-- parseJSON = 'genericParseJSON' 'defaultOptions'
186+-- @
187+
188+class FromJSON a where
189+ parseJSON :: Value -> Parser a
100
190
101−import Data.Aeson.Types.FromJSON
191+ default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
102−import Data.Aeson.Types.Generic (One, Zero)
192+ parseJSON = genericParseJSON defaultOptions
103−import Data.Aeson.Types.ToJSON hiding (GToJSON)
104−import qualified Data.Aeson.Types.ToJSON as ToJSON
105−import Data.Aeson.Types.Internal (Value)
106−import Data.Aeson.Encoding (Encoding)
107
193
108−type GToJSON = ToJSON.GToJSON Value
194+-- | A key-value pair for a JSON object.
109−type GToEncoding = ToJSON.GToJSON Encoding
195+class KeyValue t where
196+ (.=) :: ToJSON v => Text -> v -> t
197+ infixr 8 .=
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+715−66
@@ -1,63 +1,733 @@
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-2015 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 = Encoding . 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 = Encoding $
91+ B.char7 '[' <> encodeProduct opts p <> B.char7 ']'
92+
93+instance ( AllNullary (a :+: b) allNullary
94+ , SumToJSON (a :+: b) allNullary ) => GToJSON (a :+: b) where
95+ -- If all constructors of a sum datatype are nullary and the
96+ -- 'allNullaryToStringTag' option is set they are encoded to
97+ -- strings. This distinction is made by 'sumToJSON':
98+ gToJSON opts = (unTagged :: Tagged allNullary Value -> Value)
99+ . sumToJSON opts
100+ {-# INLINE gToJSON #-}
101+
102+ gToEncoding opts = Encoding .
103+ (unTagged :: Tagged allNullary B.Builder -> B.Builder) .
104+ sumToEncoding opts
105+ {-# INLINE gToEncoding #-}
106+
107+--------------------------------------------------------------------------------
108+
109+class SumToJSON f allNullary where
110+ sumToJSON :: Options -> f a -> Tagged allNullary Value
111+ sumToEncoding :: Options -> f a -> Tagged allNullary B.Builder
112+
113+instance ( GetConName f
114+ , TaggedObject f
115+ , ObjectWithSingleField f
116+ , TwoElemArray f ) => SumToJSON f True where
117+ sumToJSON opts
118+ | allNullaryToStringTag opts = Tagged . String . pack
119+ . constructorTagModifier opts . getConName
120+ | otherwise = Tagged . nonAllNullarySumToJSON opts
121+ {-# INLINE sumToJSON #-}
122+
123+ sumToEncoding opts
124+ | allNullaryToStringTag opts = Tagged . builder .
125+ constructorTagModifier opts . getConName
126+ | otherwise = Tagged . nonAllNullarySumToEncoding opts
127+ {-# INLINE sumToEncoding #-}
128+
129+instance ( TwoElemArray f
130+ , TaggedObject f
131+ , ObjectWithSingleField f ) => SumToJSON f False where
132+ sumToJSON opts = Tagged . nonAllNullarySumToJSON opts
133+ {-# INLINE sumToJSON #-}
134+ sumToEncoding opts = Tagged . nonAllNullarySumToEncoding opts
135+ {-# INLINE sumToEncoding #-}
136+
137+nonAllNullarySumToJSON :: ( TwoElemArray f
138+ , TaggedObject f
139+ , ObjectWithSingleField f
140+ ) => Options -> f a -> Value
141+nonAllNullarySumToJSON opts =
142+ case sumEncoding opts of
143+ TaggedObject{..} ->
144+ object . taggedObjectPairs opts tagFieldName contentsFieldName
145+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts
146+ TwoElemArray -> Array . twoElemArrayObj opts
147+{-# INLINE nonAllNullarySumToJSON #-}
148+
149+nonAllNullarySumToEncoding :: ( TwoElemArray f
150+ , TaggedObject f
151+ , ObjectWithSingleField f
152+ ) => Options -> f a -> B.Builder
153+nonAllNullarySumToEncoding opts =
154+ case sumEncoding opts of
155+ TaggedObject{..} ->
156+ taggedObjectEnc opts tagFieldName contentsFieldName
157+ ObjectWithSingleField -> objectWithSingleFieldEnc opts
158+ TwoElemArray -> twoElemArrayEnc opts
159+{-# INLINE nonAllNullarySumToEncoding #-}
160+
161+--------------------------------------------------------------------------------
162+
163+class TaggedObject f where
164+ taggedObjectPairs :: Options -> String -> String -> f a -> [Pair]
165+ taggedObjectEnc :: Options -> String -> String -> f a -> B.Builder
166+
167+instance ( TaggedObject a
168+ , TaggedObject b ) => TaggedObject (a :+: b) where
169+ taggedObjectPairs opts tagFieldName contentsFieldName (L1 x) =
170+ taggedObjectPairs opts tagFieldName contentsFieldName x
171+ taggedObjectPairs opts tagFieldName contentsFieldName (R1 x) =
172+ taggedObjectPairs opts tagFieldName contentsFieldName x
173+ {-# INLINE taggedObjectPairs #-}
174+
175+ taggedObjectEnc opts tagFieldName contentsFieldName (L1 x) =
176+ taggedObjectEnc opts tagFieldName contentsFieldName x
177+ taggedObjectEnc opts tagFieldName contentsFieldName (R1 x) =
178+ taggedObjectEnc opts tagFieldName contentsFieldName x
179+ {-# INLINE taggedObjectEnc #-}
180+
181+instance ( IsRecord a isRecord
182+ , TaggedObject' a isRecord
183+ , Constructor c ) => TaggedObject (C1 c a) where
184+ taggedObjectPairs opts tagFieldName contentsFieldName =
185+ (pack tagFieldName .= constructorTagModifier opts
186+ (conName (undefined :: t c a p)) :) .
187+ (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
188+ taggedObjectPairs' opts contentsFieldName . unM1
189+ {-# INLINE taggedObjectPairs #-}
190+
191+ taggedObjectEnc opts tagFieldName contentsFieldName v =
192+ B.char7 '{' <>
193+ (builder tagFieldName <>
194+ B.char7 ':' <>
195+ builder (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
196+ B.char7 ',' <>
197+ ((unTagged :: Tagged isRecord B.Builder -> B.Builder) .
198+ taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>
199+ B.char7 '}'
200+ {-# INLINE taggedObjectEnc #-}
201+
202+class TaggedObject' f isRecord where
203+ taggedObjectPairs' :: Options -> String -> f a -> Tagged isRecord [Pair]
204+ taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord B.Builder
205+
206+instance (RecordTo f) => TaggedObject' f True where
207+ taggedObjectPairs' opts _ = Tagged . toList . recordToPairs opts
208+ {-# INLINE taggedObjectPairs' #-}
209+
210+ taggedObjectEnc' opts _ = Tagged . recordToEncoding opts
211+ {-# INLINE taggedObjectEnc' #-}
212+
213+instance (GToJSON f) => TaggedObject' f False where
214+ taggedObjectPairs' opts contentsFieldName =
215+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts
216+ {-# INLINE taggedObjectPairs' #-}
217+
218+ taggedObjectEnc' opts contentsFieldName =
219+ Tagged . (\z -> builder contentsFieldName <> B.char7 ':' <> z) .
220+ gbuilder opts
221+ {-# INLINE taggedObjectEnc' #-}
222+
223+--------------------------------------------------------------------------------
224+
225+-- | Get the name of the constructor of a sum datatype.
226+class GetConName f where
227+ getConName :: f a -> String
228+
229+instance (GetConName a, GetConName b) => GetConName (a :+: b) where
230+ getConName (L1 x) = getConName x
231+ getConName (R1 x) = getConName x
232+ {-# INLINE getConName #-}
233+
234+instance (Constructor c, GToJSON a, ConsToJSON a) => GetConName (C1 c a) where
235+ getConName = conName
236+ {-# INLINE getConName #-}
237+
238+--------------------------------------------------------------------------------
239+
240+class TwoElemArray f where
241+ twoElemArrayObj :: Options -> f a -> V.Vector Value
242+ twoElemArrayEnc :: Options -> f a -> B.Builder
243+
244+instance (TwoElemArray a, TwoElemArray b) => TwoElemArray (a :+: b) where
245+ twoElemArrayObj opts (L1 x) = twoElemArrayObj opts x
246+ twoElemArrayObj opts (R1 x) = twoElemArrayObj opts x
247+ {-# INLINE twoElemArrayObj #-}
248+
249+ twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
250+ twoElemArrayEnc opts (R1 x) = twoElemArrayEnc opts x
251+ {-# INLINE twoElemArrayEnc #-}
252+
253+instance ( GToJSON a, ConsToJSON a
254+ , Constructor c ) => TwoElemArray (C1 c a) where
255+ twoElemArrayObj opts x = V.create $ do
256+ mv <- VM.unsafeNew 2
257+ VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
258+ $ conName (undefined :: t c a p)
259+ VM.unsafeWrite mv 1 $ gToJSON opts x
260+ return mv
261+ {-# INLINE twoElemArrayObj #-}
262+
263+ twoElemArrayEnc opts x = fromEncoding . tuple $
264+ builder (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
265+ gbuilder opts x
266+ {-# INLINE twoElemArrayEnc #-}
267+
268+--------------------------------------------------------------------------------
269+
270+class ConsToJSON f where
271+ consToJSON :: Options -> f a -> Value
272+ consToEncoding :: Options -> f a -> B.Builder
273+
274+class ConsToJSON' f isRecord where
275+ consToJSON' :: Options -> Bool -- ^ Are we a record with one field
276+ -> f a -> Tagged isRecord Value
277+ consToEncoding' :: Options -> Bool -- ^ Are we a record with one field
278+ -> f a -> Tagged isRecord B.Builder
279+
280+instance ( IsRecord f isRecord
281+ , ConsToJSON' f isRecord ) => ConsToJSON f where
282+ consToJSON opts = (unTagged :: Tagged isRecord Value -> Value)
283+ . consToJSON' opts (isUnary (undefined :: f a))
284+ {-# INLINE consToJSON #-}
285+
286+ consToEncoding opts = (unTagged :: Tagged isRecord B.Builder -> B.Builder)
287+ . consToEncoding' opts (isUnary (undefined :: f a))
288+ {-# INLINE consToEncoding #-}
289+
290+instance (RecordTo f) => ConsToJSON' f True where
291+ consToJSON' opts isUn f = let
292+ vals = toList $ recordToPairs opts f
293+ in case (unwrapUnaryRecords opts,isUn,vals) of
294+ (True,True,[(_,val)]) -> Tagged val
295+ _ -> Tagged $ object vals
296+ {-# INLINE consToJSON' #-}
297+
298+ consToEncoding' opts isUn x
299+ | (True,True) <- (unwrapUnaryRecords opts,isUn) = Tagged $ recordToEncoding opts x
300+ | otherwise = Tagged $
301+ B.char7 '{' <>
302+ recordToEncoding opts x <>
303+ B.char7 '}'
304+ {-# INLINE consToEncoding' #-}
305+
306+instance GToJSON f => ConsToJSON' f False where
307+ consToJSON' opts _ = Tagged . gToJSON opts
308+ {-# INLINE consToJSON' #-}
309+ consToEncoding' opts _ = Tagged . gbuilder opts
310+ {-# INLINE consToEncoding' #-}
311+
312+--------------------------------------------------------------------------------
313+
314+class RecordTo f where
315+ recordToPairs :: Options -> f a -> DList Pair
316+ recordToEncoding :: Options -> f a -> B.Builder
317+
318+instance (RecordTo a, RecordTo b) => RecordTo (a :*: b) where
319+ recordToPairs opts (a :*: b) = recordToPairs opts a <>
320+ recordToPairs opts b
321+ {-# INLINE recordToPairs #-}
322+
323+ recordToEncoding opts (a :*: b) = recordToEncoding opts a <>
324+ B.char7 ',' <>
325+ recordToEncoding opts b
326+ {-# INLINE recordToEncoding #-}
327+
328+instance (Selector s, GToJSON a) => RecordTo (S1 s a) where
329+ recordToPairs = fieldToPair
330+ {-# INLINE recordToPairs #-}
331+
332+ recordToEncoding = fieldToEncoding
333+ {-# INLINE recordToEncoding #-}
334+
335+instance (Selector s, ToJSON a) => RecordTo (S1 s (K1 i (Maybe a))) where
336+ recordToPairs opts (M1 k1) | omitNothingFields opts
337+ , K1 Nothing <- k1 = empty
338+ recordToPairs opts m1 = fieldToPair opts m1
339+ {-# INLINE recordToPairs #-}
340+
341+ recordToEncoding opts (M1 k1) | omitNothingFields opts
342+ , K1 Nothing <- k1 = mempty
343+ recordToEncoding opts m1 = fieldToEncoding opts m1
344+ {-# INLINE recordToEncoding #-}
345+
346+fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair
347+fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
348+ , gToJSON opts (unM1 m1)
349+ )
350+{-# INLINE fieldToPair #-}
351+
352+fieldToEncoding :: (Selector s, GToJSON a) => Options -> S1 s a p -> B.Builder
353+fieldToEncoding opts m1 =
354+ builder (fieldLabelModifier opts $ selName m1) <>
355+ B.char7 ':' <>
356+ gbuilder opts (unM1 m1)
357+{-# INLINE fieldToEncoding #-}
358+
359+--------------------------------------------------------------------------------
360+
361+class WriteProduct f where
362+ writeProduct :: Options
363+ -> VM.MVector s Value
364+ -> Int -- ^ index
365+ -> Int -- ^ length
366+ -> f a
367+ -> ST s ()
368+ encodeProduct :: Options -> f a -> B.Builder
369+
370+instance ( WriteProduct a
371+ , WriteProduct b ) => WriteProduct (a :*: b) where
372+ writeProduct opts mv ix len (a :*: b) = do
373+ writeProduct opts mv ix lenL a
374+ writeProduct opts mv ixR lenR b
375+ where
376+ lenL = len `unsafeShiftR` 1
377+ lenR = len - lenL
378+ ixR = ix + lenL
379+ {-# INLINE writeProduct #-}
380+
381+ encodeProduct opts (a :*: b) = encodeProduct opts a <>
382+ B.char7 ',' <>
383+ encodeProduct opts b
384+ {-# INLINE encodeProduct #-}
385+
386+instance (GToJSON a) => WriteProduct a where
387+ writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts
388+ {-# INLINE writeProduct #-}
389+
390+ encodeProduct opts = gbuilder opts
391+ {-# INLINE encodeProduct #-}
392+
393+--------------------------------------------------------------------------------
394+
395+class ObjectWithSingleField f where
396+ objectWithSingleFieldObj :: Options -> f a -> Object
397+ objectWithSingleFieldEnc :: Options -> f a -> B.Builder
398+
399+instance ( ObjectWithSingleField a
400+ , ObjectWithSingleField b ) => ObjectWithSingleField (a :+: b) where
401+ objectWithSingleFieldObj opts (L1 x) = objectWithSingleFieldObj opts x
402+ objectWithSingleFieldObj opts (R1 x) = objectWithSingleFieldObj opts x
403+ {-# INLINE objectWithSingleFieldObj #-}
404+
405+ objectWithSingleFieldEnc opts (L1 x) = objectWithSingleFieldEnc opts x
406+ objectWithSingleFieldEnc opts (R1 x) = objectWithSingleFieldEnc opts x
407+ {-# INLINE objectWithSingleFieldEnc #-}
408+
409+instance ( GToJSON a, ConsToJSON a
410+ , Constructor c ) => ObjectWithSingleField (C1 c a) where
411+ objectWithSingleFieldObj opts = H.singleton typ . gToJSON opts
412+ where
413+ typ = pack $ constructorTagModifier opts $
414+ conName (undefined :: t c a p)
415+ {-# INLINE objectWithSingleFieldObj #-}
416+
417+ objectWithSingleFieldEnc opts v =
418+ B.char7 '{' <>
419+ builder (constructorTagModifier opts
420+ (conName (undefined :: t c a p))) <>
421+ B.char7 ':' <>
422+ gbuilder opts v <>
423+ B.char7 '}'
424+ {-# INLINE objectWithSingleFieldEnc #-}
425+
426+gbuilder :: GToJSON f => Options -> f a -> Builder
427+gbuilder opts = fromEncoding . gToEncoding opts
428+
429+--------------------------------------------------------------------------------
430+-- Generic parseJSON
431+
432+instance (GFromJSON a) => GFromJSON (M1 i c a) where
433+ -- Meta-information, which is not handled elsewhere, is just added to the
434+ -- parsed value:
435+ gParseJSON opts = fmap M1 . gParseJSON opts
436+ {-# INLINE gParseJSON #-}
437+
438+instance (FromJSON a) => GFromJSON (K1 i a) where
439+ -- Constant values are decoded using their FromJSON instance:
440+ gParseJSON _opts = fmap K1 . parseJSON
441+ {-# INLINE gParseJSON #-}
442+
443+instance GFromJSON U1 where
444+ -- Empty constructors are expected to be encoded as an empty array:
445+ gParseJSON _opts v
446+ | isEmptyArray v = pure U1
447+ | otherwise = typeMismatch "unit constructor (U1)" v
448+ {-# INLINE gParseJSON #-}
449+
450+instance (ConsFromJSON a) => GFromJSON (C1 c a) where
451+ -- Constructors need to be decoded differently depending on whether they're
452+ -- a record or not. This distinction is made by consParseJSON:
453+ gParseJSON opts = fmap M1 . consParseJSON opts
454+ {-# INLINE gParseJSON #-}
455+
456+instance ( FromProduct a, FromProduct b
457+ , ProductSize a, ProductSize b ) => GFromJSON (a :*: b) where
458+ -- Products are expected to be encoded to an array. Here we check whether we
459+ -- got an array of the same size as the product, then parse each of the
460+ -- product's elements using parseProduct:
461+ gParseJSON opts = withArray "product (:*:)" $ \arr ->
462+ let lenArray = V.length arr
463+ lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
464+ productSize in
465+ if lenArray == lenProduct
466+ then parseProduct opts arr 0 lenProduct
467+ else fail $ "When expecting a product of " ++ show lenProduct ++
468+ " values, encountered an Array of " ++ show lenArray ++
469+ " elements instead"
470+ {-# INLINE gParseJSON #-}
471+
472+instance ( AllNullary (a :+: b) allNullary
473+ , ParseSum (a :+: b) allNullary ) => GFromJSON (a :+: b) where
474+ -- If all constructors of a sum datatype are nullary and the
475+ -- 'allNullaryToStringTag' option is set they are expected to be
476+ -- encoded as strings. This distinction is made by 'parseSum':
477+ gParseJSON opts = (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->
478+ (Parser ((a :+: b) d)))
479+ . parseSum opts
480+ {-# INLINE gParseJSON #-}
481+
482+--------------------------------------------------------------------------------
483+
484+class ParseSum f allNullary where
485+ parseSum :: Options -> Value -> Tagged allNullary (Parser (f a))
486+
487+instance ( SumFromString (a :+: b)
488+ , FromPair (a :+: b)
489+ , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) True where
490+ parseSum opts
491+ | allNullaryToStringTag opts = Tagged . parseAllNullarySum opts
492+ | otherwise = Tagged . parseNonAllNullarySum opts
493+ {-# INLINE parseSum #-}
494+
495+instance ( FromPair (a :+: b)
496+ , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) False where
497+ parseSum opts = Tagged . parseNonAllNullarySum opts
498+ {-# INLINE parseSum #-}
499+
500+--------------------------------------------------------------------------------
501+
502+parseAllNullarySum :: SumFromString f => Options -> Value -> Parser (f a)
503+parseAllNullarySum opts = withText "Text" $ \key ->
504+ maybe (notFound $ unpack key) return $
505+ parseSumFromString opts key
506+{-# INLINE parseAllNullarySum #-}
507+
508+class SumFromString f where
509+ parseSumFromString :: Options -> Text -> Maybe (f a)
510+
511+instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where
512+ parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>
513+ (R1 <$> parseSumFromString opts key)
514+ {-# INLINE parseSumFromString #-}
515+
516+instance (Constructor c) => SumFromString (C1 c U1) where
517+ parseSumFromString opts key | key == name = Just $ M1 U1
518+ | otherwise = Nothing
519+ where
520+ name = pack $ constructorTagModifier opts $
521+ conName (undefined :: t c U1 p)
522+ {-# INLINE parseSumFromString #-}
523+
524+--------------------------------------------------------------------------------
525+
526+parseNonAllNullarySum :: ( FromPair (a :+: b)
527+ , FromTaggedObject (a :+: b)
528+ ) => Options -> Value -> Parser ((a :+: b) c)
529+parseNonAllNullarySum opts =
530+ case sumEncoding opts of
531+ TaggedObject{..} ->
532+ withObject "Object" $ \obj -> do
533+ tag <- obj .: pack tagFieldName
534+ fromMaybe (notFound $ unpack tag) $
535+ parseFromTaggedObject opts contentsFieldName obj tag
536+
537+ ObjectWithSingleField ->
538+ withObject "Object" $ \obj ->
539+ case H.toList obj of
540+ [pair@(tag, _)] -> fromMaybe (notFound $ unpack tag) $
541+ parsePair opts pair
542+ _ -> fail "Object doesn't have a single field"
543+
544+ TwoElemArray ->
545+ withArray "Array" $ \arr ->
546+ if V.length arr == 2
547+ then case V.unsafeIndex arr 0 of
548+ String tag -> fromMaybe (notFound $ unpack tag) $
549+ parsePair opts (tag, V.unsafeIndex arr 1)
550+ _ -> fail "First element is not a String"
551+ else fail "Array doesn't have 2 elements"
552+{-# INLINE parseNonAllNullarySum #-}
553+
554+--------------------------------------------------------------------------------
555+
556+class FromTaggedObject f where
557+ parseFromTaggedObject :: Options -> String -> Object -> Text
558+ -> Maybe (Parser (f a))
559+
560+instance (FromTaggedObject a, FromTaggedObject b) =>
561+ FromTaggedObject (a :+: b) where
562+ parseFromTaggedObject opts contentsFieldName obj tag =
563+ (fmap L1 <$> parseFromTaggedObject opts contentsFieldName obj tag) <|>
564+ (fmap R1 <$> parseFromTaggedObject opts contentsFieldName obj tag)
565+ {-# INLINE parseFromTaggedObject #-}
566+
567+instance ( FromTaggedObject' f
568+ , Constructor c ) => FromTaggedObject (C1 c f) where
569+ parseFromTaggedObject opts contentsFieldName obj tag
570+ | tag == name = Just $ M1 <$> parseFromTaggedObject'
571+ opts contentsFieldName obj
572+ | otherwise = Nothing
573+ where
574+ name = pack $ constructorTagModifier opts $
575+ conName (undefined :: t c f p)
576+ {-# INLINE parseFromTaggedObject #-}
577+
578+--------------------------------------------------------------------------------
579+
580+class FromTaggedObject' f where
581+ parseFromTaggedObject' :: Options -> String -> Object -> Parser (f a)
582+
583+class FromTaggedObject'' f isRecord where
584+ parseFromTaggedObject'' :: Options -> String -> Object
585+ -> Tagged isRecord (Parser (f a))
586+
587+instance ( IsRecord f isRecord
588+ , FromTaggedObject'' f isRecord
589+ ) => FromTaggedObject' f where
590+ parseFromTaggedObject' opts contentsFieldName =
591+ (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .
592+ parseFromTaggedObject'' opts contentsFieldName
593+ {-# INLINE parseFromTaggedObject' #-}
594+
595+instance (FromRecord f) => FromTaggedObject'' f True where
596+ parseFromTaggedObject'' opts _ = Tagged . parseRecord opts Nothing
597+ {-# INLINE parseFromTaggedObject'' #-}
598+
599+instance (GFromJSON f) => FromTaggedObject'' f False where
600+ parseFromTaggedObject'' opts contentsFieldName = Tagged .
601+ (gParseJSON opts <=< (.: pack contentsFieldName))
602+ {-# INLINE parseFromTaggedObject'' #-}
603+
604+--------------------------------------------------------------------------------
605+
606+class ConsFromJSON f where
607+ consParseJSON :: Options -> Value -> Parser (f a)
608+
609+class ConsFromJSON' f isRecord where
610+ consParseJSON' :: Options -> (Maybe Text) -- ^ A dummy label
611+ -- (Nothing to use proper label)
612+ -> Value -> Tagged isRecord (Parser (f a))
613+
614+instance ( IsRecord f isRecord
615+ , ConsFromJSON' f isRecord
616+ ) => ConsFromJSON f where
617+ consParseJSON opts v = let
618+ (v2,lab) = case (unwrapUnaryRecords opts,isUnary (undefined :: f a)) of
619+ -- use a dummy object with a dummy label
620+ (True,True) -> ((object [(pack "dummy",v)]),Just $ pack "dummy")
621+ _ ->(v,Nothing)
622+ in (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
623+ $ consParseJSON' opts lab v2
624+ {-# INLINE consParseJSON #-}
625+
626+
627+instance (FromRecord f) => ConsFromJSON' f True where
628+ consParseJSON' opts mlab = Tagged . (withObject "record (:*:)"
629+ $ parseRecord opts mlab)
630+ {-# INLINE consParseJSON' #-}
631+
632+instance (GFromJSON f) => ConsFromJSON' f False where
633+ consParseJSON' opts _ = Tagged . gParseJSON opts
634+ {-# INLINE consParseJSON' #-}
635+
636+--------------------------------------------------------------------------------
637+
638+class FromRecord f where
639+ parseRecord :: Options -> (Maybe Text) -- ^ A dummy label
640+ -- (Nothing to use proper label)
641+ -> Object -> Parser (f a)
642+
643+instance (FromRecord a, FromRecord b) => FromRecord (a :*: b) where
644+ parseRecord opts _ obj = (:*:) <$> parseRecord opts Nothing obj
645+ <*> parseRecord opts Nothing obj
646+ {-# INLINE parseRecord #-}
647+
648+instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where
649+ parseRecord opts (Just lab) = maybe (notFound $ unpack lab)
650+ (gParseJSON opts) . H.lookup lab
651+ parseRecord opts Nothing = maybe (notFound label)
652+ (gParseJSON opts) . H.lookup (pack label)
653+ where
654+ label = fieldLabelModifier opts $ selName (undefined :: t s a p)
655+ {-# INLINE parseRecord #-}
656+
657+instance (Selector s, FromJSON a) => FromRecord (S1 s (K1 i (Maybe a))) where
658+ parseRecord _ (Just lab) obj = (M1 . K1) <$> obj .:? lab
659+ parseRecord opts Nothing obj = (M1 . K1) <$> obj .:? pack label
660+ where
661+ label = fieldLabelModifier opts $
662+ selName (undefined :: t s (K1 i (Maybe a)) p)
663+ {-# INLINE parseRecord #-}
664+
665+--------------------------------------------------------------------------------
666+
667+class ProductSize f where
668+ productSize :: Tagged2 f Int
669+
670+instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where
671+ productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) +
672+ unTagged2 (productSize :: Tagged2 b Int)
673+ {-# INLINE productSize #-}
674+
675+instance ProductSize (S1 s a) where
676+ productSize = Tagged2 1
677+ {-# INLINE productSize #-}
678+
679+--------------------------------------------------------------------------------
680+
681+class FromProduct f where
682+ parseProduct :: Options -> Array -> Int -> Int -> Parser (f a)
683+
684+instance (FromProduct a, FromProduct b) => FromProduct (a :*: b) where
685+ parseProduct opts arr ix len =
686+ (:*:) <$> parseProduct opts arr ix lenL
687+ <*> parseProduct opts arr ixR lenR
688+ where
689+ lenL = len `unsafeShiftR` 1
690+ ixR = ix + lenL
691+ lenR = len - lenL
692+ {-# INLINE parseProduct #-}
693+
694+instance (GFromJSON a) => FromProduct (S1 s a) where
695+ parseProduct opts arr ix _ = gParseJSON opts $ V.unsafeIndex arr ix
696+ {-# INLINE parseProduct #-}
697+
698+--------------------------------------------------------------------------------
699+
700+class FromPair f where
701+ parsePair :: Options -> Pair -> Maybe (Parser (f a))
702+
703+instance (FromPair a, FromPair b) => FromPair (a :+: b) where
704+ parsePair opts pair = (fmap L1 <$> parsePair opts pair) <|>
705+ (fmap R1 <$> parsePair opts pair)
706+ {-# INLINE parsePair #-}
707+
708+instance (Constructor c, GFromJSON a, ConsFromJSON a) => FromPair (C1 c a) where
709+ parsePair opts (tag, value)
710+ | tag == tag' = Just $ gParseJSON opts value
711+ | otherwise = Nothing
712+ where
713+ tag' = pack $ constructorTagModifier opts $
714+ conName (undefined :: t c a p)
715+ {-# INLINE parsePair #-}
44
716
45--------------------------------------------------------------------------------
717--------------------------------------------------------------------------------
46
718
47class IsRecord (f :: * -> *) isRecord | f -> isRecord
719class IsRecord (f :: * -> *) isRecord | f -> isRecord
720+ where
721+ isUnary :: f a -> Bool
722+ isUnary = const True
48
723
49instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
724instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
50−#if MIN_VERSION_base(4,9,0)
725+ where isUnary = const False
51−instance OVERLAPPING_ IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False
52−#else
53−instance OVERLAPPING_ IsRecord (M1 S NoSelector f) False
726+instance IsRecord (M1 S NoSelector f) False
54−#endif
55instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
727instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
56instance IsRecord (K1 i c) True
728instance 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
729instance IsRecord U1 False
730+ where isUnary = const False
61
731
62--------------------------------------------------------------------------------
732--------------------------------------------------------------------------------
63
733
@@ -69,15 +739,9 @@ instance ( AllNullary a allNullaryL
69 ) => AllNullary (a :+: b) allNullary
739 ) => AllNullary (a :+: b) allNullary
70instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
740instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
71instance AllNullary (a :*: b) False
741instance AllNullary (a :*: b) False
72−instance AllNullary (a :.: b) False
73instance AllNullary (K1 i c) False
742instance AllNullary (K1 i c) False
74−instance AllNullary Par1 False
75−instance AllNullary (Rec1 f) False
76instance AllNullary U1 True
743instance AllNullary U1 True
77
744
78−newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}
79− deriving Functor
80−
81--------------------------------------------------------------------------------
745--------------------------------------------------------------------------------
82
746
83data True
747data True
@@ -92,27 +756,12 @@ instance And True False False
92
756
93--------------------------------------------------------------------------------
757--------------------------------------------------------------------------------
94
758
95−-- | A type-level indicator that 'ToJSON' or 'FromJSON' is being derived generically.
759+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
760
101−--------------------------------------------------------------------------------
761+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
762
113--------------------------------------------------------------------------------
763--------------------------------------------------------------------------------
114
764
115−-- | Simple extensible tuple type to simplify passing around many parameters.
765+notFound :: String -> Parser a
116−data a :* b = a :* b
766+notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
117−
767+{-# INLINE notFound #-}
118−infixr 1 :*
Data/Aeson/Types/Instances.hsnew file+1568
@@ -0,0 +1,1568 @@
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-2015 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+ , KeyValue(..)
28+ -- ** Generic JSON classes
29+ , GFromJSON(..)
30+ , GToJSON(..)
31+ , genericToJSON
32+ , genericParseJSON
33+
34+ -- * Types
35+ , DotNetTime(..)
36+
37+ -- * Inspecting @'Value's@
38+ , withObject
39+ , withText
40+ , withArray
41+ , withNumber
42+ , withScientific
43+ , withBool
44+
45+ -- * Functions
46+ , fromJSON
47+ , (.:)
48+ , (.:?)
49+ , (.!=)
50+ , builder
51+ , series
52+ , foldable
53+ , tuple
54+ , (>*<)
55+ , typeMismatch
56+ ) where
57+
58+import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)
59+import qualified Data.Aeson.Encode.ByteString as E
60+import qualified Data.ByteString.Builder as B
61+import Data.Aeson.Functions
62+import Data.Monoid ((<>), mempty)
63+import Data.Aeson.Types.Class
64+import Data.Aeson.Types.Internal
65+import Data.Scientific (Scientific)
66+import qualified Data.Scientific as Scientific (coefficient, base10Exponent, fromFloatDigits, toRealFloat)
67+import Data.Attoparsec.Number (Number(..))
68+import Data.Fixed
69+import Data.Foldable (Foldable, foldMap, toList)
70+import Data.ByteString.Builder.Prim (primBounded)
71+import Data.Functor.Identity (Identity(..))
72+import Data.Hashable (Hashable(..))
73+import Data.Int (Int8, Int16, Int32, Int64)
74+import Data.Maybe (fromMaybe)
75+import Data.Monoid (Dual(..), First(..), Last(..))
76+import Data.Ratio (Ratio, (%), numerator, denominator)
77+import Data.Text (Text, pack, unpack)
78+import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))
79+import Data.Time.Format (FormatTime, formatTime, parseTime)
80+import Data.Traversable as Tr (sequence, traverse)
81+import Data.Vector (Vector)
82+import Data.Word (Word, Word8, Word16, Word32, Word64)
83+import Foreign.Storable (Storable)
84+import Prelude hiding (foldr)
85+import qualified Data.HashMap.Strict as H
86+import qualified Data.HashSet as HashSet
87+import qualified Data.IntMap as IntMap
88+import qualified Data.IntSet as IntSet
89+import qualified Data.Map as M
90+import qualified Data.Set as Set
91+import qualified Data.Sequence as Seq
92+import qualified Data.Tree as Tree
93+import qualified Data.Text as T
94+import qualified Data.Text.Lazy as LT
95+import qualified Data.Vector as V
96+import qualified Data.Vector.Generic as VG
97+import qualified Data.Vector.Primitive as VP
98+import qualified Data.Vector.Storable as VS
99+import qualified Data.Vector.Unboxed as VU
100+import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )
101+import qualified Prelude as P
102+
103+#if MIN_VERSION_time(1,5,0)
104+import Data.Time.Format (defaultTimeLocale, dateTimeFmt)
105+#else
106+import System.Locale (defaultTimeLocale, dateTimeFmt)
107+#endif
108+
109+parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a
110+parseIndexedJSON idx value = parseJSON value <?> Index idx
111+
112+instance (ToJSON a) => ToJSON (Identity a) where
113+ toJSON (Identity a) = toJSON a
114+ {-# INLINE toJSON #-}
115+
116+ toEncoding (Identity a) = toEncoding a
117+ {-# INLINE toEncoding #-}
118+
119+instance (FromJSON a) => FromJSON (Identity a) where
120+ parseJSON a = Identity <$> parseJSON a
121+ {-# INLINE parseJSON #-}
122+
123+instance (ToJSON a) => ToJSON (Maybe a) where
124+ toJSON (Just a) = toJSON a
125+ toJSON Nothing = Null
126+ {-# INLINE toJSON #-}
127+
128+ toEncoding (Just a) = toEncoding a
129+ toEncoding Nothing = Encoding E.null_
130+
131+instance (FromJSON a) => FromJSON (Maybe a) where
132+ parseJSON Null = pure Nothing
133+ parseJSON a = Just <$> parseJSON a
134+ {-# INLINE parseJSON #-}
135+
136+instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
137+ toJSON (Left a) = object [left .= a]
138+ toJSON (Right b) = object [right .= b]
139+ {-# INLINE toJSON #-}
140+
141+ toEncoding (Left a) = Encoding $
142+ B.shortByteString "{\"left\":" <> builder a <> B.char7 '}'
143+ toEncoding (Right a) = Encoding $
144+ B.shortByteString "{\"right\":" <> builder a <> B.char7 '}'
145+
146+builder :: ToJSON a => a -> B.Builder
147+builder = fromEncoding . toEncoding
148+{-# INLINE builder #-}
149+
150+instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where
151+ parseJSON (Object (H.toList -> [(key, value)]))
152+ | key == left = Left <$> parseJSON value
153+ | key == right = Right <$> parseJSON value
154+ parseJSON _ = fail $
155+ "expected an object with a single property " ++
156+ "where the property key should be either " ++
157+ "\"Left\" or \"Right\""
158+ {-# INLINE parseJSON #-}
159+
160+left, right :: Text
161+left = "Left"
162+right = "Right"
163+
164+instance ToJSON Bool where
165+ toJSON = Bool
166+ {-# INLINE toJSON #-}
167+
168+ toEncoding = Encoding . E.bool
169+
170+instance FromJSON Bool where
171+ parseJSON = withBool "Bool" pure
172+ {-# INLINE parseJSON #-}
173+
174+instance ToJSON () where
175+ toJSON _ = emptyArray
176+ {-# INLINE toJSON #-}
177+
178+ toEncoding _ = E.emptyArray_
179+
180+instance FromJSON () where
181+ parseJSON = withArray "()" $ \v ->
182+ if V.null v
183+ then pure ()
184+ else fail "Expected an empty array"
185+ {-# INLINE parseJSON #-}
186+
187+instance ToJSON [Char] where
188+ toJSON = String . T.pack
189+ {-# INLINE toJSON #-}
190+
191+ toEncoding = Encoding . E.text . T.pack
192+
193+instance FromJSON [Char] where
194+ parseJSON = withText "String" $ pure . T.unpack
195+ {-# INLINE parseJSON #-}
196+
197+instance ToJSON Char where
198+ toJSON = String . T.singleton
199+ {-# INLINE toJSON #-}
200+
201+ toEncoding = Encoding . E.text . T.singleton
202+
203+instance FromJSON Char where
204+ parseJSON = withText "Char" $ \t ->
205+ if T.compareLength t 1 == EQ
206+ then pure $ T.head t
207+ else fail "Expected a string of length 1"
208+ {-# INLINE parseJSON #-}
209+
210+instance ToJSON Scientific where
211+ toJSON = Number
212+ {-# INLINE toJSON #-}
213+
214+ toEncoding = Encoding . E.number
215+ {-# INLINE toEncoding #-}
216+
217+instance FromJSON Scientific where
218+ parseJSON = withScientific "Scientific" pure
219+ {-# INLINE parseJSON #-}
220+
221+instance ToJSON Double where
222+ toJSON = realFloatToJSON
223+ {-# INLINE toJSON #-}
224+
225+ toEncoding = realFloatToEncoding
226+ {-# INLINE toEncoding #-}
227+
228+instance FromJSON Double where
229+ parseJSON = parseRealFloat "Double"
230+ {-# INLINE parseJSON #-}
231+
232+instance ToJSON Number where
233+ toJSON (D d) = toJSON d
234+ toJSON (I i) = toJSON i
235+ {-# INLINE toJSON #-}
236+
237+ toEncoding (D d) = toEncoding d
238+ toEncoding (I i) = toEncoding i
239+ {-# INLINE toEncoding #-}
240+
241+instance FromJSON Number where
242+ parseJSON (Number s) = pure $ scientificToNumber s
243+ parseJSON Null = pure (D (0/0))
244+ parseJSON v = typeMismatch "Number" v
245+ {-# INLINE parseJSON #-}
246+
247+instance ToJSON Float where
248+ toJSON = realFloatToJSON
249+ {-# INLINE toJSON #-}
250+
251+ toEncoding = realFloatToEncoding
252+ {-# INLINE toEncoding #-}
253+
254+instance FromJSON Float where
255+ parseJSON = parseRealFloat "Float"
256+ {-# INLINE parseJSON #-}
257+
258+instance ToJSON (Ratio Integer) where
259+ toJSON r = object [ "numerator" .= numerator r
260+ , "denominator" .= denominator r
261+ ]
262+
263+ toEncoding r = Encoding $
264+ B.shortByteString "{\"numerator\":" <> builder (numerator r) <>
265+ B.shortByteString ",\"denominator\":" <> builder (denominator r) <>
266+ B.char7 '}'
267+
268+instance FromJSON (Ratio Integer) where
269+ parseJSON = withObject "Rational" $ \obj ->
270+ (%) <$> obj .: "numerator"
271+ <*> obj .: "denominator"
272+ {-# INLINE parseJSON #-}
273+
274+instance HasResolution a => ToJSON (Fixed a) where
275+ toJSON = Number . realToFrac
276+ {-# INLINE toJSON #-}
277+
278+ toEncoding = Encoding . E.number . realToFrac
279+
280+-- | /WARNING:/ Only parse fixed-precision numbers from trusted input
281+-- since an attacker could easily fill up the memory of the target
282+-- system by specifying a scientific number with a big exponent like
283+-- @1e1000000000@.
284+instance HasResolution a => FromJSON (Fixed a) where
285+ parseJSON = withScientific "Fixed" $ pure . realToFrac
286+ {-# INLINE parseJSON #-}
287+
288+instance ToJSON Int where
289+ toJSON = Number . fromIntegral
290+ {-# INLINE toJSON #-}
291+
292+ toEncoding = Encoding . B.intDec
293+ {-# INLINE toEncoding #-}
294+
295+instance FromJSON Int where
296+ parseJSON = parseIntegral "Int"
297+ {-# INLINE parseJSON #-}
298+
299+instance ToJSON Integer where
300+ toJSON = Number . fromInteger
301+ {-# INLINE toJSON #-}
302+
303+ toEncoding = Encoding . B.integerDec
304+
305+-- | /WARNING:/ Only parse Integers from trusted input since an
306+-- attacker could easily fill up the memory of the target system by
307+-- specifying a scientific number with a big exponent like
308+-- @1e1000000000@.
309+instance FromJSON Integer where
310+ parseJSON = withScientific "Integral" $ pure . floor
311+ {-# INLINE parseJSON #-}
312+
313+instance ToJSON Int8 where
314+ toJSON = Number . fromIntegral
315+ {-# INLINE toJSON #-}
316+
317+ toEncoding = Encoding . B.int8Dec
318+
319+instance FromJSON Int8 where
320+ parseJSON = parseIntegral "Int8"
321+ {-# INLINE parseJSON #-}
322+
323+instance ToJSON Int16 where
324+ toJSON = Number . fromIntegral
325+ {-# INLINE toJSON #-}
326+
327+ toEncoding = Encoding . B.int16Dec
328+
329+instance FromJSON Int16 where
330+ parseJSON = parseIntegral "Int16"
331+ {-# INLINE parseJSON #-}
332+
333+instance ToJSON Int32 where
334+ toJSON = Number . fromIntegral
335+ {-# INLINE toJSON #-}
336+
337+ toEncoding = Encoding . B.int32Dec
338+
339+instance FromJSON Int32 where
340+ parseJSON = parseIntegral "Int32"
341+ {-# INLINE parseJSON #-}
342+
343+instance ToJSON Int64 where
344+ toJSON = Number . fromIntegral
345+ {-# INLINE toJSON #-}
346+
347+ toEncoding = Encoding . B.int64Dec
348+
349+instance FromJSON Int64 where
350+ parseJSON = parseIntegral "Int64"
351+ {-# INLINE parseJSON #-}
352+
353+instance ToJSON Word where
354+ toJSON = Number . fromIntegral
355+ {-# INLINE toJSON #-}
356+
357+ toEncoding = Encoding . B.wordDec
358+
359+instance FromJSON Word where
360+ parseJSON = parseIntegral "Word"
361+ {-# INLINE parseJSON #-}
362+
363+instance ToJSON Word8 where
364+ toJSON = Number . fromIntegral
365+ {-# INLINE toJSON #-}
366+
367+ toEncoding = Encoding . B.word8Dec
368+
369+instance FromJSON Word8 where
370+ parseJSON = parseIntegral "Word8"
371+ {-# INLINE parseJSON #-}
372+
373+instance ToJSON Word16 where
374+ toJSON = Number . fromIntegral
375+ {-# INLINE toJSON #-}
376+
377+ toEncoding = Encoding . B.word16Dec
378+
379+instance FromJSON Word16 where
380+ parseJSON = parseIntegral "Word16"
381+ {-# INLINE parseJSON #-}
382+
383+instance ToJSON Word32 where
384+ toJSON = Number . fromIntegral
385+ {-# INLINE toJSON #-}
386+
387+ toEncoding = Encoding . B.word32Dec
388+
389+instance FromJSON Word32 where
390+ parseJSON = parseIntegral "Word32"
391+ {-# INLINE parseJSON #-}
392+
393+instance ToJSON Word64 where
394+ toJSON = Number . fromIntegral
395+ {-# INLINE toJSON #-}
396+
397+ toEncoding = Encoding . B.word64Dec
398+
399+instance FromJSON Word64 where
400+ parseJSON = parseIntegral "Word64"
401+ {-# INLINE parseJSON #-}
402+
403+instance ToJSON Text where
404+ toJSON = String
405+ {-# INLINE toJSON #-}
406+
407+ toEncoding = Encoding . E.text
408+
409+instance FromJSON Text where
410+ parseJSON = withText "Text" pure
411+ {-# INLINE parseJSON #-}
412+
413+instance ToJSON LT.Text where
414+ toJSON = String . LT.toStrict
415+ {-# INLINE toJSON #-}
416+
417+ toEncoding t = Encoding $
418+ B.char7 '"' <>
419+ LT.foldrChunks (\x xs -> E.unquoted x <> xs) mempty t <>
420+ B.char7 '"'
421+
422+instance FromJSON LT.Text where
423+ parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
424+ {-# INLINE parseJSON #-}
425+
426+instance (ToJSON a) => ToJSON [a] where
427+ toJSON = Array . V.fromList . map toJSON
428+ {-# INLINE toJSON #-}
429+
430+ toEncoding [] = E.emptyArray_
431+ toEncoding (x:xs) = Encoding $
432+ B.char7 '[' <> builder x <> commas xs <> B.char7 ']'
433+ where commas = P.foldr (\v vs -> B.char7 ',' <> builder v <> vs) mempty
434+
435+instance (FromJSON a) => FromJSON [a] where
436+ parseJSON = withArray "[a]" $ Tr.sequence .
437+ zipWith parseIndexedJSON [0..] . V.toList
438+ {-# INLINE parseJSON #-}
439+
440+instance (Foldable t, ToJSON a) => ToJSON (t a) where
441+ toJSON = toJSON . toList
442+ {-# INLINE toJSON #-}
443+
444+ toEncoding = foldable
445+
446+instance (FromJSON a) => FromJSON (Seq.Seq a) where
447+ parseJSON = withArray "Seq a" $ traverse parseJSON . Seq.fromList . V.toList
448+ {-# INLINE parseJSON #-}
449+
450+instance (ToJSON a) => ToJSON (Vector a) where
451+ toJSON = Array . V.map toJSON
452+ {-# INLINE toJSON #-}
453+
454+ toEncoding = encodeVector
455+
456+-- | Encode a 'Foldable' as a JSON array.
457+foldable :: (Foldable t, ToJSON a) => t a -> Encoding
458+foldable = brackets '[' ']' . foldMap (Value . toEncoding)
459+
460+brackets :: Char -> Char -> Series -> Encoding
461+brackets begin end (Value v) = Encoding $
462+ B.char7 begin <> fromEncoding v <> B.char7 end
463+brackets begin end Empty = Encoding (primBounded (E.ascii2 (begin,end)) ())
464+
465+encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
466+encodeVector xs
467+ | VG.null xs = E.emptyArray_
468+ | otherwise = Encoding $
469+ B.char7 '[' <> builder (VG.unsafeHead xs) <>
470+ VG.foldr go mempty (VG.unsafeTail xs) <>
471+ B.char7 ']'
472+ where go v b = B.char7 ',' <> builder v <> b
473+
474+instance (FromJSON a) => FromJSON (Vector a) where
475+ parseJSON = withArray "Vector a" $ V.mapM (uncurry parseIndexedJSON) .
476+ V.indexed
477+ {-# INLINE parseJSON #-}
478+
479+vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
480+vectorToJSON = Array . V.map toJSON . V.convert
481+{-# INLINE vectorToJSON #-}
482+
483+vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
484+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry parseIndexedJSON) . V.indexed
485+{-# INLINE vectorParseJSON #-}
486+
487+instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
488+ toJSON = vectorToJSON
489+
490+ toEncoding = encodeVector
491+
492+instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where
493+ parseJSON = vectorParseJSON "Data.Vector.Storable.Vector a"
494+
495+instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where
496+ toJSON = vectorToJSON
497+
498+ toEncoding = encodeVector
499+
500+instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where
501+ parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector a"
502+
503+instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where
504+ toJSON = vectorToJSON
505+
506+ toEncoding = encodeVector
507+
508+instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where
509+ parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"
510+
511+instance (ToJSON a) => ToJSON (Set.Set a) where
512+ toJSON = toJSON . Set.toList
513+ {-# INLINE toJSON #-}
514+
515+ toEncoding = encodeSet Set.minView Set.foldr
516+
517+instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where
518+ parseJSON = fmap Set.fromList . parseJSON
519+ {-# INLINE parseJSON #-}
520+
521+instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
522+ toJSON = toJSON . HashSet.toList
523+ {-# INLINE toJSON #-}
524+
525+ toEncoding = foldable
526+
527+instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where
528+ parseJSON = fmap HashSet.fromList . parseJSON
529+ {-# INLINE parseJSON #-}
530+
531+instance ToJSON IntSet.IntSet where
532+ toJSON = toJSON . IntSet.toList
533+ {-# INLINE toJSON #-}
534+
535+ toEncoding = encodeSet IntSet.minView IntSet.foldr
536+
537+encodeSet :: (ToJSON a) =>
538+ (s -> Maybe (a, s))
539+ -> ((a -> B.Builder -> B.Builder) -> B.Builder -> s -> B.Builder)
540+ -> s -> Encoding
541+encodeSet minView foldr xs =
542+ case minView xs of
543+ Nothing -> E.emptyArray_
544+ Just (m,ys) -> Encoding $
545+ B.char7 '[' <> builder m <>
546+ foldr go mempty ys <>
547+ B.char7 ']'
548+ where go v b = B.char7 ',' <> builder v <> b
549+
550+instance FromJSON IntSet.IntSet where
551+ parseJSON = fmap IntSet.fromList . parseJSON
552+ {-# INLINE parseJSON #-}
553+
554+instance ToJSON a => ToJSON (IntMap.IntMap a) where
555+ toJSON = toJSON . IntMap.toList
556+ {-# INLINE toJSON #-}
557+
558+ toEncoding = toEncoding . IntMap.toList
559+
560+instance FromJSON a => FromJSON (IntMap.IntMap a) where
561+ parseJSON = fmap IntMap.fromList . parseJSON
562+ {-# INLINE parseJSON #-}
563+
564+instance (ToJSON v) => ToJSON (M.Map Text v) where
565+ toJSON = Object . M.foldrWithKey (\k -> H.insert k . toJSON) H.empty
566+ {-# INLINE toJSON #-}
567+
568+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey
569+
570+encodeMap :: (ToJSON k, ToJSON v) =>
571+ (m -> Maybe ((k,v), m))
572+ -> ((k -> v -> B.Builder -> B.Builder) -> B.Builder -> m -> B.Builder)
573+ -> m -> Encoding
574+encodeMap minViewWithKey foldrWithKey xs =
575+ case minViewWithKey xs of
576+ Nothing -> E.emptyObject_
577+ Just ((k,v),ys) -> Encoding $
578+ B.char7 '{' <> encodePair k v <>
579+ foldrWithKey go mempty ys <> B.char7 '}'
580+ where go k v b = B.char7 ',' <> encodePair k v <> b
581+
582+encodeWithKey :: (ToJSON k, ToJSON v) =>
583+ ((k -> v -> Series -> Series) -> Series -> m -> Series)
584+ -> m -> Encoding
585+encodeWithKey foldrWithKey = brackets '{' '}' . foldrWithKey go mempty
586+ where go k v c = Value (Encoding $ encodePair k v) <> c
587+
588+encodePair :: (ToJSON k, ToJSON v) => k -> v -> B.Builder
589+encodePair k v = builder k <> B.char7 ':' <> builder v
590+
591+instance (FromJSON v) => FromJSON (M.Map Text v) where
592+ parseJSON = withObject "Map Text a" $
593+ fmap (H.foldrWithKey M.insert M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
594+
595+instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
596+ toJSON = Object . mapHashKeyVal LT.toStrict toJSON
597+
598+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey
599+
600+instance (FromJSON v) => FromJSON (M.Map LT.Text v) where
601+ parseJSON = fmap (hashMapKey LT.fromStrict) . parseJSON
602+
603+instance (ToJSON v) => ToJSON (M.Map String v) where
604+ toJSON = Object . mapHashKeyVal pack toJSON
605+
606+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey
607+
608+instance (FromJSON v) => FromJSON (M.Map String v) where
609+ parseJSON = fmap (hashMapKey unpack) . parseJSON
610+
611+instance (ToJSON v) => ToJSON (H.HashMap Text v) where
612+ toJSON = Object . H.map toJSON
613+ {-# INLINE toJSON #-}
614+
615+ toEncoding = encodeWithKey H.foldrWithKey
616+
617+instance (FromJSON v) => FromJSON (H.HashMap Text v) where
618+ parseJSON = withObject "HashMap Text a" $ H.traverseWithKey (\k v -> parseJSON v <?> Key k)
619+
620+instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
621+ toJSON = Object . mapKeyVal LT.toStrict toJSON
622+
623+ toEncoding = encodeWithKey H.foldrWithKey
624+
625+instance (FromJSON v) => FromJSON (H.HashMap LT.Text v) where
626+ parseJSON = fmap (mapKey LT.fromStrict) . parseJSON
627+
628+instance (ToJSON v) => ToJSON (H.HashMap String v) where
629+ toJSON = Object . mapKeyVal pack toJSON
630+
631+ toEncoding = encodeWithKey H.foldrWithKey
632+
633+instance (FromJSON v) => FromJSON (H.HashMap String v) where
634+ parseJSON = fmap (mapKey unpack) . parseJSON
635+
636+instance (ToJSON v) => ToJSON (Tree.Tree v) where
637+ toJSON (Tree.Node root branches) = toJSON (root,branches)
638+
639+ toEncoding (Tree.Node root branches) = toEncoding (root,branches)
640+
641+instance (FromJSON v) => FromJSON (Tree.Tree v) where
642+ parseJSON j = uncurry Tree.Node <$> parseJSON j
643+
644+instance ToJSON Value where
645+ toJSON a = a
646+ {-# INLINE toJSON #-}
647+
648+ toEncoding = Encoding . E.encodeToBuilder
649+
650+instance FromJSON Value where
651+ parseJSON a = pure a
652+ {-# INLINE parseJSON #-}
653+
654+instance ToJSON DotNetTime where
655+ toJSON = toJSON . dotNetTime
656+ {-# INLINE toJSON #-}
657+
658+ toEncoding = toEncoding . dotNetTime
659+
660+dotNetTime :: DotNetTime -> String
661+dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
662+ where secs = formatTime defaultTimeLocale "/Date(%s" t
663+
664+instance FromJSON DotNetTime where
665+ parseJSON = withText "DotNetTime" $ \t ->
666+ let (s,m) = T.splitAt (T.length t - 5) t
667+ t' = T.concat [s,".",m]
668+ in case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of
669+ Just d -> pure (DotNetTime d)
670+ _ -> fail "could not parse .NET time"
671+ {-# INLINE parseJSON #-}
672+
673+instance ToJSON ZonedTime where
674+ toJSON = toJSON . zonedTime
675+
676+ toEncoding = toEncoding . zonedTime
677+
678+zonedTime :: ZonedTime -> String
679+zonedTime t = formatTime defaultTimeLocale format t
680+ where
681+ format = "%FT%T." ++ formatMillis t ++ tzFormat
682+ tzFormat | timeZoneMinutes (zonedTimeZone t) == 0 = "Z"
683+ | otherwise = "%z"
684+
685+formatMillis :: (FormatTime t) => t -> String
686+formatMillis = take 3 . formatSubseconds
687+
688+formatSubseconds :: (FormatTime t) => t -> String
689+formatSubseconds = formatTime defaultTimeLocale "%q"
690+
691+instance FromJSON ZonedTime where
692+ parseJSON (String t) =
693+ tryFormats alternateFormats
694+ <|> fail "could not parse ECMA-262 ISO-8601 date"
695+ where
696+ tryFormat f =
697+ case parseTime defaultTimeLocale f (unpack t) of
698+ Just d -> pure d
699+ Nothing -> empty
700+ tryFormats = foldr1 (<|>) . map tryFormat
701+ alternateFormats =
702+ "%FT%T%QZ" : -- (javascript new Date().toISOString())
703+ "%F %T%Q%z" : -- (postgres)
704+ "%F %T%Q %Z" : -- (time's Show format)
705+ "%FT%T%Q%z" :
706+ "%Y-%mT%T%Q" :
707+ "%Y-%mT%R" :
708+ "%Y-%mT%T" :
709+ "%Y-%mT%T%QZ" :
710+ "%Y-%mT%T%Q%z" :
711+ "%YT%T%Q" :
712+ "%YT%R" :
713+ "%YT%T" :
714+ "%YT%T%QZ" :
715+ "%YT%T%Q%z" :
716+ "%FT%T%Q" :
717+ "%FT%R" :
718+ "%FT%T" :
719+ dateTimeFmt defaultTimeLocale :
720+ []
721+
722+ parseJSON v = typeMismatch "ZonedTime" v
723+
724+instance ToJSON UTCTime where
725+ toJSON = toJSON . utcTime
726+ {-# INLINE toJSON #-}
727+
728+ toEncoding = toEncoding . utcTime
729+
730+utcTime :: UTCTime -> String
731+utcTime t = formatTime defaultTimeLocale format t
732+ where format = "%FT%T." ++ formatSubseconds t ++ "Z"
733+
734+instance FromJSON UTCTime where
735+ parseJSON = withText "UTCTime" $ \t ->
736+ case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of
737+ Just d -> pure d
738+ _ -> fail "could not parse ISO-8601 date"
739+ {-# INLINE parseJSON #-}
740+
741+parseJSONElemAtIndex :: FromJSON a => Int -> Vector Value -> Parser a
742+parseJSONElemAtIndex idx ary = parseJSON (V.unsafeIndex ary idx) <?> Index idx
743+
744+tuple :: B.Builder -> Encoding
745+tuple b = Encoding (B.char7 '[' <> b <> B.char7 ']')
746+{-# INLINE tuple #-}
747+
748+(>*<) :: B.Builder -> B.Builder -> B.Builder
749+a >*< b = a <> B.char7 ',' <> b
750+{-# INLINE (>*<) #-}
751+infixr 6 >*<
752+
753+instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
754+ toJSON (a,b) = Array $ V.create $ do
755+ mv <- VM.unsafeNew 2
756+ VM.unsafeWrite mv 0 (toJSON a)
757+ VM.unsafeWrite mv 1 (toJSON b)
758+ return mv
759+ {-# INLINE toJSON #-}
760+
761+ toEncoding (a,b) = tuple $
762+ builder a >*< builder b
763+ {-# INLINE toEncoding #-}
764+
765+instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
766+ parseJSON = withArray "(a,b)" $ \ab ->
767+ let n = V.length ab
768+ in if n == 2
769+ then (,) <$> parseJSONElemAtIndex 0 ab
770+ <*> parseJSONElemAtIndex 1 ab
771+ else fail $ "cannot unpack array of length " ++
772+ show n ++ " into a pair"
773+ {-# INLINE parseJSON #-}
774+
775+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where
776+ toJSON (a,b,c) = Array $ V.create $ do
777+ mv <- VM.unsafeNew 3
778+ VM.unsafeWrite mv 0 (toJSON a)
779+ VM.unsafeWrite mv 1 (toJSON b)
780+ VM.unsafeWrite mv 2 (toJSON c)
781+ return mv
782+ {-# INLINE toJSON #-}
783+
784+ toEncoding (a,b,c) = tuple $
785+ builder a >*<
786+ builder b >*<
787+ builder c
788+ {-# INLINE toEncoding #-}
789+
790+instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
791+ parseJSON = withArray "(a,b,c)" $ \abc ->
792+ let n = V.length abc
793+ in if n == 3
794+ then (,,) <$> parseJSONElemAtIndex 0 abc
795+ <*> parseJSONElemAtIndex 1 abc
796+ <*> parseJSONElemAtIndex 2 abc
797+ else fail $ "cannot unpack array of length " ++
798+ show n ++ " into a 3-tuple"
799+ {-# INLINE parseJSON #-}
800+
801+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where
802+ toJSON (a,b,c,d) = Array $ V.create $ do
803+ mv <- VM.unsafeNew 4
804+ VM.unsafeWrite mv 0 (toJSON a)
805+ VM.unsafeWrite mv 1 (toJSON b)
806+ VM.unsafeWrite mv 2 (toJSON c)
807+ VM.unsafeWrite mv 3 (toJSON d)
808+ return mv
809+ {-# INLINE toJSON #-}
810+
811+ toEncoding (a,b,c,d) = tuple $
812+ builder a >*<
813+ builder b >*<
814+ builder c >*<
815+ builder d
816+ {-# INLINE toEncoding #-}
817+
818+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>
819+ FromJSON (a,b,c,d) where
820+ parseJSON = withArray "(a,b,c,d)" $ \abcd ->
821+ let n = V.length abcd
822+ in if n == 4
823+ then (,,,) <$> parseJSONElemAtIndex 0 abcd
824+ <*> parseJSONElemAtIndex 1 abcd
825+ <*> parseJSONElemAtIndex 2 abcd
826+ <*> parseJSONElemAtIndex 3 abcd
827+ else fail $ "cannot unpack array of length " ++
828+ show n ++ " into a 4-tuple"
829+ {-# INLINE parseJSON #-}
830+
831+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) =>
832+ ToJSON (a,b,c,d,e) where
833+ toJSON (a,b,c,d,e) = Array $ V.create $ do
834+ mv <- VM.unsafeNew 5
835+ VM.unsafeWrite mv 0 (toJSON a)
836+ VM.unsafeWrite mv 1 (toJSON b)
837+ VM.unsafeWrite mv 2 (toJSON c)
838+ VM.unsafeWrite mv 3 (toJSON d)
839+ VM.unsafeWrite mv 4 (toJSON e)
840+ return mv
841+ {-# INLINE toJSON #-}
842+
843+ toEncoding (a,b,c,d,e) = tuple $
844+ builder a >*<
845+ builder b >*<
846+ builder c >*<
847+ builder d >*<
848+ builder e
849+
850+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) =>
851+ FromJSON (a,b,c,d,e) where
852+ parseJSON = withArray "(a,b,c,d,e)" $ \abcde ->
853+ let n = V.length abcde
854+ in if n == 5
855+ then (,,,,) <$> parseJSONElemAtIndex 0 abcde
856+ <*> parseJSONElemAtIndex 1 abcde
857+ <*> parseJSONElemAtIndex 2 abcde
858+ <*> parseJSONElemAtIndex 3 abcde
859+ <*> parseJSONElemAtIndex 4 abcde
860+ else fail $ "cannot unpack array of length " ++
861+ show n ++ " into a 5-tuple"
862+ {-# INLINE parseJSON #-}
863+
864+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) =>
865+ ToJSON (a,b,c,d,e,f) where
866+ toJSON (a,b,c,d,e,f) = Array $ V.create $ do
867+ mv <- VM.unsafeNew 6
868+ VM.unsafeWrite mv 0 (toJSON a)
869+ VM.unsafeWrite mv 1 (toJSON b)
870+ VM.unsafeWrite mv 2 (toJSON c)
871+ VM.unsafeWrite mv 3 (toJSON d)
872+ VM.unsafeWrite mv 4 (toJSON e)
873+ VM.unsafeWrite mv 5 (toJSON f)
874+ return mv
875+ {-# INLINE toJSON #-}
876+
877+ toEncoding (a,b,c,d,e,f) = tuple $
878+ builder a >*<
879+ builder b >*<
880+ builder c >*<
881+ builder d >*<
882+ builder e >*<
883+ builder f
884+
885+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
886+ FromJSON f) => FromJSON (a,b,c,d,e,f) where
887+ parseJSON = withArray "(a,b,c,d,e,f)" $ \abcdef ->
888+ let n = V.length abcdef
889+ in if n == 6
890+ then (,,,,,) <$> parseJSONElemAtIndex 0 abcdef
891+ <*> parseJSONElemAtIndex 1 abcdef
892+ <*> parseJSONElemAtIndex 2 abcdef
893+ <*> parseJSONElemAtIndex 3 abcdef
894+ <*> parseJSONElemAtIndex 4 abcdef
895+ <*> parseJSONElemAtIndex 5 abcdef
896+ else fail $ "cannot unpack array of length " ++
897+ show n ++ " into a 6-tuple"
898+ {-# INLINE parseJSON #-}
899+
900+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
901+ ToJSON g) => ToJSON (a,b,c,d,e,f,g) where
902+ toJSON (a,b,c,d,e,f,g) = Array $ V.create $ do
903+ mv <- VM.unsafeNew 7
904+ VM.unsafeWrite mv 0 (toJSON a)
905+ VM.unsafeWrite mv 1 (toJSON b)
906+ VM.unsafeWrite mv 2 (toJSON c)
907+ VM.unsafeWrite mv 3 (toJSON d)
908+ VM.unsafeWrite mv 4 (toJSON e)
909+ VM.unsafeWrite mv 5 (toJSON f)
910+ VM.unsafeWrite mv 6 (toJSON g)
911+ return mv
912+ {-# INLINE toJSON #-}
913+
914+ toEncoding (a,b,c,d,e,f,g) = tuple $
915+ builder a >*<
916+ builder b >*<
917+ builder c >*<
918+ builder d >*<
919+ builder e >*<
920+ builder f >*<
921+ builder g
922+
923+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
924+ FromJSON f, FromJSON g) => FromJSON (a,b,c,d,e,f,g) where
925+ parseJSON = withArray "(a,b,c,d,e,f,g)" $ \abcdefg ->
926+ let n = V.length abcdefg
927+ in if n == 7
928+ then (,,,,,,) <$> parseJSONElemAtIndex 0 abcdefg
929+ <*> parseJSONElemAtIndex 1 abcdefg
930+ <*> parseJSONElemAtIndex 2 abcdefg
931+ <*> parseJSONElemAtIndex 3 abcdefg
932+ <*> parseJSONElemAtIndex 4 abcdefg
933+ <*> parseJSONElemAtIndex 5 abcdefg
934+ <*> parseJSONElemAtIndex 6 abcdefg
935+ else fail $ "cannot unpack array of length " ++
936+ show n ++ " into a 7-tuple"
937+ {-# INLINE parseJSON #-}
938+
939+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
940+ ToJSON g, ToJSON h) => ToJSON (a,b,c,d,e,f,g,h) where
941+ toJSON (a,b,c,d,e,f,g,h) = Array $ V.create $ do
942+ mv <- VM.unsafeNew 8
943+ VM.unsafeWrite mv 0 (toJSON a)
944+ VM.unsafeWrite mv 1 (toJSON b)
945+ VM.unsafeWrite mv 2 (toJSON c)
946+ VM.unsafeWrite mv 3 (toJSON d)
947+ VM.unsafeWrite mv 4 (toJSON e)
948+ VM.unsafeWrite mv 5 (toJSON f)
949+ VM.unsafeWrite mv 6 (toJSON g)
950+ VM.unsafeWrite mv 7 (toJSON h)
951+ return mv
952+ {-# INLINE toJSON #-}
953+
954+ toEncoding (a,b,c,d,e,f,g,h) = tuple $
955+ builder a >*<
956+ builder b >*<
957+ builder c >*<
958+ builder d >*<
959+ builder e >*<
960+ builder f >*<
961+ builder g >*<
962+ builder h
963+
964+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
965+ FromJSON f, FromJSON g, FromJSON h) =>
966+ FromJSON (a,b,c,d,e,f,g,h) where
967+ parseJSON = withArray "(a,b,c,d,e,f,g,h)" $ \ary ->
968+ let n = V.length ary
969+ in if n /= 8
970+ then fail $ "cannot unpack array of length " ++
971+ show n ++ " into an 8-tuple"
972+ else (,,,,,,,)
973+ <$> parseJSONElemAtIndex 0 ary
974+ <*> parseJSONElemAtIndex 1 ary
975+ <*> parseJSONElemAtIndex 2 ary
976+ <*> parseJSONElemAtIndex 3 ary
977+ <*> parseJSONElemAtIndex 4 ary
978+ <*> parseJSONElemAtIndex 5 ary
979+ <*> parseJSONElemAtIndex 6 ary
980+ <*> parseJSONElemAtIndex 7 ary
981+ {-# INLINE parseJSON #-}
982+
983+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
984+ ToJSON g, ToJSON h, ToJSON i) => ToJSON (a,b,c,d,e,f,g,h,i) where
985+ toJSON (a,b,c,d,e,f,g,h,i) = Array $ V.create $ do
986+ mv <- VM.unsafeNew 9
987+ VM.unsafeWrite mv 0 (toJSON a)
988+ VM.unsafeWrite mv 1 (toJSON b)
989+ VM.unsafeWrite mv 2 (toJSON c)
990+ VM.unsafeWrite mv 3 (toJSON d)
991+ VM.unsafeWrite mv 4 (toJSON e)
992+ VM.unsafeWrite mv 5 (toJSON f)
993+ VM.unsafeWrite mv 6 (toJSON g)
994+ VM.unsafeWrite mv 7 (toJSON h)
995+ VM.unsafeWrite mv 8 (toJSON i)
996+ return mv
997+ {-# INLINE toJSON #-}
998+
999+ toEncoding (a,b,c,d,e,f,g,h,i) = tuple $
1000+ builder a >*<
1001+ builder b >*<
1002+ builder c >*<
1003+ builder d >*<
1004+ builder e >*<
1005+ builder f >*<
1006+ builder g >*<
1007+ builder h >*<
1008+ builder i
1009+
1010+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1011+ FromJSON f, FromJSON g, FromJSON h, FromJSON i) =>
1012+ FromJSON (a,b,c,d,e,f,g,h,i) where
1013+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i)" $ \ary ->
1014+ let n = V.length ary
1015+ in if n /= 9
1016+ then fail $ "cannot unpack array of length " ++
1017+ show n ++ " into a 9-tuple"
1018+ else (,,,,,,,,)
1019+ <$> parseJSONElemAtIndex 0 ary
1020+ <*> parseJSONElemAtIndex 1 ary
1021+ <*> parseJSONElemAtIndex 2 ary
1022+ <*> parseJSONElemAtIndex 3 ary
1023+ <*> parseJSONElemAtIndex 4 ary
1024+ <*> parseJSONElemAtIndex 5 ary
1025+ <*> parseJSONElemAtIndex 6 ary
1026+ <*> parseJSONElemAtIndex 7 ary
1027+ <*> parseJSONElemAtIndex 8 ary
1028+ {-# INLINE parseJSON #-}
1029+
1030+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1031+ ToJSON g, ToJSON h, ToJSON i, ToJSON j) =>
1032+ ToJSON (a,b,c,d,e,f,g,h,i,j) where
1033+ toJSON (a,b,c,d,e,f,g,h,i,j) = Array $ V.create $ do
1034+ mv <- VM.unsafeNew 10
1035+ VM.unsafeWrite mv 0 (toJSON a)
1036+ VM.unsafeWrite mv 1 (toJSON b)
1037+ VM.unsafeWrite mv 2 (toJSON c)
1038+ VM.unsafeWrite mv 3 (toJSON d)
1039+ VM.unsafeWrite mv 4 (toJSON e)
1040+ VM.unsafeWrite mv 5 (toJSON f)
1041+ VM.unsafeWrite mv 6 (toJSON g)
1042+ VM.unsafeWrite mv 7 (toJSON h)
1043+ VM.unsafeWrite mv 8 (toJSON i)
1044+ VM.unsafeWrite mv 9 (toJSON j)
1045+ return mv
1046+ {-# INLINE toJSON #-}
1047+
1048+ toEncoding (a,b,c,d,e,f,g,h,i,j) = tuple $
1049+ builder a >*<
1050+ builder b >*<
1051+ builder c >*<
1052+ builder d >*<
1053+ builder e >*<
1054+ builder f >*<
1055+ builder g >*<
1056+ builder h >*<
1057+ builder i >*<
1058+ builder j
1059+
1060+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1061+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) =>
1062+ FromJSON (a,b,c,d,e,f,g,h,i,j) where
1063+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j)" $ \ary ->
1064+ let n = V.length ary
1065+ in if n /= 10
1066+ then fail $ "cannot unpack array of length " ++
1067+ show n ++ " into a 10-tuple"
1068+ else (,,,,,,,,,)
1069+ <$> parseJSONElemAtIndex 0 ary
1070+ <*> parseJSONElemAtIndex 1 ary
1071+ <*> parseJSONElemAtIndex 2 ary
1072+ <*> parseJSONElemAtIndex 3 ary
1073+ <*> parseJSONElemAtIndex 4 ary
1074+ <*> parseJSONElemAtIndex 5 ary
1075+ <*> parseJSONElemAtIndex 6 ary
1076+ <*> parseJSONElemAtIndex 7 ary
1077+ <*> parseJSONElemAtIndex 8 ary
1078+ <*> parseJSONElemAtIndex 9 ary
1079+ {-# INLINE parseJSON #-}
1080+
1081+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1082+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) =>
1083+ ToJSON (a,b,c,d,e,f,g,h,i,j,k) where
1084+ toJSON (a,b,c,d,e,f,g,h,i,j,k) = Array $ V.create $ do
1085+ mv <- VM.unsafeNew 11
1086+ VM.unsafeWrite mv 0 (toJSON a)
1087+ VM.unsafeWrite mv 1 (toJSON b)
1088+ VM.unsafeWrite mv 2 (toJSON c)
1089+ VM.unsafeWrite mv 3 (toJSON d)
1090+ VM.unsafeWrite mv 4 (toJSON e)
1091+ VM.unsafeWrite mv 5 (toJSON f)
1092+ VM.unsafeWrite mv 6 (toJSON g)
1093+ VM.unsafeWrite mv 7 (toJSON h)
1094+ VM.unsafeWrite mv 8 (toJSON i)
1095+ VM.unsafeWrite mv 9 (toJSON j)
1096+ VM.unsafeWrite mv 10 (toJSON k)
1097+ return mv
1098+ {-# INLINE toJSON #-}
1099+
1100+ toEncoding (a,b,c,d,e,f,g,h,i,j,k) = tuple $
1101+ builder a >*<
1102+ builder b >*<
1103+ builder c >*<
1104+ builder d >*<
1105+ builder e >*<
1106+ builder f >*<
1107+ builder g >*<
1108+ builder h >*<
1109+ builder i >*<
1110+ builder j >*<
1111+ builder k
1112+
1113+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1114+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1115+ FromJSON k) =>
1116+ FromJSON (a,b,c,d,e,f,g,h,i,j,k) where
1117+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k)" $ \ary ->
1118+ let n = V.length ary
1119+ in if n /= 11
1120+ then fail $ "cannot unpack array of length " ++
1121+ show n ++ " into an 11-tuple"
1122+ else (,,,,,,,,,,)
1123+ <$> parseJSONElemAtIndex 0 ary
1124+ <*> parseJSONElemAtIndex 1 ary
1125+ <*> parseJSONElemAtIndex 2 ary
1126+ <*> parseJSONElemAtIndex 3 ary
1127+ <*> parseJSONElemAtIndex 4 ary
1128+ <*> parseJSONElemAtIndex 5 ary
1129+ <*> parseJSONElemAtIndex 6 ary
1130+ <*> parseJSONElemAtIndex 7 ary
1131+ <*> parseJSONElemAtIndex 8 ary
1132+ <*> parseJSONElemAtIndex 9 ary
1133+ <*> parseJSONElemAtIndex 10 ary
1134+ {-# INLINE parseJSON #-}
1135+
1136+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1137+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) =>
1138+ ToJSON (a,b,c,d,e,f,g,h,i,j,k,l) where
1139+ toJSON (a,b,c,d,e,f,g,h,i,j,k,l) = Array $ V.create $ do
1140+ mv <- VM.unsafeNew 12
1141+ VM.unsafeWrite mv 0 (toJSON a)
1142+ VM.unsafeWrite mv 1 (toJSON b)
1143+ VM.unsafeWrite mv 2 (toJSON c)
1144+ VM.unsafeWrite mv 3 (toJSON d)
1145+ VM.unsafeWrite mv 4 (toJSON e)
1146+ VM.unsafeWrite mv 5 (toJSON f)
1147+ VM.unsafeWrite mv 6 (toJSON g)
1148+ VM.unsafeWrite mv 7 (toJSON h)
1149+ VM.unsafeWrite mv 8 (toJSON i)
1150+ VM.unsafeWrite mv 9 (toJSON j)
1151+ VM.unsafeWrite mv 10 (toJSON k)
1152+ VM.unsafeWrite mv 11 (toJSON l)
1153+ return mv
1154+ {-# INLINE toJSON #-}
1155+
1156+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l) = tuple $
1157+ builder a >*<
1158+ builder b >*<
1159+ builder c >*<
1160+ builder d >*<
1161+ builder e >*<
1162+ builder f >*<
1163+ builder g >*<
1164+ builder h >*<
1165+ builder i >*<
1166+ builder j >*<
1167+ builder k >*<
1168+ builder l
1169+
1170+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1171+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1172+ FromJSON k, FromJSON l) =>
1173+ FromJSON (a,b,c,d,e,f,g,h,i,j,k,l) where
1174+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l)" $ \ary ->
1175+ let n = V.length ary
1176+ in if n /= 12
1177+ then fail $ "cannot unpack array of length " ++
1178+ show n ++ " into a 12-tuple"
1179+ else (,,,,,,,,,,,)
1180+ <$> parseJSONElemAtIndex 0 ary
1181+ <*> parseJSONElemAtIndex 1 ary
1182+ <*> parseJSONElemAtIndex 2 ary
1183+ <*> parseJSONElemAtIndex 3 ary
1184+ <*> parseJSONElemAtIndex 4 ary
1185+ <*> parseJSONElemAtIndex 5 ary
1186+ <*> parseJSONElemAtIndex 6 ary
1187+ <*> parseJSONElemAtIndex 7 ary
1188+ <*> parseJSONElemAtIndex 8 ary
1189+ <*> parseJSONElemAtIndex 9 ary
1190+ <*> parseJSONElemAtIndex 10 ary
1191+ <*> parseJSONElemAtIndex 11 ary
1192+ {-# INLINE parseJSON #-}
1193+
1194+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1195+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1196+ ToJSON m) =>
1197+ ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) where
1198+ toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) = Array $ V.create $ do
1199+ mv <- VM.unsafeNew 13
1200+ VM.unsafeWrite mv 0 (toJSON a)
1201+ VM.unsafeWrite mv 1 (toJSON b)
1202+ VM.unsafeWrite mv 2 (toJSON c)
1203+ VM.unsafeWrite mv 3 (toJSON d)
1204+ VM.unsafeWrite mv 4 (toJSON e)
1205+ VM.unsafeWrite mv 5 (toJSON f)
1206+ VM.unsafeWrite mv 6 (toJSON g)
1207+ VM.unsafeWrite mv 7 (toJSON h)
1208+ VM.unsafeWrite mv 8 (toJSON i)
1209+ VM.unsafeWrite mv 9 (toJSON j)
1210+ VM.unsafeWrite mv 10 (toJSON k)
1211+ VM.unsafeWrite mv 11 (toJSON l)
1212+ VM.unsafeWrite mv 12 (toJSON m)
1213+ return mv
1214+ {-# INLINE toJSON #-}
1215+
1216+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m) = tuple $
1217+ builder a >*<
1218+ builder b >*<
1219+ builder c >*<
1220+ builder d >*<
1221+ builder e >*<
1222+ builder f >*<
1223+ builder g >*<
1224+ builder h >*<
1225+ builder i >*<
1226+ builder j >*<
1227+ builder k >*<
1228+ builder l >*<
1229+ builder m
1230+
1231+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1232+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1233+ FromJSON k, FromJSON l, FromJSON m) =>
1234+ FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) where
1235+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m)" $ \ary ->
1236+ let n = V.length ary
1237+ in if n /= 13
1238+ then fail $ "cannot unpack array of length " ++
1239+ show n ++ " into a 13-tuple"
1240+ else (,,,,,,,,,,,,)
1241+ <$> parseJSONElemAtIndex 0 ary
1242+ <*> parseJSONElemAtIndex 1 ary
1243+ <*> parseJSONElemAtIndex 2 ary
1244+ <*> parseJSONElemAtIndex 3 ary
1245+ <*> parseJSONElemAtIndex 4 ary
1246+ <*> parseJSONElemAtIndex 5 ary
1247+ <*> parseJSONElemAtIndex 6 ary
1248+ <*> parseJSONElemAtIndex 7 ary
1249+ <*> parseJSONElemAtIndex 8 ary
1250+ <*> parseJSONElemAtIndex 9 ary
1251+ <*> parseJSONElemAtIndex 10 ary
1252+ <*> parseJSONElemAtIndex 11 ary
1253+ <*> parseJSONElemAtIndex 12 ary
1254+ {-# INLINE parseJSON #-}
1255+
1256+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1257+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1258+ ToJSON m, ToJSON n) =>
1259+ ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
1260+ toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = Array $ V.create $ do
1261+ mv <- VM.unsafeNew 14
1262+ VM.unsafeWrite mv 0 (toJSON a)
1263+ VM.unsafeWrite mv 1 (toJSON b)
1264+ VM.unsafeWrite mv 2 (toJSON c)
1265+ VM.unsafeWrite mv 3 (toJSON d)
1266+ VM.unsafeWrite mv 4 (toJSON e)
1267+ VM.unsafeWrite mv 5 (toJSON f)
1268+ VM.unsafeWrite mv 6 (toJSON g)
1269+ VM.unsafeWrite mv 7 (toJSON h)
1270+ VM.unsafeWrite mv 8 (toJSON i)
1271+ VM.unsafeWrite mv 9 (toJSON j)
1272+ VM.unsafeWrite mv 10 (toJSON k)
1273+ VM.unsafeWrite mv 11 (toJSON l)
1274+ VM.unsafeWrite mv 12 (toJSON m)
1275+ VM.unsafeWrite mv 13 (toJSON n)
1276+ return mv
1277+ {-# INLINE toJSON #-}
1278+
1279+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = tuple $
1280+ builder a >*<
1281+ builder b >*<
1282+ builder c >*<
1283+ builder d >*<
1284+ builder e >*<
1285+ builder f >*<
1286+ builder g >*<
1287+ builder h >*<
1288+ builder i >*<
1289+ builder j >*<
1290+ builder k >*<
1291+ builder l >*<
1292+ builder m >*<
1293+ builder n
1294+
1295+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1296+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1297+ FromJSON k, FromJSON l, FromJSON m, FromJSON n) =>
1298+ FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
1299+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m,n)" $ \ary ->
1300+ let n = V.length ary
1301+ in if n /= 14
1302+ then fail $ "cannot unpack array of length " ++
1303+ show n ++ " into a 14-tuple"
1304+ else (,,,,,,,,,,,,,)
1305+ <$> parseJSONElemAtIndex 0 ary
1306+ <*> parseJSONElemAtIndex 1 ary
1307+ <*> parseJSONElemAtIndex 2 ary
1308+ <*> parseJSONElemAtIndex 3 ary
1309+ <*> parseJSONElemAtIndex 4 ary
1310+ <*> parseJSONElemAtIndex 5 ary
1311+ <*> parseJSONElemAtIndex 6 ary
1312+ <*> parseJSONElemAtIndex 7 ary
1313+ <*> parseJSONElemAtIndex 8 ary
1314+ <*> parseJSONElemAtIndex 9 ary
1315+ <*> parseJSONElemAtIndex 10 ary
1316+ <*> parseJSONElemAtIndex 11 ary
1317+ <*> parseJSONElemAtIndex 12 ary
1318+ <*> parseJSONElemAtIndex 13 ary
1319+ {-# INLINE parseJSON #-}
1320+
1321+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1322+ ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1323+ ToJSON m, ToJSON n, ToJSON o) =>
1324+ ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
1325+ toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = Array $ V.create $ do
1326+ mv <- VM.unsafeNew 15
1327+ VM.unsafeWrite mv 0 (toJSON a)
1328+ VM.unsafeWrite mv 1 (toJSON b)
1329+ VM.unsafeWrite mv 2 (toJSON c)
1330+ VM.unsafeWrite mv 3 (toJSON d)
1331+ VM.unsafeWrite mv 4 (toJSON e)
1332+ VM.unsafeWrite mv 5 (toJSON f)
1333+ VM.unsafeWrite mv 6 (toJSON g)
1334+ VM.unsafeWrite mv 7 (toJSON h)
1335+ VM.unsafeWrite mv 8 (toJSON i)
1336+ VM.unsafeWrite mv 9 (toJSON j)
1337+ VM.unsafeWrite mv 10 (toJSON k)
1338+ VM.unsafeWrite mv 11 (toJSON l)
1339+ VM.unsafeWrite mv 12 (toJSON m)
1340+ VM.unsafeWrite mv 13 (toJSON n)
1341+ VM.unsafeWrite mv 14 (toJSON o)
1342+ return mv
1343+ {-# INLINE toJSON #-}
1344+
1345+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = tuple $
1346+ builder a >*<
1347+ builder b >*<
1348+ builder c >*<
1349+ builder d >*<
1350+ builder e >*<
1351+ builder f >*<
1352+ builder g >*<
1353+ builder h >*<
1354+ builder i >*<
1355+ builder j >*<
1356+ builder k >*<
1357+ builder l >*<
1358+ builder m >*<
1359+ builder n >*<
1360+ builder o
1361+
1362+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1363+ FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1364+ FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) =>
1365+ FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
1366+ parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)" $ \ary ->
1367+ let n = V.length ary
1368+ in if n /= 15
1369+ then fail $ "cannot unpack array of length " ++
1370+ show n ++ " into a 15-tuple"
1371+ else (,,,,,,,,,,,,,,)
1372+ <$> parseJSONElemAtIndex 0 ary
1373+ <*> parseJSONElemAtIndex 1 ary
1374+ <*> parseJSONElemAtIndex 2 ary
1375+ <*> parseJSONElemAtIndex 3 ary
1376+ <*> parseJSONElemAtIndex 4 ary
1377+ <*> parseJSONElemAtIndex 5 ary
1378+ <*> parseJSONElemAtIndex 6 ary
1379+ <*> parseJSONElemAtIndex 7 ary
1380+ <*> parseJSONElemAtIndex 8 ary
1381+ <*> parseJSONElemAtIndex 9 ary
1382+ <*> parseJSONElemAtIndex 10 ary
1383+ <*> parseJSONElemAtIndex 11 ary
1384+ <*> parseJSONElemAtIndex 12 ary
1385+ <*> parseJSONElemAtIndex 13 ary
1386+ <*> parseJSONElemAtIndex 14 ary
1387+ {-# INLINE parseJSON #-}
1388+
1389+instance ToJSON a => ToJSON (Dual a) where
1390+ toJSON = toJSON . getDual
1391+ {-# INLINE toJSON #-}
1392+
1393+ toEncoding = toEncoding . getDual
1394+
1395+instance FromJSON a => FromJSON (Dual a) where
1396+ parseJSON = fmap Dual . parseJSON
1397+ {-# INLINE parseJSON #-}
1398+
1399+instance ToJSON a => ToJSON (First a) where
1400+ toJSON = toJSON . getFirst
1401+ {-# INLINE toJSON #-}
1402+
1403+ toEncoding = toEncoding . getFirst
1404+
1405+instance FromJSON a => FromJSON (First a) where
1406+ parseJSON = fmap First . parseJSON
1407+ {-# INLINE parseJSON #-}
1408+
1409+instance ToJSON a => ToJSON (Last a) where
1410+ toJSON = toJSON . getLast
1411+ {-# INLINE toJSON #-}
1412+
1413+ toEncoding = toEncoding . getLast
1414+
1415+instance FromJSON a => FromJSON (Last a) where
1416+ parseJSON = fmap Last . parseJSON
1417+ {-# INLINE parseJSON #-}
1418+
1419+-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@
1420+-- and fails using @'typeMismatch' expected@ otherwise.
1421+withObject :: String -> (Object -> Parser a) -> Value -> Parser a
1422+withObject _ f (Object obj) = f obj
1423+withObject expected _ v = typeMismatch expected v
1424+{-# INLINE withObject #-}
1425+
1426+-- | @withText expected f value@ applies @f@ to the 'Text' when @value@ is a @String@
1427+-- and fails using @'typeMismatch' expected@ otherwise.
1428+withText :: String -> (Text -> Parser a) -> Value -> Parser a
1429+withText _ f (String txt) = f txt
1430+withText expected _ v = typeMismatch expected v
1431+{-# INLINE withText #-}
1432+
1433+-- | @withArray expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@
1434+-- and fails using @'typeMismatch' expected@ otherwise.
1435+withArray :: String -> (Array -> Parser a) -> Value -> Parser a
1436+withArray _ f (Array arr) = f arr
1437+withArray expected _ v = typeMismatch expected v
1438+{-# INLINE withArray #-}
1439+
1440+-- | @withNumber expected f value@ applies @f@ to the 'Number' when @value@ is a 'Number'.
1441+-- and fails using @'typeMismatch' expected@ otherwise.
1442+withNumber :: String -> (Number -> Parser a) -> Value -> Parser a
1443+withNumber expected f = withScientific expected (f . scientificToNumber)
1444+{-# INLINE withNumber #-}
1445+{-# DEPRECATED withNumber "Use withScientific instead" #-}
1446+
1447+-- | @withScientific expected f value@ applies @f@ to the 'Scientific' number when @value@ is a 'Number'.
1448+-- and fails using @'typeMismatch' expected@ otherwise.
1449+withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
1450+withScientific _ f (Number scientific) = f scientific
1451+withScientific expected _ v = typeMismatch expected v
1452+{-# INLINE withScientific #-}
1453+
1454+-- | @withBool expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@
1455+-- and fails using @'typeMismatch' expected@ otherwise.
1456+withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
1457+withBool _ f (Bool arr) = f arr
1458+withBool expected _ v = typeMismatch expected v
1459+{-# INLINE withBool #-}
1460+
1461+instance KeyValue Pair where
1462+ name .= value = (name, toJSON value)
1463+ {-# INLINE (.=) #-}
1464+
1465+instance KeyValue Series where
1466+ name .= value = Value . Encoding $
1467+ E.text name <> B.char7 ':' <> builder value
1468+ {-# INLINE (.=) #-}
1469+
1470+series :: Series -> Encoding
1471+series Empty = mempty
1472+series (Value v) = v
1473+
1474+-- | Convert a value from JSON, failing if the types do not match.
1475+fromJSON :: (FromJSON a) => Value -> Result a
1476+fromJSON = parse parseJSON
1477+{-# INLINE fromJSON #-}
1478+
1479+-- | Retrieve the value associated with the given key of an 'Object'.
1480+-- The result is 'empty' if the key is not present or the value cannot
1481+-- be converted to the desired type.
1482+--
1483+-- This accessor is appropriate if the key and value /must/ be present
1484+-- in an object for it to be valid. If the key and value are
1485+-- optional, use '(.:?)' instead.
1486+(.:) :: (FromJSON a) => Object -> Text -> Parser a
1487+obj .: key = case H.lookup key obj of
1488+ Nothing -> fail $ "key " ++ show key ++ " not present"
1489+ Just v -> parseJSON v <?> Key key
1490+{-# INLINE (.:) #-}
1491+
1492+-- | Retrieve the value associated with the given key of an 'Object'.
1493+-- The result is 'Nothing' if the key is not present, or 'empty' if
1494+-- the value cannot be converted to the desired type.
1495+--
1496+-- This accessor is most useful if the key and value can be absent
1497+-- from an object without affecting its validity. If the key and
1498+-- value are mandatory, use '(.:)' instead.
1499+(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
1500+obj .:? key = case H.lookup key obj of
1501+ Nothing -> pure Nothing
1502+ Just v -> parseJSON v <?> Key key
1503+{-# INLINE (.:?) #-}
1504+
1505+-- | Helper for use in combination with '.:?' to provide default
1506+-- values for optional JSON object fields.
1507+--
1508+-- This combinator is most useful if the key and value can be absent
1509+-- from an object without affecting its validity and we know a default
1510+-- value to assign in that case. If the key and value are mandatory,
1511+-- use '(.:)' instead.
1512+--
1513+-- Example usage:
1514+--
1515+-- @ v1 <- o '.:?' \"opt_field_with_dfl\" .!= \"default_val\"
1516+-- v2 <- o '.:' \"mandatory_field\"
1517+-- v3 <- o '.:?' \"opt_field2\"
1518+-- @
1519+(.!=) :: Parser (Maybe a) -> a -> Parser a
1520+pmval .!= val = fromMaybe val <$> pmval
1521+{-# INLINE (.!=) #-}
1522+
1523+-- | Fail parsing due to a type mismatch, with a descriptive message.
1524+typeMismatch :: String -- ^ The name of the type you are trying to parse.
1525+ -> Value -- ^ The actual value encountered.
1526+ -> Parser a
1527+typeMismatch expected actual =
1528+ fail $ "when expecting a " ++ expected ++ ", encountered " ++ name ++
1529+ " instead"
1530+ where
1531+ name = case actual of
1532+ Object _ -> "Object"
1533+ Array _ -> "Array"
1534+ String _ -> "String"
1535+ Number _ -> "Number"
1536+ Bool _ -> "Boolean"
1537+ Null -> "Null"
1538+
1539+realFloatToJSON :: RealFloat a => a -> Value
1540+realFloatToJSON d
1541+ | isNaN d || isInfinite d = Null
1542+ | otherwise = Number $ Scientific.fromFloatDigits d
1543+{-# INLINE realFloatToJSON #-}
1544+
1545+realFloatToEncoding :: RealFloat a => a -> Encoding
1546+realFloatToEncoding d
1547+ | isNaN d || isInfinite d = Encoding E.null_
1548+ | otherwise = toEncoding (Scientific.fromFloatDigits d)
1549+{-# INLINE realFloatToEncoding #-}
1550+
1551+scientificToNumber :: Scientific -> Number
1552+scientificToNumber s
1553+ | e < 0 = D $ Scientific.toRealFloat s
1554+ | otherwise = I $ c * 10 ^ e
1555+ where
1556+ e = Scientific.base10Exponent s
1557+ c = Scientific.coefficient s
1558+{-# INLINE scientificToNumber #-}
1559+
1560+parseRealFloat :: RealFloat a => String -> Value -> Parser a
1561+parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
1562+parseRealFloat _ Null = pure (0/0)
1563+parseRealFloat expected v = typeMismatch expected v
1564+{-# INLINE parseRealFloat #-}
1565+
1566+parseIntegral :: Integral a => String -> Value -> Parser a
1567+parseIntegral expected = withScientific expected $ pure . floor
1568+{-# INLINE parseIntegral #-}
Data/Aeson/Types/Internal.hs+74−424
@@ -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-2015 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,90 +15,58 @@ 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(..)
28 , JSONPathElement(..)
42 , JSONPath
29 , JSONPath
43− , iparse
44 , parse
30 , parse
45 , parseEither
31 , parseEither
46 , parseMaybe
32 , parseMaybe
47 , modifyFailure
33 , modifyFailure
48− , prependFailure
49− , parserThrowError
50− , parserCatchError
51 , formatError
34 , formatError
52− , formatPath
53− , formatRelativePath
54 , (<?>)
35 , (<?>)
55 -- * Constructors and accessors
36 -- * Constructors and accessors
56 , object
37 , object
57
38
58 -- * Generic and TH encoding configuration
39 -- * Generic and TH encoding configuration
59− , Options(
40+ , Options(..)
60− fieldLabelModifier
61− , constructorTagModifier
62− , allNullaryToStringTag
63− , omitNothingFields
64− , sumEncoding
65− , unwrapUnaryRecords
66− , tagSingleConstructors
67− , rejectUnknownFields
68− )
69−
70 , SumEncoding(..)
41 , SumEncoding(..)
71− , JSONKeyOptions(keyModifier)
72 , defaultOptions
42 , defaultOptions
73 , defaultTaggedObject
43 , defaultTaggedObject
74− , defaultJSONKeyOptions
75
44
76 -- * Used for changing CamelCase names into something else.
45 -- * Used for changing CamelCase names into something else.
77 , camelTo
46 , camelTo
78− , camelTo2
79
47
80 -- * Other types
48 -- * Other types
81 , DotNetTime(..)
49 , DotNetTime(..)
82 ) where
50 ) where
83
51
84−import Prelude.Compat
85−
86−import Control.Applicative (Alternative(..))
52+import Control.Applicative
87−import Control.Arrow (first)
53+import Control.Monad
88import Control.DeepSeq (NFData(..))
54import Control.DeepSeq (NFData(..))
89−import Control.Monad (MonadPlus(..), ap)
55+import Data.ByteString.Builder (Builder, char7)
90−import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
56+import Data.Char (toLower, isUpper)
57+import Data.Scientific (Scientific)
58+import Data.Hashable (Hashable(..))
91import Data.Data (Data)
59import Data.Data (Data)
92−import Data.Foldable (foldl')
93import Data.HashMap.Strict (HashMap)
60import Data.HashMap.Strict (HashMap)
94−import Data.Hashable (Hashable(..))
61+import Data.Monoid (Monoid(..), (<>))
95−import Data.List (intercalate)
96−import Data.Scientific (Scientific)
97−import Data.Semigroup (Semigroup((<>)))
98import Data.String (IsString(..))
62import Data.String (IsString(..))
99import Data.Text (Text, pack, unpack)
63import Data.Text (Text, pack, unpack)
100import Data.Time (UTCTime)
64import Data.Time (UTCTime)
101import Data.Time.Format (FormatTime)
65import Data.Time.Format (FormatTime)
102import Data.Typeable (Typeable)
66import Data.Typeable (Typeable)
103import Data.Vector (Vector)
67import 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
68import qualified Data.HashMap.Strict as H
108−import qualified Data.Scientific as S
109import qualified Data.Vector as V
69import 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
70
116-- | Elements of a JSON path used to describe the location of an
71-- | Elements of a JSON path used to describe the location of an
117-- error.
72-- error.
@@ -121,16 +76,11 @@ data JSONPathElement = Key Text
121 | Index {-# UNPACK #-} !Int
76 | Index {-# UNPACK #-} !Int
122 -- ^ JSON path element of an index into an
77 -- ^ JSON path element of an index into an
123 -- array, \"array[index]\".
78 -- array, \"array[index]\".
124− deriving (Eq, Show, Typeable, Ord)
79+ deriving (Eq, Show, Typeable)
125type JSONPath = [JSONPathElement]
80type JSONPath = [JSONPathElement]
126
81
127−-- | The internal result of running a 'Parser'.
128−data IResult a = IError JSONPath String
129− | ISuccess a
130− deriving (Eq, Show, Typeable)
131−
132-- | The result of running a 'Parser'.
82-- | The result of running a 'Parser'.
133−data Result a = Error String
83+data Result a = Error JSONPath String
134 | Success a
84 | Success a
135 deriving (Eq, Show, Typeable)
85 deriving (Eq, Show, Typeable)
136
86
@@ -138,77 +88,28 @@ instance NFData JSONPathElement where
138 rnf (Key t) = rnf t
88 rnf (Key t) = rnf t
139 rnf (Index i) = rnf i
89 rnf (Index i) = rnf i
140
90
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
91instance (NFData a) => NFData (Result a) where
146 rnf (Success a) = rnf a
92 rnf (Success a) = rnf a
147− rnf (Error err) = rnf err
93+ rnf (Error path err) = rnf path `seq` rnf err
148−
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
94
154instance Functor Result where
95instance Functor Result where
155 fmap f (Success a) = Success (f a)
96 fmap f (Success a) = Success (f a)
156− fmap _ (Error err) = Error err
97+ fmap _ (Error path err) = Error path err
157 {-# INLINE fmap #-}
98 {-# INLINE fmap #-}
158
99
159−instance Monad.Monad IResult where
100+instance Monad Result where
160− return = pure
161− {-# 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
101+ return = Success
178 {-# INLINE return #-}
102 {-# INLINE return #-}
179−
180− Success a >>= k = k a
103+ Success a >>= k = k a
181− Error err >>= _ = Error err
104+ Error path err >>= _ = Error path err
182 {-# INLINE (>>=) #-}
105 {-# INLINE (>>=) #-}
183
106
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
107instance Applicative Result where
200− pure = Success
108+ pure = return
201 {-# INLINE pure #-}
109 {-# INLINE pure #-}
202 (<*>) = ap
110 (<*>) = ap
203 {-# INLINE (<*>) #-}
111 {-# INLINE (<*>) #-}
204
112
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
113instance MonadPlus Result where
213 mzero = fail "mzero"
114 mzero = fail "mzero"
214 {-# INLINE mzero #-}
115 {-# INLINE mzero #-}
@@ -216,74 +117,24 @@ instance MonadPlus Result where
216 mplus _ b = b
117 mplus _ b = b
217 {-# INLINE mplus #-}
118 {-# INLINE mplus #-}
218
119
219−instance Alternative IResult where
220− empty = mzero
221− {-# INLINE empty #-}
222− (<|>) = mplus
223− {-# INLINE (<|>) #-}
224−
225instance Alternative Result where
120instance Alternative Result where
226 empty = mzero
121 empty = mzero
227 {-# INLINE empty #-}
122 {-# INLINE empty #-}
228 (<|>) = mplus
123 (<|>) = mplus
229 {-# INLINE (<|>) #-}
124 {-# INLINE (<|>) #-}
230
125
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
126instance Monoid (Result a) where
246 mempty = fail "mempty"
127 mempty = fail "mempty"
247 {-# INLINE mempty #-}
128 {-# INLINE mempty #-}
248− mappend = (<>)
129+ mappend = mplus
249 {-# INLINE mappend #-}
130 {-# INLINE mappend #-}
250
131
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.
132-- | Failure continuation.
280type Failure f r = JSONPath -> String -> f r
133type Failure f r = JSONPath -> String -> f r
281-- | Success continuation.
134-- | Success continuation.
282type Success a f r = a -> f r
135type Success a f r = a -> f r
283
136
284−-- | A JSON parser. N.B. This might not fit your usual understanding of
137+-- | 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 {
138newtype Parser a = Parser {
288 runParser :: forall f r.
139 runParser :: forall f r.
289 JSONPath
140 JSONPath
@@ -292,19 +143,12 @@ newtype Parser a = Parser {
292 -> f r
143 -> f r
293 }
144 }
294
145
295−instance Monad.Monad Parser where
146+instance Monad Parser where
296 m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks
147 m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks
297 in runParser m path kf ks'
148 in runParser m path kf ks'
298 {-# INLINE (>>=) #-}
149 {-# INLINE (>>=) #-}
299− return = pure
150+ return a = Parser $ \_path _kf ks -> ks a
300 {-# INLINE return #-}
151 {-# 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
152 fail msg = Parser $ \path kf _ks -> kf (reverse path) msg
309 {-# INLINE fail #-}
153 {-# INLINE fail #-}
310
154
@@ -314,7 +158,7 @@ instance Functor Parser where
314 {-# INLINE fmap #-}
158 {-# INLINE fmap #-}
315
159
316instance Applicative Parser where
160instance Applicative Parser where
317− pure a = Parser $ \_path _kf ks -> ks a
161+ pure = return
318 {-# INLINE pure #-}
162 {-# INLINE pure #-}
319 (<*>) = apP
163 (<*>) = apP
320 {-# INLINE (<*>) #-}
164 {-# INLINE (<*>) #-}
@@ -332,20 +176,17 @@ instance MonadPlus Parser where
332 in runParser a path kf' ks
176 in runParser a path kf' ks
333 {-# INLINE mplus #-}
177 {-# INLINE mplus #-}
334
178
335−instance Semigroup (Parser a) where
336− (<>) = mplus
337− {-# INLINE (<>) #-}
338−
339instance Monoid (Parser a) where
179instance Monoid (Parser a) where
340 mempty = fail "mempty"
180 mempty = fail "mempty"
341 {-# INLINE mempty #-}
181 {-# INLINE mempty #-}
342− mappend = (<>)
182+ mappend = mplus
343 {-# INLINE mappend #-}
183 {-# INLINE mappend #-}
344
184
345apP :: Parser (a -> b) -> Parser a -> Parser b
185apP :: Parser (a -> b) -> Parser a -> Parser b
346apP d e = do
186apP d e = do
347 b <- d
187 b <- d
348− b <$> e
188+ a <- e
189+ return (b a)
349{-# INLINE apP #-}
190{-# INLINE apP #-}
350
191
351-- | A JSON \"object\" (key\/value map).
192-- | A JSON \"object\" (key\/value map).
@@ -361,11 +202,31 @@ data Value = Object !Object
361 | Number !Scientific
202 | Number !Scientific
362 | Bool !Bool
203 | Bool !Bool
363 | Null
204 | Null
364− deriving (Eq, Read, Show, Typeable, Data, Generic)
205+ deriving (Eq, Read, Show, Typeable, Data)
206+
207+-- | An encoding of a JSON value.
208+newtype Encoding = Encoding {
209+ fromEncoding :: Builder
210+ } deriving (Monoid)
211+
212+-- | A series of values that, when encoded, should be separated by commas.
213+data Series = Empty
214+ | Value Encoding
215+ deriving (Typeable)
216+
217+instance Monoid Series where
218+ mempty = Empty
219+
220+ mappend Empty a = a
221+ mappend (Value a) b =
222+ Value $
223+ a <> case b of
224+ Empty -> mempty
225+ Value c -> Encoding (char7 ',') <> c
226+ {-# INLINE mappend #-}
365
227
366-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
228-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
367−-- serialization format as Microsoft .NET, whose
229+-- 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:
230-- type is by default serialized to JSON as in the following example:
370--
231--
371-- > /Date(1302547608878)/
232-- > /Date(1302547608878)/
@@ -373,12 +234,11 @@ data Value = Object !Object
373-- The number represents milliseconds since the Unix epoch.
234-- The number represents milliseconds since the Unix epoch.
374newtype DotNetTime = DotNetTime {
235newtype DotNetTime = DotNetTime {
375 fromDotNetTime :: UTCTime
236 fromDotNetTime :: UTCTime
376− -- ^ Acquire the underlying value.
377 } deriving (Eq, Ord, Read, Show, Typeable, FormatTime)
237 } deriving (Eq, Ord, Read, Show, Typeable, FormatTime)
378
238
379instance NFData Value where
239instance NFData Value where
380 rnf (Object o) = rnf o
240 rnf (Object o) = rnf o
381− rnf (Array a) = foldl' (\x y -> rnf y `seq` x) () a
241+ rnf (Array a) = V.foldl' (\x y -> rnf y `seq` x) () a
382 rnf (String s) = rnf s
242 rnf (String s) = rnf s
383 rnf (Number n) = rnf n
243 rnf (Number n) = rnf n
384 rnf (Bool b) = rnf b
244 rnf (Bool b) = rnf b
@@ -389,15 +249,9 @@ instance IsString Value where
389 {-# INLINE fromString #-}
249 {-# INLINE fromString #-}
390
250
391hashValue :: Int -> Value -> Int
251hashValue :: 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
252+hashValue s (Object o) = H.foldl' hashWithSalt
396− (s `hashWithSalt` (0::Int)) assocHashesSorted
253+ (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
254+hashValue s (Array a) = V.foldl' hashWithSalt
401 (s `hashWithSalt` (1::Int)) a
255 (s `hashWithSalt` (1::Int)) a
402hashValue s (String str) = s `hashWithSalt` (2::Int) `hashWithSalt` str
256hashValue s (String str) = s `hashWithSalt` (2::Int) `hashWithSalt` str
403hashValue s (Number n) = s `hashWithSalt` (3::Int) `hashWithSalt` n
257hashValue s (Number n) = s `hashWithSalt` (3::Int) `hashWithSalt` n
@@ -407,21 +261,6 @@ hashValue s Null = s `hashWithSalt` (5::Int)
407instance Hashable Value where
261instance Hashable Value where
408 hashWithSalt = hashValue
262 hashWithSalt = hashValue
409
263
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.
264-- | The empty array.
426emptyArray :: Value
265emptyArray :: Value
427emptyArray = Array V.empty
266emptyArray = Array V.empty
@@ -438,63 +277,28 @@ emptyObject = Object H.empty
438
277
439-- | Run a 'Parser'.
278-- | Run a 'Parser'.
440parse :: (a -> Parser b) -> a -> Result b
279parse :: (a -> Parser b) -> a -> Result b
441−parse m v = runParser (m v) [] (const Error) Success
280+parse m v = runParser (m v) [] Error Success
442{-# INLINE parse #-}
281{-# INLINE parse #-}
443
282
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.
283-- | Run a 'Parser' with a 'Maybe' result type.
450parseMaybe :: (a -> Parser b) -> a -> Maybe b
284parseMaybe :: (a -> Parser b) -> a -> Maybe b
451parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just
285parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just
452{-# INLINE parseMaybe #-}
286{-# INLINE parseMaybe #-}
453
287
454−-- | Run a 'Parser' with an 'Either' result type. If the parse fails,
288+-- | 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
289parseEither :: (a -> Parser b) -> a -> Either String b
457−parseEither m v = runParser (m v) [] onError Right
458− where onError path msg = Left (formatError path msg)
290+parseEither m v = runParser (m v) [] (\path msg -> Left $ formatError path msg) Right
459{-# INLINE parseEither #-}
291{-# INLINE parseEither #-}
460
292
461−-- | Annotate an error message with a
293+-- | Annotate error message with JSON Path error location
462−-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.
463formatError :: JSONPath -> String -> String
294formatError :: JSONPath -> String -> String
464−formatError path msg = "Error in " ++ formatPath path ++ ": " ++ msg
295+formatError path msg = "Error in " ++ (formatJSONPath path) ++ ": " ++ msg
465−
296+ where formatJSONPath :: JSONPath -> String
466−-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String',
297+ formatJSONPath p = format "$" p
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
298+ where format :: String -> JSONPath -> String
477− format pfx [] = pfx
299+ format prefix [] = prefix
478− format pfx (Index idx:parts) = format (pfx ++ "[" ++ show idx ++ "]") parts
300+ format prefix (Index idx:parts) = format (prefix ++ "[" ++ show idx ++ "]") parts
479− format pfx (Key key:parts) = format (pfx ++ formatKey key) parts
301+ format prefix (Key key:parts) = format (prefix ++ "." ++ unpack 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
302
499-- | A key\/value pair for an 'Object'.
303-- | A key\/value pair for an 'Object'.
500type Pair = (Text, Value)
304type Pair = (Text, Value)
@@ -507,20 +311,19 @@ object = Object . H.fromList
507
311
508-- | Add JSON Path context to a parser
312-- | Add JSON Path context to a parser
509--
313--
510−-- When parsing a complex structure, it helps to annotate (sub)parsers
314+-- When parsing complex structure it helps to annotate (sub)parsers
511−-- with context, so that if an error occurs, you can find its location.
315+-- with context so that if error occurs you can find it's location.
512--
316--
513-- > withObject "Person" $ \o ->
317-- > withObject "Person" $ \o ->
514-- > Person
318-- > Person
515-- > <$> o .: "name" <?> Key "name"
319-- > <$> o .: "name" <?> Key "name"
516-- > <*> o .: "age" <?> Key "age"
320-- > <*> o .: "age" <?> Key "age"
517--
321--
518−-- (Standard methods like '(.:)' already do this.)
322+-- (except for standard methods like '(.:)' already do that)
519--
323--
520−-- With such annotations, if an error occurs, you will get a JSON Path
521−-- location of that error.
324+-- After that in case of error you will get a JSON Path location of that error.
522--
325--
523−-- Since 0.10
326+-- Since 0.9
524(<?>) :: Parser a -> JSONPathElement -> Parser a
327(<?>) :: Parser a -> JSONPathElement -> Parser a
525p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks
328p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks
526
329
@@ -534,40 +337,13 @@ p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks
534--
337--
535-- Since 0.6.2.0
338-- Since 0.6.2.0
536modifyFailure :: (String -> String) -> Parser a -> Parser a
339modifyFailure :: (String -> String) -> Parser a -> Parser a
537−modifyFailure f (Parser p) = Parser $ \path kf ks ->
340+modifyFailure f (Parser p) = Parser $ \path kf ks -> p path (\p' m -> kf p' (f m)) ks
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
341
563--------------------------------------------------------------------------------
342--------------------------------------------------------------------------------
564-- Generic and TH encoding configuration
343-- Generic and TH encoding configuration
565--------------------------------------------------------------------------------
344--------------------------------------------------------------------------------
566
345
567-- | Options that specify how to encode\/decode your datatype to\/from JSON.
346-- | 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
347data Options = Options
572 { fieldLabelModifier :: String -> String
348 { fieldLabelModifier :: String -> String
573 -- ^ Function applied to field labels.
349 -- ^ Function applied to field labels.
@@ -584,68 +360,13 @@ data Options = Options
584 -- ^ If 'True' record fields with a 'Nothing' value will be
360 -- ^ If 'True' record fields with a 'Nothing' value will be
585 -- omitted from the resulting object. If 'False' the resulting
361 -- omitted from the resulting object. If 'False' the resulting
586 -- object will include those fields mapping to @null@.
362 -- 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
363 , sumEncoding :: SumEncoding
621 -- ^ Specifies how to encode constructors of a sum datatype.
364 -- ^ Specifies how to encode constructors of a sum datatype.
622 , unwrapUnaryRecords :: Bool
365 , unwrapUnaryRecords :: Bool
623 -- ^ Hide the field name when a record constructor has only one
366 -- ^ Hide the field name when a record constructor has only one
624 -- field, like a newtype.
367 -- 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 }
368 }
633
369
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.
370-- | Specifies how to encode constructors of a sum datatype.
650data SumEncoding =
371data SumEncoding =
651 TaggedObject { tagFieldName :: String
372 TaggedObject { tagFieldName :: String
@@ -660,20 +381,6 @@ data SumEncoding =
660 -- by the encoded value of that field! If the constructor is not a
381 -- by the encoded value of that field! If the constructor is not a
661 -- record the encoded constructor contents will be stored under
382 -- record the encoded constructor contents will be stored under
662 -- the 'contentsFieldName' field.
383 -- 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
384 | ObjectWithSingleField
678 -- ^ A constructor will be encoded to an object with a single
385 -- ^ A constructor will be encoded to an object with a single
679 -- field named after the constructor tag (modified by the
386 -- field named after the constructor tag (modified by the
@@ -684,34 +391,6 @@ data SumEncoding =
684 -- first element is the tag of the constructor (modified by the
391 -- first element is the tag of the constructor (modified by the
685 -- 'constructorTagModifier') and the second element the encoded
392 -- 'constructorTagModifier') and the second element the encoded
686 -- contents of the constructor.
393 -- 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
394
716-- | Default encoding 'Options':
395-- | Default encoding 'Options':
717--
396--
@@ -722,9 +401,6 @@ data JSONKeyOptions = JSONKeyOptions
722-- , 'allNullaryToStringTag' = True
401-- , 'allNullaryToStringTag' = True
723-- , 'omitNothingFields' = False
402-- , 'omitNothingFields' = False
724-- , 'sumEncoding' = 'defaultTaggedObject'
403-- , 'sumEncoding' = 'defaultTaggedObject'
725−-- , 'unwrapUnaryRecords' = False
726−-- , 'tagSingleConstructors' = False
727−-- , 'rejectUnknownFields' = False
728-- }
404-- }
729-- @
405-- @
730defaultOptions :: Options
406defaultOptions :: Options
@@ -735,8 +411,6 @@ defaultOptions = Options
735 , omitNothingFields = False
411 , omitNothingFields = False
736 , sumEncoding = defaultTaggedObject
412 , sumEncoding = defaultTaggedObject
737 , unwrapUnaryRecords = False
413 , unwrapUnaryRecords = False
738− , tagSingleConstructors = False
739− , rejectUnknownFields = False
740 }
414 }
741
415
742-- | Default 'TaggedObject' 'SumEncoding' options:
416-- | Default 'TaggedObject' 'SumEncoding' options:
@@ -753,16 +427,6 @@ defaultTaggedObject = TaggedObject
753 , contentsFieldName = "contents"
427 , contentsFieldName = "contents"
754 }
428 }
755
429
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
430-- | Converts from CamelCase to another lower case, interspersing
767-- the character between all capital letters and their previous
431-- the character between all capital letters and their previous
768-- entries, except those capital letters that appear together,
432-- entries, except those capital letters that appear together,
@@ -772,7 +436,6 @@ defaultJSONKeyOptions = JSONKeyOptions id
772--
436--
773-- > camelTo '_' 'CamelCaseAPI' == "camel_case_api"
437-- > camelTo '_' 'CamelCaseAPI' == "camel_case_api"
774camelTo :: Char -> String -> String
438camelTo :: Char -> String -> String
775−{-# DEPRECATED camelTo "Use camelTo2 for better results" #-}
776camelTo c = lastWasCap True
439camelTo c = lastWasCap True
777 where
440 where
778 lastWasCap :: Bool -- ^ Previous was a capital letter
441 lastWasCap :: Bool -- ^ Previous was a capital letter
@@ -784,16 +447,3 @@ camelTo c = lastWasCap True
784 then toLower x : lastWasCap True xs
447 then toLower x : lastWasCap True xs
785 else c : toLower x : lastWasCap True xs
448 else c : toLower x : lastWasCap True xs
786 else x : lastWasCap False xs
449 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−184
@@ -1,16 +1,16 @@
1name: aeson
1name: aeson
2−version: 1.4.6.0
2+version: 0.10.0.0
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,155 @@ 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
68 benchmarks/Typed/*.hs
35 benchmarks/json-data/*.json
69 benchmarks/json-data/*.json
36− cbits/*.c
37 changelog.md
70 changelog.md
38 examples/*.cabal
71 examples/*.cabal
39 examples/*.hs
72 examples/*.hs
40 examples/Twitter/*.hs
73 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
74
48flag developer
75flag developer
49 description: operate in developer mode
76 description: operate in developer mode
50 default: False
77 default: False
51 manual: True
78 manual: True
52
79
53−flag fast
80+flag old-locale
54− description: compile without optimizations
81+ description: If false then depend on time >= 1.5.
55− default: False
82+ .
56− manual: True
83+ 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
84 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
85
68library
86library
69− default-language: Haskell2010
70− hs-source-dirs: . attoparsec-iso8601/
71−
72 exposed-modules:
87 exposed-modules:
73 Data.Aeson
88 Data.Aeson
74− Data.Aeson.Encoding
89+ Data.Aeson.Encode
75 Data.Aeson.Parser
90 Data.Aeson.Parser
76− Data.Aeson.Text
77 Data.Aeson.Types
91 Data.Aeson.Types
78 Data.Aeson.TH
92 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
93
90 other-modules:
94 other-modules:
91− Data.Aeson.Encoding.Builder
95+ Data.Aeson.Encode.ByteString
92− Data.Aeson.Internal.Functions
96+ Data.Aeson.Functions
93− Data.Aeson.Parser.Unescape
97+ 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
98 Data.Aeson.Types.Class
99+ Data.Aeson.Types.Generic
100+ Data.Aeson.Types.Instances
99 Data.Aeson.Types.Internal
101 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
102
114− if impl(ghc >= 8.0)
115− build-depends: bytestring >= 0.10.8.1
116−
117− -- Compat
118 build-depends:
103 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,
104+ attoparsec >= 0.13.0.0,
105+ base >= 4.5 && < 5,
106+ bytestring >= 0.10.4.0,
107+ containers,
108+ deepseq,
150− dlist >= 0.8.0.4 && < 0.9,
109+ dlist >= 0.2,
110+ ghc-prim >= 0.2,
151− hashable >= 1.2.7.0 && < 1.4,
111+ hashable >= 1.1.2.0,
112+ mtl,
152− scientific >= 0.3.6.2 && < 0.4,
113+ scientific >= 0.3.1 && < 0.4,
153− th-abstraction >= 0.2.8.0 && < 0.4,
114+ syb,
154− uuid-types >= 1.0.3 && < 1.1,
115+ template-haskell >= 2.4,
116+ text >= 1.1.1.0,
117+ transformers,
118+ unordered-containers >= 0.2.5.0,
155− vector >= 0.12.0.1 && < 0.13
119+ vector >= 0.7.1
156−
120+
157− ghc-options: -Wall
121+ if flag(old-locale)
122+ build-depends: time < 1.5, old-locale
123+ else
124+ build-depends: time >= 1.5
158
125
159 if flag(developer)
126 if flag(developer)
160 ghc-options: -Werror
127 ghc-options: -Werror
161 ghc-prof-options: -auto-all
128 ghc-prof-options: -auto-all
162
129
163− if flag(fast)
164− ghc-options: -O0
165− else
166− ghc-options: -O2
130+ 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
131
178test-suite tests
132test-suite tests
179− default-language: Haskell2010
180− type: exitcode-stdio-1.0
133+ type: exitcode-stdio-1.0
181− hs-source-dirs: tests ffi pure
134+ hs-source-dirs: tests
182− main-is: Tests.hs
135+ main-is: Properties.hs
183− c-sources: cbits/unescape_string.c
184− ghc-options: -Wall -threaded -rtsopts
185−
186 other-modules:
136 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
137 Encoders
194− ErrorMessages
195 Functions
138 Functions
196 Instances
139 Instances
197 Options
140 Options
198− PropUtils
199− Properties
141+ Properties.ZonedTime
200− PropertyGeneric
201− PropertyKeys
202− PropertyRoundTrip
203− PropertyRTFunctors
204− PropertyTH
205− SerializationFormatSpec
206 Types
142 Types
207− UnitTests
143+
208− UnitTests.NullaryConstructors
144+ ghc-options: -Wall -threaded -rtsopts
209
145
210 build-depends:
146 build-depends:
147+ HUnit,
211− QuickCheck >= 2.10.0.1 && < 2.14,
148+ QuickCheck >= 2.7,
212 aeson,
149 aeson,
213− integer-logarithms >= 1 && <1.1,
214 attoparsec,
150 attoparsec,
215 base,
151 base,
216− base-compat,
217− base-orphans >= 0.5.3 && <0.9,
218− base16-bytestring,
152+ bytestring,
219 containers,
153 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,
154 ghc-prim >= 0.2,
226− hashable >= 1.2.4.0,
227− scientific,
228− tagged,
229 template-haskell,
155 template-haskell,
230− tasty,
156+ test-framework,
231− tasty-golden,
157+ test-framework-hunit,
232− tasty-hunit,
158+ test-framework-quickcheck2,
233− tasty-quickcheck,
234 text,
159 text,
235 time,
160 time,
236− time-compat,
237 unordered-containers,
161 unordered-containers,
238− uuid-types,
239− vector,
162+ vector
240− quickcheck-instances >= 0.3.21 && <0.4
241
163
242− if flag(bytestring-builder)
164+ if flag(old-locale)
243− build-depends: bytestring >= 0.9 && < 0.10.4,
165+ build-depends: time < 1.5, old-locale
244− bytestring-builder >= 0.10.4 && < 1
245 else
166 else
246− build-depends: bytestring >= 0.10.4
167+ 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
168
264source-repository head
169source-repository head
265 type: git
170 type: git
266 location: git://github.com/bos/aeson.git
171 location: git://github.com/bos/aeson.git
172+
173+source-repository head
174+ type: mercurial
175+ 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+6−12
@@ -1,13 +1,7 @@
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
12import Data.Attoparsec.ByteString (IResult(..), parseWith)
6import Data.Attoparsec.ByteString (IResult(..), parseWith)
13import Data.Char (isDigit)
7import Data.Char (isDigit)
@@ -15,6 +9,7 @@ import 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+4−9
@@ -1,13 +1,8 @@
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
11import Data.Attoparsec.ByteString (IResult(..), parseWith)
6import Data.Attoparsec.ByteString (IResult(..), parseWith)
12import Data.Time.Clock
7import Data.Time.Clock
13import System.Environment (getArgs)
8import System.Environment (getArgs)
@@ -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.hs−7
@@ -1,9 +1,5 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3module Main (main) where
1module Main (main) where
4
2
5−import Prelude.Compat
6−
7import Criterion.Main
3import Criterion.Main
8import qualified Typed.Generic as Generic
4import qualified Typed.Generic as Generic
9import qualified Typed.Manual as Manual
5import qualified Typed.Manual as Manual
@@ -14,7 +10,4 @@ main = defaultMain [
14 Generic.benchmarks
10 Generic.benchmarks
15 , Manual.benchmarks
11 , Manual.benchmarks
16 , TH.benchmarks
12 , TH.benchmarks
17− , Generic.decodeBenchmarks
18− , Manual.decodeBenchmarks
19− , TH.decodeBenchmarks
20 ]
13 ]
benchmarks/Typed/Common.hs+3−9
@@ -1,16 +1,10 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−{-# OPTIONS_GHC -fno-warn-unused-imports #-}
4−
5module Typed.Common (load) where
1module Typed.Common (load) where
6
2
7−import Prelude.Compat
3+import Data.Aeson hiding (Result)
8−
9import Data.ByteString.Lazy as L
4import Data.ByteString.Lazy as L
10−import System.Exit
5+import Control.Applicative
11import System.IO
6import System.IO
12−
7+import System.Exit
13−import Data.Aeson hiding (Result)
14
8
15load :: FromJSON a => FilePath -> IO a
9load :: FromJSON a => FilePath -> IO a
16load fileName = do
10load fileName = do
benchmarks/Typed/Generic.hs+10−25
@@ -1,44 +1,29 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+module Typed.Generic (benchmarks) where
2
2
3−module Typed.Generic (benchmarks, decodeBenchmarks) where
3+import Control.Applicative
4−
5−import Prelude.Compat
6−
7−import Data.Aeson hiding (Result)
8import Criterion
4import Criterion
5+import Data.Aeson hiding (Result)
6+import Data.ByteString.Builder as B
9import Data.ByteString.Lazy as L
7import Data.ByteString.Lazy as L
10−import Twitter.Generic
8+import Twitter.TH
11import Typed.Common
9import Typed.Common
12
10
13encodeDirect :: Result -> L.ByteString
11encodeDirect :: Result -> L.ByteString
14−encodeDirect = encode
12+encodeDirect = B.toLazyByteString . fromEncoding . toEncoding
15
13
16encodeViaValue :: Result -> L.ByteString
14encodeViaValue :: Result -> L.ByteString
17−encodeViaValue = encode . toJSON
15+encodeViaValue = encode
18
16
19benchmarks :: Benchmark
17benchmarks :: Benchmark
20benchmarks =
18benchmarks =
21 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
19 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
22− bgroup "encodeGeneric" [
20+ bgroup "generic" [
23 bgroup "direct" [
21 bgroup "direct" [
24 bench "twitter100" $ nf encodeDirect twitter100
22 bench "twitter100" $ nf encodeDirect twitter100
25− , bench "jp100" $ nf encodeDirect jp100
23+ , bench "jp100" $ nf encodeDirect jp100
26 ]
24 ]
27 , bgroup "viaValue" [
25 , bgroup "viaValue" [
28 bench "twitter100" $ nf encodeViaValue twitter100
26 bench "twitter100" $ nf encodeViaValue twitter100
29− , bench "jp100" $ nf encodeViaValue jp100
27+ , 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 ]
28 ]
44 ]
29 ]
benchmarks/Typed/Manual.hs+9−24
@@ -1,44 +1,29 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+module Typed.Manual (benchmarks) where
2
2
3−module Typed.Manual (benchmarks, decodeBenchmarks) where
3+import Control.Applicative
4−
5−import Prelude.Compat
6−
7−import Data.Aeson hiding (Result)
8import Criterion
4import Criterion
5+import Data.Aeson hiding (Result)
6+import Data.ByteString.Builder as B
9import Data.ByteString.Lazy as L
7import Data.ByteString.Lazy as L
10import Twitter.Manual
8import Twitter.Manual
11import Typed.Common
9import Typed.Common
12
10
13encodeDirect :: Result -> L.ByteString
11encodeDirect :: Result -> L.ByteString
14−encodeDirect = encode
12+encodeDirect = B.toLazyByteString . fromEncoding . toEncoding
15
13
16encodeViaValue :: Result -> L.ByteString
14encodeViaValue :: Result -> L.ByteString
17−encodeViaValue = encode . toJSON
15+encodeViaValue = encode
18
16
19benchmarks :: Benchmark
17benchmarks :: Benchmark
20benchmarks =
18benchmarks =
21 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
19 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
22− bgroup "encodeManual" [
20+ bgroup "manual" [
23 bgroup "direct" [
21 bgroup "direct" [
24 bench "twitter100" $ nf encodeDirect twitter100
22 bench "twitter100" $ nf encodeDirect twitter100
25− , bench "jp100" $ nf encodeDirect jp100
23+ , bench "jp100" $ nf encodeDirect jp100
26 ]
24 ]
27 , bgroup "viaValue" [
25 , bgroup "viaValue" [
28 bench "twitter100" $ nf encodeViaValue twitter100
26 bench "twitter100" $ nf encodeViaValue twitter100
29− , bench "jp100" $ nf encodeViaValue jp100
27+ , 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 ]
28 ]
44 ]
29 ]
benchmarks/Typed/TH.hs+10−25
@@ -1,44 +1,29 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+module Typed.TH (benchmarks) where
2
2
3−module Typed.TH (benchmarks, decodeBenchmarks) where
3+import Control.Applicative
4−
5−import Prelude.Compat
6−
7−import Data.Aeson hiding (Result)
8import Criterion
4import Criterion
5+import Data.Aeson hiding (Result)
6+import Data.ByteString.Builder as B
9import Data.ByteString.Lazy as L
7import Data.ByteString.Lazy as L
10−import Twitter.TH
8+import Twitter.Generic
11import Typed.Common
9import Typed.Common
12
10
13encodeDirect :: Result -> L.ByteString
11encodeDirect :: Result -> L.ByteString
14−encodeDirect = encode
12+encodeDirect = B.toLazyByteString . fromEncoding . toEncoding
15
13
16encodeViaValue :: Result -> L.ByteString
14encodeViaValue :: Result -> L.ByteString
17−encodeViaValue = encode . toJSON
15+encodeViaValue = encode
18
16
19benchmarks :: Benchmark
17benchmarks :: Benchmark
20benchmarks =
18benchmarks =
21 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
19 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
22− bgroup "encodeTH" [
20+ bgroup "th" [
23 bgroup "direct" [
21 bgroup "direct" [
24 bench "twitter100" $ nf encodeDirect twitter100
22 bench "twitter100" $ nf encodeDirect twitter100
25− , bench "jp100" $ nf encodeDirect jp100
23+ , bench "jp100" $ nf encodeDirect jp100
26 ]
24 ]
27 , bgroup "viaValue" [
25 , bgroup "viaValue" [
28 bench "twitter100" $ nf encodeViaValue twitter100
26 bench "twitter100" $ nf encodeViaValue twitter100
29− , bench "jp100" $ nf encodeViaValue jp100
27+ , 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 ]
28 ]
44 ]
29 ]
benchmarks/aeson-benchmarks.cabal+44−275
@@ -1,240 +1,81 @@
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−
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
31
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:
32 build-depends:
163− aeson-benchmarks,
33+ attoparsec >= 0.13.0.0,
164− base,
165− base-compat,
34+ base == 4.*,
166− buffer-builder,
167− bytestring,
35+ bytestring >= 0.10.4.0,
168− criterion >= 1.0,
36+ containers,
169 deepseq,
37 deepseq,
38+ dlist >= 0.2,
170− 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,
171− text
45+ text >= 1.1.1.0,
46+ time,
47+ transformers,
48+ unordered-containers >= 0.2.3.0,
49+ vector >= 0.7.1
50+
51+ if flag(old-locale)
52+ build-depends: time < 1.5, old-locale
53+ else
54+ build-depends: time >= 1.5
172
55
173− if impl(ghc < 8.4)
56+ ghc-options: -O2 -Wall
174− other-modules:
57+ cpp-options: -DGENERICS
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:
188− aeson-benchmarks,
189− base,
190− base-compat,
191− bytestring,
192− criterion >= 1.0,
193− deepseq,
194− ghc-prim,
195− text
196
58
197executable aeson-benchmark-typed
59executable aeson-benchmark-typed
198− default-language: Haskell2010
199 main-is: Typed.hs
60 main-is: Typed.hs
200 hs-source-dirs: ../examples .
61 hs-source-dirs: ../examples .
201 ghc-options: -Wall -O2 -rtsopts
62 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:
63 build-depends:
213 aeson-benchmarks,
64 aeson-benchmarks,
214 base,
65 base,
215− base-compat,
66+ bytestring,
216 criterion >= 1.0,
67 criterion >= 1.0,
217 deepseq,
68 deepseq,
218 ghc-prim,
69 ghc-prim,
219 text,
70 text,
220 time
71 time
221
72
222− if flag(bytestring-builder)
223− build-depends: bytestring >= 0.9 && < 0.10.4,
224− bytestring-builder >= 0.10.4 && < 1
225− else
226− build-depends: bytestring >= 0.10.4
227− if impl(ghc < 8.0)
228− build-depends: semigroups
229−
230executable aeson-benchmark-compare-with-json
73executable aeson-benchmark-compare-with-json
231− default-language: Haskell2010
232 main-is: CompareWithJSON.hs
74 main-is: CompareWithJSON.hs
233 ghc-options: -Wall -O2 -rtsopts
75 ghc-options: -Wall -O2 -rtsopts
234 build-depends:
76 build-depends:
235 aeson-benchmarks,
77 aeson-benchmarks,
236 base,
78 base,
237− base-compat,
238 blaze-builder,
79 blaze-builder,
239 bytestring,
80 bytestring,
240 criterion,
81 criterion,
@@ -243,103 +84,31 @@ executable aeson-benchmark-compare-with-json
243 text
84 text
244
85
245executable aeson-benchmark-aeson-encode
86executable aeson-benchmark-aeson-encode
246− default-language: Haskell2010
247 main-is: AesonEncode.hs
87 main-is: AesonEncode.hs
248 ghc-options: -Wall -O2 -rtsopts
88 ghc-options: -Wall -O2 -rtsopts
249 build-depends:
89 build-depends:
250 aeson-benchmarks,
90 aeson-benchmarks,
251 attoparsec,
91 attoparsec,
252 base,
92 base,
253− base-compat,
254 bytestring,
93 bytestring,
255 deepseq,
94 deepseq,
256 time
95 time
257
96
258executable aeson-benchmark-aeson-parse
97executable aeson-benchmark-aeson-parse
259− default-language: Haskell2010
260 main-is: AesonParse.hs
98 main-is: AesonParse.hs
261 ghc-options: -Wall -O2 -rtsopts
99 ghc-options: -Wall -O2 -rtsopts
262 build-depends:
100 build-depends:
263 aeson-benchmarks,
101 aeson-benchmarks,
264 attoparsec,
102 attoparsec,
265 base,
103 base,
266− base-compat,
267 bytestring,
104 bytestring,
268 time
105 time
269
106
270executable aeson-benchmark-json-parse
107executable aeson-benchmark-json-parse
271− default-language: Haskell2010
272 main-is: JsonParse.hs
108 main-is: JsonParse.hs
273 ghc-options: -Wall -O2 -rtsopts
109 ghc-options: -Wall -O2 -rtsopts
274 build-depends:
110 build-depends:
275 base,
111 base,
276− base-compat,
277 deepseq,
112 deepseq,
278 json,
113 json,
279 time
114 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.

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+5−7

This diff is too big to show here.

examples/Simplest.hs+3−9

This diff is too big to show here.

examples/TemplateHaskell.hs+3−6

This diff is too big to show here.

examples/Twitter.hs+6−12

This diff is too big to show here.

examples/Twitter/Generic.hs+9−27

This diff is too big to show here.

examples/Twitter/Manual.hs+20−25

This diff is too big to show here.

examples/Twitter/Options.hsdeleted−10

This diff is too big to show here.

examples/Twitter/TH.hs+5−10

This diff is too big to show here.

examples/aeson-examples.cabal+2−3

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+22−333

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

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

This diff is too big to show here.

tests/PropUtils.hsdeleted−208

This diff is too big to show here.

tests/Properties.hs+203−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.