on 319ef69 help sign in
.gitattributesdeleted−1
since splitsnapshots
unifiedsplit
@@ -1 +0,0 @@
1−tests/JSONTestSuite/* linguist-vendored
.gitignore−11
@@ -1,21 +1,10 @@
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
7*.nix
13−*.swp
14−.\#*
15−\#*
16−
17−# Emacs backup files
18−*~
19
8
20benchmarks/AesonEncode
9benchmarks/AesonEncode
21
10
.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.yml+16−43
@@ -12,58 +12,31 @@ cache:
12 - $HOME/.stack
12 - $HOME/.stack
13 - $HOME/.cabsnap
13 - $HOME/.cabsnap
14 - $HOME/.cabal/packages
14 - $HOME/.cabal/packages
15− - $HOME/.cabal/store
16
15
17before_cache:
16before_cache:
18 - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
17 - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
19− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
18+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
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
19
25matrix:
20matrix:
26 include:
21 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
22+ - env: BUILD=cabal CABALVER=1.16 GHCVER=7.4.2
49− compiler: ": #GHC 8.4.4"
23+ compiler: ": #GHC 7.4.2"
50− addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.4], sources: [hvr-ghc]}}
24+ addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], 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
25+ - env: BUILD=cabal CABALVER=1.16 GHCVER=7.6.3
61− compiler: ": #GHC 7.10.3"
26+ compiler: ": #GHC 7.6.3"
62− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
27+ addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
63−
64 - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4
28 - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4
65 compiler: ": #GHC 7.8.4"
29 compiler: ": #GHC 7.8.4"
66 addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
30 addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
31+ - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2
32+ compiler: ": #GHC 7.10.2"
33+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
34+ - env: BUILD=cabal CABALVER=1.24 GHCVER=8.0.1
35+ compiler: ": #GHC 8.0.1"
36+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
37+ - env: BUILD=stack CABALVER=1.22 GHCVER=7.10.3
38+ compiler: ": #GHC 7.10.3"
39+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
67
40
68before_install:
41before_install:
69 - unset CC
42 - unset CC
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+15−99
@@ -1,4 +1,3 @@
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-2016 Bryan O'Sullivan
@@ -39,16 +38,11 @@ module Data.Aeson
39 , eitherDecode
38 , eitherDecode
40 , eitherDecode'
39 , eitherDecode'
41 , encode
40 , encode
42− , encodeFile
43 -- ** Variants for strict bytestrings
41 -- ** Variants for strict bytestrings
44 , decodeStrict
42 , decodeStrict
45− , decodeFileStrict
46 , decodeStrict'
43 , decodeStrict'
47− , decodeFileStrict'
48 , eitherDecodeStrict
44 , eitherDecodeStrict
49− , eitherDecodeFileStrict
50 , eitherDecodeStrict'
45 , eitherDecodeStrict'
51− , eitherDecodeFileStrict'
52 -- * Core JSON types
46 -- * Core JSON types
53 , Value(..)
47 , Value(..)
54 , Encoding
48 , Encoding
@@ -63,18 +57,11 @@ module Data.Aeson
63 , fromJSON
57 , fromJSON
64 , ToJSON(..)
58 , ToJSON(..)
65 , KeyValue(..)
59 , KeyValue(..)
66− , (<?>)
67− , JSONPath
68 -- ** Keys for maps
60 -- ** Keys for maps
69 , ToJSONKey(..)
61 , ToJSONKey(..)
70 , ToJSONKeyFunction(..)
62 , ToJSONKeyFunction(..)
71 , FromJSONKey(..)
63 , FromJSONKey(..)
72 , FromJSONKeyFunction(..)
64 , FromJSONKeyFunction(..)
73− -- *** Generic keys
74− , GToJSONKey()
75− , genericToJSONKey
76− , GFromJSONKey()
77− , genericFromJSONKey
78 -- ** Liftings to unary and binary type constructors
65 -- ** Liftings to unary and binary type constructors
79 , FromJSON1(..)
66 , FromJSON1(..)
80 , parseJSON1
67 , parseJSON1
@@ -88,46 +75,20 @@ module Data.Aeson
88 , toEncoding2
75 , toEncoding2
89 -- ** Generic JSON classes and options
76 -- ** Generic JSON classes and options
90 , GFromJSON(..)
77 , GFromJSON(..)
91− , FromArgs(..)
92− , GToJSON
78+ , GToJSON(..)
93− , GToEncoding
79+ , GToEncoding(..)
94− , ToArgs(..)
95− , Zero
96− , One
97 , genericToJSON
80 , genericToJSON
98− , genericLiftToJSON
99 , genericToEncoding
81 , genericToEncoding
100− , genericLiftToEncoding
101 , genericParseJSON
82 , genericParseJSON
102− , genericLiftParseJSON
103− -- ** Generic and TH encoding configuration
104− , Options
105 , defaultOptions
83 , 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
84
124 -- * Inspecting @'Value's@
85 -- * Inspecting @'Value's@
125 , withObject
86 , withObject
126 , withText
87 , withText
127 , withArray
88 , withArray
89+ , withNumber
128 , withScientific
90 , withScientific
129 , withBool
91 , withBool
130− , withEmbeddedJSON
131 -- * Constructors and accessors
92 -- * Constructors and accessors
132 , Series
93 , Series
133 , pairs
94 , pairs
@@ -140,29 +101,18 @@ module Data.Aeson
140 -- * Parsing
101 -- * Parsing
141 , json
102 , json
142 , json'
103 , json'
143− , parseIndexedJSON
144 ) where
104 ) where
145
105
146−import Prelude.Compat
106+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')
107+import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith,
108+ eitherDecodeWith, eitherDecodeStrictWith,
109+ jsonEOF, json, jsonEOF', json')
151import Data.Aeson.Types
110import Data.Aeson.Types
111+import Data.Aeson.Types.Instances (ifromJSON)
152−import Data.Aeson.Types.Internal (JSONPath, formatError, (<?>))
112+import Data.Aeson.Types.Internal (JSONPath, formatError)
153import qualified Data.ByteString as B
113import qualified Data.ByteString as B
154import qualified Data.ByteString.Lazy as L
114import qualified Data.ByteString.Lazy as L
155
115
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'.
116-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
167-- If this fails due to incomplete or invalid input, 'Nothing' is
117-- If this fails due to incomplete or invalid input, 'Nothing' is
168-- returned.
118-- returned.
@@ -189,18 +139,6 @@ decodeStrict :: (FromJSON a) => B.ByteString -> Maybe a
189decodeStrict = decodeStrictWith jsonEOF fromJSON
139decodeStrict = decodeStrictWith jsonEOF fromJSON
190{-# INLINE decodeStrict #-}
140{-# INLINE decodeStrict #-}
191
141
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'.
142-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
205-- If this fails due to incomplete or invalid input, 'Nothing' is
143-- If this fails due to incomplete or invalid input, 'Nothing' is
206-- returned.
144-- returned.
@@ -227,18 +165,6 @@ decodeStrict' :: (FromJSON a) => B.ByteString -> Maybe a
227decodeStrict' = decodeStrictWith jsonEOF' fromJSON
165decodeStrict' = decodeStrictWith jsonEOF' fromJSON
228{-# INLINE decodeStrict' #-}
166{-# INLINE decodeStrict' #-}
229
167
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
168eitherFormatError :: Either (JSONPath, String) a -> Either String a
243eitherFormatError = either (Left . uncurry formatError) Right
169eitherFormatError = either (Left . uncurry formatError) Right
244{-# INLINE eitherFormatError #-}
170{-# INLINE eitherFormatError #-}
@@ -254,12 +180,6 @@ eitherDecodeStrict =
254 eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON
180 eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON
255{-# INLINE eitherDecodeStrict #-}
181{-# INLINE eitherDecodeStrict #-}
256
182
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.
183-- | Like 'decode'' but returns an error message when decoding fails.
264eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
184eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
265eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' ifromJSON
185eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' ifromJSON
@@ -271,12 +191,6 @@ eitherDecodeStrict' =
271 eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON
191 eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON
272{-# INLINE eitherDecodeStrict' #-}
192{-# INLINE eitherDecodeStrict' #-}
273
193
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
194-- $use
281--
195--
282-- This section contains basic information on the different ways to
196-- This section contains basic information on the different ways to
@@ -346,9 +260,11 @@ eitherDecodeFileStrict' =
346-- > {-# LANGUAGE OverloadedStrings #-}
260-- > {-# LANGUAGE OverloadedStrings #-}
347-- >
261-- >
348-- > instance FromJSON Person where
262-- > instance FromJSON Person where
349−-- > parseJSON = withObject "Person" $ \v -> Person
263+-- > parseJSON (Object v) = Person <$>
350−-- > <$> v .: "name"
264+-- > v .: "name" <*>
351−-- > <*> v .: "age"
265+-- > v .: "age"
266+-- > -- A non-Object value is of the wrong type, so fail.
267+-- > parseJSON _ = empty
352--
268--
353-- We can now parse the JSON data like so:
269-- We can now parse the JSON data like so:
354--
270--
@@ -438,7 +354,7 @@ eitherDecodeFileStrict' =
438-- The 'Object' type contains JSON objects:
354-- The 'Object' type contains JSON objects:
439--
355--
440-- > λ> decode "{\"name\":\"Dave\",\"age\":2}" :: Maybe Object
356-- > λ> decode "{\"name\":\"Dave\",\"age\":2}" :: Maybe Object
441−-- > Just (fromList [("name",String "Dave"),("age",Number 2)])
357+-- > Just (fromList) [("name",String "Dave"),("age",Number 2)]
442--
358--
443-- You can extract values from it with a parser using 'parse',
359-- You can extract values from it with a parser using 'parse',
444-- 'parseEither' or, in this example, 'parseMaybe':
360-- 'parseEither' or, in this example, 'parseMaybe':
Data/Aeson/Encode.hs+84−15
@@ -1,4 +1,5 @@
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-2016 Bryan O'Sullivan
@@ -8,24 +9,92 @@
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.Encode.Builder (encodeToBuilder)
31+import Data.Aeson.Encode.Functions (encode)
32+import Data.Aeson.Types (Value(..))
33+import Data.Monoid ((<>))
34+import Data.Scientific (FPFormat(..), Scientific, base10Exponent)
35+import Data.Text.Lazy.Builder
36+import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
37+import Numeric (showHex)
38+import qualified Data.HashMap.Strict as H
39+import qualified Data.Text as T
40+import qualified Data.Vector as V
41+
42+-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
43+-- embedded efficiently in a text-based protocol.
44+--
45+-- If you are going to immediately encode straight to a
46+-- 'L.ByteString', it is more efficient to use 'encodeToBuilder'
47+-- instead.
48+encodeToTextBuilder :: Value -> Builder
49+encodeToTextBuilder =
50+ go
51+ where
52+ go Null = {-# SCC "go/Null" #-} "null"
53+ go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"
54+ go (Number s) = {-# SCC "go/Number" #-} fromScientific s
55+ go (String s) = {-# SCC "go/String" #-} string s
56+ go (Array v)
57+ | V.null v = {-# SCC "go/Array" #-} "[]"
58+ | otherwise = {-# SCC "go/Array" #-}
59+ singleton '[' <>
60+ go (V.unsafeHead v) <>
61+ V.foldr f (singleton ']') (V.unsafeTail v)
62+ where f a z = singleton ',' <> go a <> z
63+ go (Object m) = {-# SCC "go/Object" #-}
64+ case H.toList m of
65+ (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs
66+ _ -> "{}"
67+ where f a z = singleton ',' <> one a <> z
68+ one (k,v) = string k <> singleton ':' <> go v
69+
70+{-# DEPRECATED fromValue "Use 'encodeToTextBuilder' instead" #-}
71+fromValue :: Value -> Builder
72+fromValue = encodeToTextBuilder
19
73
20−import Data.ByteString.Lazy (ByteString)
74+string :: T.Text -> Builder
21−import Data.Text.Lazy.Builder (Builder)
75+string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'
22−import qualified Data.Aeson as A
76+ where
23−import qualified Data.Aeson.Text as A
77+ quote q = case T.uncons t of
78+ Nothing -> fromText h
79+ Just (!c,t') -> fromText h <> escape c <> quote t'
80+ where (h,t) = {-# SCC "break" #-} T.break isEscape q
81+ isEscape c = c == '\"' ||
82+ c == '\\' ||
83+ c < '\x20'
84+ escape '\"' = "\\\""
85+ escape '\\' = "\\\\"
86+ escape '\n' = "\\n"
87+ escape '\r' = "\\r"
88+ escape '\t' = "\\t"
24
89
25−encode :: A.ToJSON a => a -> ByteString
90+ escape c
26−encode = A.encode
91+ | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
27−{-# DEPRECATED encode "Use encode from Data.Aeson" #-}
92+ | otherwise = singleton c
93+ where h = showHex (fromEnum c) ""
28
94
29−encodeToTextBuilder :: A.Value -> Builder
95+fromScientific :: Scientific -> Builder
30−encodeToTextBuilder = A.encodeToTextBuilder
96+fromScientific s = formatScientificBuilder format prec s
31−{-# DEPRECATED encodeToTextBuilder "Use encodeTotextBuilder from Data.Aeson.Text" #-}
97+ where
98+ (format, prec)
99+ | base10Exponent s < 0 = (Generic, Nothing)
100+ | otherwise = (Fixed, Just 0)
Data/Aeson/Encoding/Builder.hs → Data/Aeson/Encode/Builder.hsrenamed+39−36
@@ -1,8 +1,7 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
2+
3−{-# LANGUAGE TupleSections #-}
4-- |
3-- |
5−-- Module: Data.Aeson.Encoding.Builder
4+-- Module: Data.Aeson.Encode.Builder
6-- Copyright: (c) 2011 MailRank, Inc.
5-- Copyright: (c) 2011 MailRank, Inc.
7-- (c) 2013 Simon Meier <iridcode@gmail.com>
6-- (c) 2013 Simon Meier <iridcode@gmail.com>
8-- License: BSD3
7-- License: BSD3
@@ -12,7 +11,7 @@
12--
11--
13-- Efficiently serialize a JSON value using the UTF-8 encoding.
12-- Efficiently serialize a JSON value using the UTF-8 encoding.
14
13
15−module Data.Aeson.Encoding.Builder
14+module Data.Aeson.Encode.Builder
16 (
15 (
17 encodeToBuilder
16 encodeToBuilder
18 , null_
17 , null_
@@ -25,7 +24,7 @@ module Data.Aeson.Encoding.Builder
25 , string
24 , string
26 , unquoted
25 , unquoted
27 , quote
26 , quote
28− , scientific
27+ , number
29 , day
28 , day
30 , localTime
29 , localTime
31 , utcTime
30 , utcTime
@@ -36,23 +35,21 @@ module Data.Aeson.Encoding.Builder
36 , ascii5
35 , ascii5
37 ) where
36 ) where
38
37
39−import Prelude.Compat
40−
41import Data.Aeson.Internal.Time
38import Data.Aeson.Internal.Time
42−import Data.Aeson.Types.Internal (Value (..))
39+import Data.Aeson.Types.Internal (Encoding(..), Value(..))
43import Data.ByteString.Builder as B
40import Data.ByteString.Builder as B
44import Data.ByteString.Builder.Prim as BP
41import Data.ByteString.Builder.Prim as BP
45import Data.ByteString.Builder.Scientific (scientificBuilder)
42import Data.ByteString.Builder.Scientific (scientificBuilder)
46import Data.Char (chr, ord)
43import Data.Char (chr, ord)
47−import Data.Semigroup ((<>))
44+import Data.Monoid ((<>))
48import Data.Scientific (Scientific, base10Exponent, coefficient)
45import Data.Scientific (Scientific, base10Exponent, coefficient)
49−import Data.Text.Encoding (encodeUtf8BuilderEscaped)
50import Data.Time (UTCTime(..))
46import Data.Time (UTCTime(..))
51import Data.Time.Calendar (Day(..), toGregorian)
47import Data.Time.Calendar (Day(..), toGregorian)
52import Data.Time.LocalTime
48import Data.Time.LocalTime
53import Data.Word (Word8)
49import Data.Word (Word8)
54import qualified Data.HashMap.Strict as HMS
50import qualified Data.HashMap.Strict as HMS
55import qualified Data.Text as T
51import qualified Data.Text as T
52+import qualified Data.Text.Encoding as TE
56import qualified Data.Vector as V
53import qualified Data.Vector as V
57
54
58-- | Encode a JSON value to a "Data.ByteString" 'B.Builder'.
55-- | Encode a JSON value to a "Data.ByteString" 'B.Builder'.
@@ -62,7 +59,7 @@ import qualified Data.Vector as V
62encodeToBuilder :: Value -> Builder
59encodeToBuilder :: Value -> Builder
63encodeToBuilder Null = null_
60encodeToBuilder Null = null_
64encodeToBuilder (Bool b) = bool b
61encodeToBuilder (Bool b) = bool b
65−encodeToBuilder (Number n) = scientific n
62+encodeToBuilder (Number n) = number n
66encodeToBuilder (String s) = text s
63encodeToBuilder (String s) = text s
67encodeToBuilder (Array v) = array v
64encodeToBuilder (Array v) = array v
68encodeToBuilder (Object m) = object m
65encodeToBuilder (Object m) = object m
@@ -79,7 +76,7 @@ bool = BP.primBounded (BP.condB id (ascii4 ('t',('r',('u','e'))))
79-- | Encode a JSON array.
76-- | Encode a JSON array.
80array :: V.Vector Value -> Builder
77array :: V.Vector Value -> Builder
81array v
78array v
82− | V.null v = emptyArray_
79+ | V.null v = emptyArray__
83 | otherwise = B.char8 '[' <>
80 | otherwise = B.char8 '[' <>
84 encodeToBuilder (V.unsafeHead v) <>
81 encodeToBuilder (V.unsafeHead v) <>
85 V.foldr withComma (B.char8 ']') (V.unsafeTail v)
82 V.foldr withComma (B.char8 ']') (V.unsafeTail v)
@@ -90,7 +87,7 @@ array v
90object :: HMS.HashMap T.Text Value -> Builder
87object :: HMS.HashMap T.Text Value -> Builder
91object m = case HMS.toList m of
88object m = case HMS.toList m of
92 (x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs
89 (x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs
93− _ -> emptyObject_
90+ _ -> emptyObject__
94 where
91 where
95 withComma a z = B.char8 ',' <> one a <> z
92 withComma a z = B.char8 ',' <> one a <> z
96 one (k,v) = text k <> B.char8 ':' <> encodeToBuilder v
93 one (k,v) = text k <> B.char8 ':' <> encodeToBuilder v
@@ -101,7 +98,7 @@ text t = B.char8 '"' <> unquoted t <> B.char8 '"'
101
98
102-- | Encode a JSON string, without enclosing quotes.
99-- | Encode a JSON string, without enclosing quotes.
103unquoted :: T.Text -> Builder
100unquoted :: T.Text -> Builder
104−unquoted = encodeUtf8BuilderEscaped escapeAscii
101+unquoted t = TE.encodeUtf8BuilderEscaped escapeAscii t
105
102
106-- | Add quotes surrounding a builder
103-- | Add quotes surrounding a builder
107quote :: Builder -> Builder
104quote :: Builder -> Builder
@@ -120,7 +117,7 @@ escapeAscii =
120 BP.condB (== c2w '\n' ) (ascii2 ('\\','n' )) $
117 BP.condB (== c2w '\n' ) (ascii2 ('\\','n' )) $
121 BP.condB (== c2w '\r' ) (ascii2 ('\\','r' )) $
118 BP.condB (== c2w '\r' ) (ascii2 ('\\','r' )) $
122 BP.condB (== c2w '\t' ) (ascii2 ('\\','t' )) $
119 BP.condB (== c2w '\t' ) (ascii2 ('\\','t' )) $
123− BP.liftFixedToBounded hexEscape -- fallback for chars < 0x20
120+ (BP.liftFixedToBounded hexEscape) -- fallback for chars < 0x20
124 where
121 where
125 hexEscape :: BP.FixedPrim Word8
122 hexEscape :: BP.FixedPrim Word8
126 hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<
123 hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<
@@ -131,41 +128,47 @@ c2w :: Char -> Word8
131c2w c = fromIntegral (ord c)
128c2w c = fromIntegral (ord c)
132
129
133-- | Encode a JSON number.
130-- | Encode a JSON number.
134−scientific :: Scientific -> Builder
131+number :: Scientific -> Builder
135−scientific s
132+number s
136− | e < 0 || e > 1024 = scientificBuilder s
133+ | e < 0 = scientificBuilder s
137 | otherwise = B.integerDec (coefficient s * 10 ^ e)
134 | otherwise = B.integerDec (coefficient s * 10 ^ e)
138 where
135 where
139 e = base10Exponent s
136 e = base10Exponent s
140
137
141−emptyArray_ :: Builder
138+emptyArray_ :: Encoding
139+emptyArray_ = Encoding emptyArray__
140+
141+emptyArray__ :: Builder
142−emptyArray_ = BP.primBounded (ascii2 ('[',']')) ()
142+emptyArray__ = BP.primBounded (ascii2 ('[',']')) ()
143+
144+emptyObject_ :: Encoding
145+emptyObject_ = Encoding emptyObject__
143
146
144−emptyObject_ :: Builder
147+emptyObject__ :: Builder
145−emptyObject_ = BP.primBounded (ascii2 ('{','}')) ()
148+emptyObject__ = BP.primBounded (ascii2 ('{','}')) ()
146
149
147ascii2 :: (Char, Char) -> BP.BoundedPrim a
150ascii2 :: (Char, Char) -> BP.BoundedPrim a
148−ascii2 cs = BP.liftFixedToBounded $ const cs BP.>$< BP.char7 >*< BP.char7
151+ascii2 cs = BP.liftFixedToBounded $ (const cs) BP.>$< BP.char7 >*< BP.char7
149{-# INLINE ascii2 #-}
152{-# INLINE ascii2 #-}
150
153
151ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a
154ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a
152−ascii4 cs = BP.liftFixedToBounded $ const cs >$<
155+ascii4 cs = BP.liftFixedToBounded $ (const cs) >$<
153 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
156 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
154{-# INLINE ascii4 #-}
157{-# INLINE ascii4 #-}
155
158
156ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a
159ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a
157−ascii5 cs = BP.liftFixedToBounded $ const cs >$<
160+ascii5 cs = BP.liftFixedToBounded $ (const cs) >$<
158 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
161 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
159{-# INLINE ascii5 #-}
162{-# INLINE ascii5 #-}
160
163
161ascii6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BP.BoundedPrim a
164ascii6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BP.BoundedPrim a
162−ascii6 cs = BP.liftFixedToBounded $ const cs >$<
165+ascii6 cs = BP.liftFixedToBounded $ (const cs) >$<
163 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
166 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
164{-# INLINE ascii6 #-}
167{-# INLINE ascii6 #-}
165
168
166ascii8 :: (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
169ascii8 :: (Char, (Char, (Char, (Char, (Char, (Char, (Char, Char)))))))
167 -> BP.BoundedPrim a
170 -> BP.BoundedPrim a
168−ascii8 cs = BP.liftFixedToBounded $ const cs >$<
171+ascii8 cs = BP.liftFixedToBounded $ (const cs) >$<
169 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*<
172 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*<
170 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
173 BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7
171{-# INLINE ascii8 #-}
174{-# INLINE ascii8 #-}
@@ -178,13 +181,12 @@ day dd = encodeYear yr <>
178 !(T dh dl) = twoDigits d
181 !(T dh dl) = twoDigits d
179 encodeYear y
182 encodeYear y
180 | y >= 1000 = B.integerDec y
183 | y >= 1000 = B.integerDec y
181− | y >= 0 = BP.primBounded (ascii4 (padYear y)) ()
184+ | y > 0 =
182− | y >= -999 = BP.primBounded (ascii5 ('-',padYear (- y))) ()
183− | otherwise = B.integerDec y
184− padYear y =
185− let (ab,c) = fromIntegral y `quotRem` 10
185+ let (ab,c) = fromIntegral y `quotRem` 10
186− (a,b) = ab `quotRem` 10
186+ (a,b) = ab `quotRem` 10
187− in ('0',(digit a,(digit b,digit c)))
187+ in BP.primBounded (ascii4 ('0',(digit a,(digit b,digit c)))) ()
188+ | otherwise =
189+ error "Data.Aeson.Encode.Builder.day: years BCE not supported"
188{-# INLINE day #-}
190{-# INLINE day #-}
189
191
190timeOfDay :: TimeOfDay -> Builder
192timeOfDay :: TimeOfDay -> Builder
@@ -201,7 +203,7 @@ timeOfDay64 (TOD h m s)
201 !(T mh ml) = twoDigits m
203 !(T mh ml) = twoDigits m
202 !(T sh sl) = twoDigits (fromIntegral real)
204 !(T sh sl) = twoDigits (fromIntegral real)
203 (real,frac) = s `quotRem` pico
205 (real,frac) = s `quotRem` pico
204− showFrac = ('.',) >$< (BP.liftFixedToBounded BP.char7 >*< trunc12)
206+ showFrac = (\x -> ('.', x)) >$< (BP.liftFixedToBounded BP.char7 >*< trunc12)
205 trunc12 = (`quotRem` micro) >$<
207 trunc12 = (`quotRem` micro) >$<
206 BP.condB (\(_,y) -> y == 0) (fst >$< trunc6) (digits6 >*< trunc6)
208 BP.condB (\(_,y) -> y == 0) (fst >$< trunc6) (digits6 >*< trunc6)
207 digits6 = ((`quotRem` milli) . fromIntegral) >$< (digits3 >*< digits3)
209 digits6 = ((`quotRem` milli) . fromIntegral) >$< (digits3 >*< digits3)
@@ -219,6 +221,7 @@ timeOfDay64 (TOD h m s)
219 pico = 1000000000000 -- number of picoseconds in 1 second
221 pico = 1000000000000 -- number of picoseconds in 1 second
220 micro = 1000000 -- number of microseconds in 1 second
222 micro = 1000000 -- number of microseconds in 1 second
221 milli = 1000 -- number of milliseconds in 1 second
223 milli = 1000 -- number of milliseconds in 1 second
224+{-# INLINE timeOfDay64 #-}
222
225
223timeZone :: TimeZone -> Builder
226timeZone :: TimeZone -> Builder
224timeZone (TimeZone off _ _)
227timeZone (TimeZone off _ _)
Data/Aeson/Encode/Functions.hsnew file+79
@@ -0,0 +1,79 @@
1+{-# LANGUAGE CPP #-}
2+
3+module Data.Aeson.Encode.Functions
4+ (
5+ brackets
6+ , builder
7+ , builder'
8+ , char7
9+ , encode
10+ , list
11+ , encodeMap
12+ , encodeWithKey
13+ ) where
14+
15+import Data.Aeson.Encode.Builder
16+import Data.Aeson.Types.Class
17+import Data.Aeson.Types.Internal
18+import Data.ByteString.Builder (Builder, char7)
19+import Data.ByteString.Builder.Prim (primBounded)
20+import Data.Foldable (toList)
21+import Data.Monoid ((<>))
22+import qualified Data.ByteString.Builder as B
23+import qualified Data.ByteString.Lazy as L
24+
25+#if !MIN_VERSION_base(4,8,0)
26+import Data.Foldable (Foldable, foldMap)
27+import Data.Monoid (mempty)
28+#endif
29+
30+list :: (a -> Encoding) -> [a] -> Encoding
31+list = listEncoding
32+
33+builder :: ToJSON a => a -> Builder
34+builder = fromEncoding . toEncoding
35+{-# INLINE builder #-}
36+
37+builder' :: (a -> Encoding) -> a -> Builder
38+builder' f = fromEncoding . f
39+{-# INLINE builder' #-}
40+
41+-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
42+--
43+-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.
44+encode :: ToJSON a => a -> L.ByteString
45+encode = B.toLazyByteString . builder
46+{-# INLINE encode #-}
47+
48+brackets :: Char -> Char -> Series -> Encoding
49+brackets begin end (Value v) = Encoding $
50+ char7 begin <> fromEncoding v <> char7 end
51+brackets begin end Empty = Encoding (primBounded (ascii2 (begin,end)) ())
52+
53+
54+
55+encodeMap :: (k -> Encoding)
56+ -> (v -> Encoding)
57+ -> (m -> Maybe ((k,v), m))
58+ -> ((k -> v -> B.Builder -> B.Builder) -> B.Builder -> m -> B.Builder)
59+ -> m -> Encoding
60+encodeMap encodeKey encodeVal minViewWithKey foldrWithKey xs =
61+ case minViewWithKey xs of
62+ Nothing -> Encoding $ primBounded (ascii2 ('{', '}')) ()
63+ Just ((k,v),ys) -> Encoding $
64+ B.char7 '{' <> encodeKV encodeKey encodeVal k v <>
65+ foldrWithKey go (B.char7 '}') ys
66+ where go k v b = B.char7 ',' <> encodeKV encodeKey encodeVal k v <> b
67+{-# INLINE encodeMap #-}
68+
69+encodeWithKey :: (k -> Encoding)
70+ -> (v -> Encoding)
71+ -> ((k -> v -> Series -> Series) -> Series -> m -> Series)
72+ -> m -> Encoding
73+encodeWithKey encodeKey encodeVal foldrWithKey = brackets '{' '}' . foldrWithKey go mempty
74+ where go k v c = Value (Encoding $ encodeKV encodeKey encodeVal k v) <> c
75+{-# INLINE encodeWithKey #-}
76+
77+encodeKV :: (k -> Encoding) -> (v -> Encoding) -> k -> v -> B.Builder
78+encodeKV encodeKey encodeVal k v = fromEncoding (encodeKey k) <> B.char7 ':' <> builder' encodeVal v
79+{-# INLINE encodeKV #-}
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/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+9−6
@@ -1,4 +1,3 @@
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-2016 Bryan O'Sullivan
@@ -8,15 +7,13 @@
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.hs+1−3
@@ -1,4 +1,3 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2-- |
1-- |
3-- Module: Data.Aeson.Internal
2-- Module: Data.Aeson.Internal
4-- Copyright: (c) 2015-2016 Bryan O'Sullivan
3-- Copyright: (c) 2015-2016 Bryan O'Sullivan
@@ -23,6 +22,5 @@ module Data.Aeson.Internal
23 , iparse
22 , iparse
24 ) where
23 ) where
25
24
26−
25+import Data.Aeson.Types.Instances (ifromJSON)
27import Data.Aeson.Types.Internal
26import Data.Aeson.Types.Internal
28−import Data.Aeson.Types.FromJSON (ifromJSON)
Data/Aeson/Internal/Time.hs+38−1
@@ -17,4 +17,41 @@ module Data.Aeson.Internal.Time
17 , toTimeOfDay64
17 , toTimeOfDay64
18 ) where
18 ) where
19
19
20−import Data.Attoparsec.Time.Internal
20+import Data.Fixed (Pico)
21+import Data.Int (Int64)
22+import Data.Time
23+import Unsafe.Coerce (unsafeCoerce)
24+
25+#if MIN_VERSION_base(4,7,0)
26+
27+import Data.Fixed (Fixed(MkFixed))
28+
29+toPico :: Integer -> Pico
30+toPico = MkFixed
31+
32+fromPico :: Pico -> Integer
33+fromPico (MkFixed i) = i
34+
35+#else
36+
37+toPico :: Integer -> Pico
38+toPico = unsafeCoerce
39+
40+fromPico :: Pico -> Integer
41+fromPico = unsafeCoerce
42+
43+#endif
44+
45+-- | Like TimeOfDay, but using a fixed-width integer for seconds.
46+data TimeOfDay64 = TOD {-# UNPACK #-} !Int
47+ {-# UNPACK #-} !Int
48+ {-# UNPACK #-} !Int64
49+
50+diffTimeOfDay64 :: DiffTime -> TimeOfDay64
51+diffTimeOfDay64 t = TOD (fromIntegral h) (fromIntegral m) s
52+ where (h,mp) = fromIntegral pico `quotRem` 3600000000000000
53+ (m,s) = mp `quotRem` 60000000000000
54+ pico = unsafeCoerce t :: Integer
55+
56+toTimeOfDay64 :: TimeOfDay -> TimeOfDay64
57+toTimeOfDay64 (TimeOfDay h m s) = TOD h m (fromIntegral (fromPico s))
Data/Aeson/Parser.hs+5−14
@@ -1,4 +1,5 @@
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-2016 Bryan O'Sullivan
@@ -34,21 +35,10 @@ 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
42 -- * Decoding without FromJSON instances
53 , decodeWith
43 , decodeWith
54 , decodeStrictWith
44 , decodeStrictWith
@@ -56,8 +46,9 @@ module Data.Aeson.Parser
56 , eitherDecodeStrictWith
46 , eitherDecodeStrictWith
57 ) where
47 ) where
58
48
59−
60−import Data.Aeson.Parser.Internal
49+import Data.Aeson.Parser.Internal (decodeStrictWith, decodeWith,
50+ eitherDecodeStrictWith, eitherDecodeWith,
51+ json, json', jstring, value, value')
61
52
62-- $lazy
53-- $lazy
63--
54--
Data/Aeson/Parser/Internal.hs+198−325
@@ -1,14 +1,8 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4−{-# LANGUAGE OverloadedStrings #-}
5#if MIN_VERSION_ghc_prim(0,3,1)
2#if MIN_VERSION_ghc_prim(0,3,1)
6{-# LANGUAGE MagicHash #-}
3{-# LANGUAGE MagicHash #-}
7#endif
4#endif
8−#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706
5+
9−-- Work around a compiler bug
10−{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}
11−#endif
12-- |
6-- |
13-- Module: Data.Aeson.Parser.Internal
7-- Module: Data.Aeson.Parser.Internal
14-- Copyright: (c) 2011-2016 Bryan O'Sullivan
8-- Copyright: (c) 2011-2016 Bryan O'Sullivan
@@ -25,56 +19,52 @@ module Data.Aeson.Parser.Internal
25 (
19 (
26 -- * Lazy parsers
20 -- * Lazy parsers
27 json, jsonEOF
21 json, jsonEOF
28− , jsonWith
29− , jsonLast
30− , jsonAccum
31− , jsonNoDup
32 , value
22 , value
33 , jstring
23 , jstring
34− , jstring_
35− , scientific
36 -- * Strict parsers
24 -- * Strict parsers
37 , json', jsonEOF'
25 , json', jsonEOF'
38− , jsonWith'
39− , jsonLast'
40− , jsonAccum'
41− , jsonNoDup'
42 , value'
26 , value'
43 -- * Helpers
27 -- * Helpers
44 , decodeWith
28 , decodeWith
45 , decodeStrictWith
29 , decodeStrictWith
46 , eitherDecodeWith
30 , eitherDecodeWith
47 , eitherDecodeStrictWith
31 , eitherDecodeStrictWith
48− -- ** Handling objects with duplicate keys
49− , fromListAccum
50− , parseListNoDup
51 ) where
32 ) where
52
33
53−import Prelude.Compat
54−
55−import Control.Applicative ((<|>))
56−import Control.Monad (void, when)
34+import Control.Monad.IO.Class (liftIO)
57−import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Value(..))
35+import Data.Aeson.Types.Internal (IResult(..), JSONPath, Result(..), Value(..))
58−import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
36+import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,
37+ skipSpace, string)
59−import Data.Function (fix)
38+import Data.Bits ((.|.), shiftL)
60−import Data.Functor.Compat (($>))
39+import Data.ByteString.Internal (ByteString(..))
61−import Data.Scientific (Scientific)
40+import Data.Char (chr)
62import Data.Text (Text)
41import Data.Text (Text)
63−import Data.Vector (Vector)
42+import Data.Text.Encoding (decodeUtf8')
43+import Data.Text.Internal.Encoding.Utf8 (ord2, ord3, ord4)
44+import Data.Text.Internal.Unsafe.Char (ord)
64−import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
45+import Data.Vector as Vector (Vector, empty, fromList, reverse)
46+import Data.Word (Word8)
47+import Foreign.ForeignPtr (withForeignPtr)
48+import Foreign.Ptr (Ptr, plusPtr)
49+import Foreign.Ptr (minusPtr)
50+import Foreign.Storable (poke)
51+import System.IO.Unsafe (unsafePerformIO)
65import qualified Data.Attoparsec.ByteString as A
52import qualified Data.Attoparsec.ByteString as A
66import qualified Data.Attoparsec.Lazy as L
53import qualified Data.Attoparsec.Lazy as L
54+import qualified Data.Attoparsec.Zepto as Z
67import qualified Data.ByteString as B
55import qualified Data.ByteString as B
68−import qualified Data.ByteString.Unsafe as B
56+import qualified Data.ByteString.Internal as B
69import qualified Data.ByteString.Lazy as L
57import qualified Data.ByteString.Lazy as L
58+import qualified Data.ByteString.Unsafe as B
70import qualified Data.HashMap.Strict as H
59import qualified Data.HashMap.Strict as H
71−import qualified Data.Scientific as Sci
60+
72−import Data.Aeson.Parser.Unescape (unescapeText)
61+#if !MIN_VERSION_base(4,8,0)
62+import Control.Applicative ((*>), (<$>), (<*), pure)
63+#endif
73
64
74#if MIN_VERSION_ghc_prim(0,3,1)
65#if MIN_VERSION_ghc_prim(0,3,1)
75−import GHC.Base (Int#, (==#), isTrue#, word2Int#, orI#, andI#)
66+import GHC.Base (Int#, (==#), isTrue#, orI#, word2Int#)
76import GHC.Word (Word8(W8#))
67import GHC.Word (Word8(W8#))
77−import qualified Data.Text.Encoding as TE
78#endif
68#endif
79
69
80#define BACKSLASH 92
70#define BACKSLASH 92
@@ -93,7 +83,7 @@ import qualified Data.Text.Encoding as TE
93#define C_n 110
83#define C_n 110
94#define C_t 116
84#define C_t 116
95
85
96−-- | Parse any JSON value.
86+-- | Parse a top-level JSON value.
97--
87--
98-- The conversion of a parsed value to a Haskell value is deferred
88-- The conversion of a parsed value to a Haskell value is deferred
99-- until the Haskell value is needed. This may improve performance if
89-- until the Haskell value is needed. This may improve performance if
@@ -103,15 +93,10 @@ import qualified Data.Text.Encoding as TE
103-- This function is an alias for 'value'. In aeson 0.8 and earlier, it
93-- 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
94-- parsed only object or array types, in conformance with the
105-- now-obsolete RFC 4627.
95-- 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
96json :: Parser Value
112json = value
97json = value
113
98
114−-- | Parse any JSON value.
99+-- | Parse a top-level JSON value.
115--
100--
116-- This is a strict version of 'json' which avoids building up thunks
101-- This is a strict version of 'json' which avoids building up thunks
117-- during parsing; it performs all conversions immediately. Prefer
102-- during parsing; it performs all conversions immediately. Prefer
@@ -120,64 +105,46 @@ json = value
120-- This function is an alias for 'value''. In aeson 0.8 and earlier, it
105-- 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
106-- parsed only object or array types, in conformance with the
122-- now-obsolete RFC 4627.
107-- 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
108json' :: Parser Value
129json' = value'
109json' = value'
130
110
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
111+object_ :: Parser Value
136−object_ mkObject val = {-# SCC "object_" #-} Object <$> objectValues mkObject jstring val
112+object_ = {-# SCC "object_" #-} Object <$> objectValues jstring value
137−{-# INLINE object_ #-}
138
113
139−object_' :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value
114+object_' :: Parser Value
140−object_' mkObject val' = {-# SCC "object_'" #-} do
115+object_' = {-# SCC "object_'" #-} do
141− !vals <- objectValues mkObject jstring' val'
116+ !vals <- objectValues jstring' value'
142 return (Object vals)
117 return (Object vals)
143 where
118 where
144 jstring' = do
119 jstring' = do
145 !s <- jstring
120 !s <- jstring
146 return s
121 return s
147−{-# INLINE object_' #-}
148
122
149−objectValues :: ([(Text, Value)] -> Either String Object)
150− -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)
123+objectValues :: Parser Text -> Parser Value -> Parser (H.HashMap Text Value)
151−objectValues mkObject str val = do
124+objectValues str val = do
152 skipSpace
125 skipSpace
153 w <- A.peekWord8'
126 w <- A.peekWord8'
154 if w == CLOSE_CURLY
127 if w == CLOSE_CURLY
155 then A.anyWord8 >> return H.empty
128 then A.anyWord8 >> return H.empty
156− else loop []
129+ else loop H.empty
157 where
130 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
131+ loop m0 = do
161− k <- (str A.<?> "object key") <* skipSpace <* (char ':' A.<?> "':'")
132+ k <- str <* skipSpace <* char ':'
162− v <- (val A.<?> "object value") <* skipSpace
133+ v <- val <* skipSpace
134+ let !m = H.insert k v m0
163− ch <- A.satisfy (\w -> w == COMMA || w == CLOSE_CURLY) A.<?> "',' or '}'"
135+ ch <- A.satisfy $ \w -> w == COMMA || w == CLOSE_CURLY
164− let acc' = (k, v) : acc
165 if ch == COMMA
136 if ch == COMMA
166− then skipSpace >> loop acc'
137+ then skipSpace >> loop m
167− else case mkObject acc' of
138+ else return m
168− Left err -> fail err
169− Right obj -> pure obj
170{-# INLINE objectValues #-}
139{-# INLINE objectValues #-}
171
140
172−array_ :: Parser Value -> Parser Value
141+array_ :: Parser Value
173−array_ val = {-# SCC "array_" #-} Array <$> arrayValues val
142+array_ = {-# SCC "array_" #-} Array <$> arrayValues value
174−{-# INLINE array_ #-}
175
143
176−array_' :: Parser Value -> Parser Value
144+array_' :: Parser Value
177−array_' val = {-# SCC "array_'" #-} do
145+array_' = {-# SCC "array_'" #-} do
178− !vals <- arrayValues val
146+ !vals <- arrayValues value'
179 return (Array vals)
147 return (Array vals)
180−{-# INLINE array_' #-}
181
148
182arrayValues :: Parser Value -> Parser (Vector Value)
149arrayValues :: Parser Value -> Parser (Vector Value)
183arrayValues val = do
150arrayValues val = do
@@ -185,136 +152,60 @@ arrayValues val = do
185 w <- A.peekWord8'
152 w <- A.peekWord8'
186 if w == CLOSE_SQUARE
153 if w == CLOSE_SQUARE
187 then A.anyWord8 >> return Vector.empty
154 then A.anyWord8 >> return Vector.empty
188− else loop [] 1
155+ else loop []
189 where
156 where
190− loop acc !len = do
157+ loop acc = do
191− v <- (val A.<?> "json list value") <* skipSpace
158+ v <- val <* skipSpace
192− ch <- A.satisfy (\w -> w == COMMA || w == CLOSE_SQUARE) A.<?> "',' or ']'"
159+ ch <- A.satisfy $ \w -> w == COMMA || w == CLOSE_SQUARE
193 if ch == COMMA
160 if ch == COMMA
194− then skipSpace >> loop (v:acc) (len+1)
161+ then skipSpace >> loop (v:acc)
195− else return (Vector.reverse (Vector.fromListN len (v:acc)))
162+ else return (Vector.reverse (Vector.fromList (v:acc)))
196{-# INLINE arrayValues #-}
163{-# INLINE arrayValues #-}
197
164
198−-- | Parse any JSON value. Synonym of 'json'.
165+-- | Parse any JSON value. You should usually 'json' in preference to
199−value :: Parser Value
166+-- this function, as this function relaxes the object-or-array
200−value = jsonWith (pure . H.fromList)
167+-- requirement of RFC 4627.
201−
202−-- | Parse any JSON value.
203−--
204−-- This parser is parameterized by a function to construct an 'Object'
205−-- from a raw list of key-value pairs, where duplicates are preserved.
206−-- The pairs appear in __reverse order__ from the source.
207−--
208−-- ==== __Examples__
209−--
210−-- 'json' keeps only the first occurence of each key, using 'HashMap.Lazy.fromList'.
211−--
212−-- @
213−-- 'json' = 'jsonWith' ('Right' '.' 'H.fromList')
214−-- @
215−--
216−-- 'jsonLast' keeps the last occurence of each key, using
217−-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.
218−--
219−-- @
220−-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))
221−-- @
222−--
223−-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using
224−-- 'fromListAccum'.
225−--
226−-- @
227−-- 'jsonAccum' = 'jsonWith' ('Right' . 'fromListAccum')
228−-- @
229−--
230−-- 'jsonNoDup' fails if any object contains duplicate keys, using 'parseListNoDup'.
231--
168--
232−-- @
169+-- In particular, be careful in using this function if you think your
233−-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'
170+-- code might interoperate with Javascript. A na&#xef;ve Javascript
234−-- @
171+-- library that parses JSON data using @eval@ is vulnerable to attack
235−jsonWith :: ([(Text, Value)] -> Either String Object) -> Parser Value
172+-- unless the encoded data represents an object or an array. JSON
236−jsonWith mkObject = fix $ \value_ -> do
173+-- implementations in other languages conform to that same restriction
174+-- to preserve interoperability and security.
175+value :: Parser Value
176+value = do
237 skipSpace
177 skipSpace
238 w <- A.peekWord8'
178 w <- A.peekWord8'
239 case w of
179 case w of
240 DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_)
180 DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_)
241− OPEN_CURLY -> A.anyWord8 *> object_ mkObject value_
181+ OPEN_CURLY -> A.anyWord8 *> object_
242− OPEN_SQUARE -> A.anyWord8 *> array_ value_
182+ OPEN_SQUARE -> A.anyWord8 *> array_
243− C_f -> string "false" $> Bool False
183+ C_f -> string "false" *> pure (Bool False)
244− C_t -> string "true" $> Bool True
184+ C_t -> string "true" *> pure (Bool True)
245− C_n -> string "null" $> Null
185+ C_n -> string "null" *> pure Null
246 _ | w >= 48 && w <= 57 || w == 45
186 _ | w >= 48 && w <= 57 || w == 45
247 -> Number <$> scientific
187 -> Number <$> scientific
248 | otherwise -> fail "not a valid json value"
188 | otherwise -> fail "not a valid json value"
249−{-# INLINE jsonWith #-}
250−
251−-- | Variant of 'json' which keeps only the last occurence of every key.
252−jsonLast :: Parser Value
253−jsonLast = jsonWith (Right . H.fromListWith (const id))
254−
255−-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve
256−-- key-value pairs with the same keys.
257−jsonAccum :: Parser Value
258−jsonAccum = jsonWith (Right . fromListAccum)
259−
260−-- | Variant of 'json' which fails if any object contains duplicate keys.
261−jsonNoDup :: Parser Value
262−jsonNoDup = jsonWith parseListNoDup
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
189
281−-- | Strict version of 'value'. Synonym of 'json''.
190+-- | Strict version of 'value'. See also 'json''.
282value' :: Parser Value
191value' :: Parser Value
283−value' = jsonWith' (pure . H.fromList)
192+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
193 skipSpace
289 w <- A.peekWord8'
194 w <- A.peekWord8'
290 case w of
195 case w of
291 DOUBLE_QUOTE -> do
196 DOUBLE_QUOTE -> do
292 !s <- A.anyWord8 *> jstring_
197 !s <- A.anyWord8 *> jstring_
293 return (String s)
198 return (String s)
294− OPEN_CURLY -> A.anyWord8 *> object_' mkObject value_
199+ OPEN_CURLY -> A.anyWord8 *> object_'
295− OPEN_SQUARE -> A.anyWord8 *> array_' value_
200+ OPEN_SQUARE -> A.anyWord8 *> array_'
296− C_f -> string "false" $> Bool False
201+ C_f -> string "false" *> pure (Bool False)
297− C_t -> string "true" $> Bool True
202+ C_t -> string "true" *> pure (Bool True)
298− C_n -> string "null" $> Null
203+ C_n -> string "null" *> pure Null
299 _ | w >= 48 && w <= 57 || w == 45
204 _ | w >= 48 && w <= 57 || w == 45
300 -> do
205 -> do
301 !n <- scientific
206 !n <- scientific
302 return (Number n)
207 return (Number n)
303 | otherwise -> fail "not a valid json value"
208 | 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
209
319-- | Parse a quoted JSON string.
210-- | Parse a quoted JSON string.
320jstring :: Parser Text
211jstring :: Parser Text
@@ -324,48 +215,101 @@ jstring = A.word8 DOUBLE_QUOTE *> jstring_
324jstring_ :: Parser Text
215jstring_ :: Parser Text
325{-# INLINE jstring_ #-}
216{-# INLINE jstring_ #-}
326jstring_ = {-# SCC "jstring_" #-} do
217jstring_ = {-# SCC "jstring_" #-} do
327−#if MIN_VERSION_ghc_prim(0,3,1)
328− (s, S _ escaped) <- A.runScanner startState go <* A.anyWord8
218+ (s, fin) <- A.runScanner startState go
329− -- We escape only if there are
219+ _ <- A.anyWord8
330− -- non-ascii (over 7bit) characters or backslash present.
220+ s1 <- if isEscaped fin
331− --
332− -- Note: if/when text will have fast ascii -> text conversion
333− -- (e.g. uses utf8 encoding) we can have further speedup.
334− if isTrue# escaped
335− then case unescapeText s of
221+ then case unescape s of
336− Right r -> return r
222+ Right r -> return r
223+ Left err -> fail err
224+ else return s
225+ case decodeUtf8' s1 of
226+ Right r -> return r
337− Left err -> fail $ show err
227+ Left err -> fail $ show err
338− else return (TE.decodeUtf8 s)
339 where
228 where
229+#if MIN_VERSION_ghc_prim(0,3,1)
230+ isEscaped (S _ escaped) = isTrue# escaped
340 startState = S 0# 0#
231 startState = S 0# 0#
341− go (S skip escaped) (W8# c)
232+ go (S a b) (W8# c)
342− | isTrue# skip = Just (S 0# escaped')
233+ | isTrue# a = Just (S 0# b)
343− | isTrue# (w ==# 34#) = Nothing -- double quote
234+ | isTrue# (word2Int# c ==# 34#) = Nothing -- double quote
344− | otherwise = Just (S skip' escaped')
345− where
346− w = word2Int# c
347− skip' = w ==# 92# -- backslash
235+ | otherwise = let a' = word2Int# c ==# 92# -- backslash
348− escaped' = escaped
236+ in Just (S a' (orI# a' b))
349− `orI#` (w `andI#` 0x80# ==# 0x80#) -- c >= 0x80
350− `orI#` skip'
351− `orI#` (w `andI#` 0x1f# ==# w) -- c < 0x20
352
237
353data S = S Int# Int#
238data S = S Int# Int#
354#else
239#else
355− s <- A.scan startState go <* A.anyWord8
240+ isEscaped (S _ escaped) = escaped
356− case unescapeText s of
357− Right r -> return r
358− Left err -> fail $ show err
359− where
360− startState = False
241+ startState = S False False
361− go a c
242+ go (S a b) c
362− | a = Just False
243+ | a = Just (S False b)
363 | c == DOUBLE_QUOTE = Nothing
244 | c == DOUBLE_QUOTE = Nothing
364 | otherwise = let a' = c == backslash
245 | otherwise = let a' = c == backslash
365− in Just a'
246+ in Just (S a' (a' || b))
366 where backslash = BACKSLASH
247 where backslash = BACKSLASH
248+
249+data S = S !Bool !Bool
367#endif
250#endif
368
251
252+unescape :: ByteString -> Either String ByteString
253+unescape s = unsafePerformIO $ do
254+ let len = B.length s
255+ fp <- B.mallocByteString len
256+ -- We perform no bounds checking when writing to the destination
257+ -- string, as unescaping always makes it shorter than the source.
258+ withForeignPtr fp $ \ptr -> do
259+ ret <- Z.parseT (go ptr) s
260+ case ret of
261+ Left err -> return (Left err)
262+ Right p -> do
263+ let newlen = p `minusPtr` ptr
264+ slop = len - newlen
265+ Right <$> if slop >= 128 && slop >= len `quot` 4
266+ then B.create newlen $ \np -> B.memcpy np ptr newlen
267+ else return (PS fp 0 newlen)
268+ where
269+ go ptr = do
270+ h <- Z.takeWhile (/=BACKSLASH)
271+ let rest = do
272+ start <- Z.take 2
273+ let !slash = B.unsafeHead start
274+ !t = B.unsafeIndex start 1
275+ escape = case B.elemIndex t "\"\\/ntbrfu" of
276+ Just i -> i
277+ _ -> 255
278+ if slash /= BACKSLASH || escape == 255
279+ then fail "invalid JSON escape sequence"
280+ else
281+ if t /= 117 -- 'u'
282+ then copy h ptr >>= word8 (B.unsafeIndex mapping escape) >>= go
283+ else do
284+ a <- hexQuad
285+ if a < 0xd800 || a > 0xdfff
286+ then copy h ptr >>= charUtf8 (chr a) >>= go
287+ else do
288+ b <- Z.string "\\u" *> hexQuad
289+ if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
290+ then let !c = ((a - 0xd800) `shiftL` 10) +
291+ (b - 0xdc00) + 0x10000
292+ in copy h ptr >>= charUtf8 (chr c) >>= go
293+ else fail "invalid UTF-16 surrogates"
294+ done <- Z.atEnd
295+ if done
296+ then copy h ptr
297+ else rest
298+ mapping = "\"\\/\n\t\b\r\f"
299+
300+hexQuad :: Z.ZeptoT IO Int
301+hexQuad = do
302+ s <- Z.take 4
303+ let hex n | w >= C_0 && w <= C_9 = w - C_0
304+ | w >= C_a && w <= C_f = w - 87
305+ | w >= C_A && w <= C_F = w - 55
306+ | otherwise = 255
307+ where w = fromIntegral $ B.unsafeIndex s n
308+ a = hex 0; b = hex 1; c = hex 2; d = hex 3
309+ if (a .|. b .|. c .|. d) /= 255
310+ then return $! d .|. (c `shiftL` 4) .|. (b `shiftL` 8) .|. (a `shiftL` 12)
311+ else fail "invalid hex escape"
312+
369decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
313decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
370decodeWith p to s =
314decodeWith p to s =
371 case L.parse p s of
315 case L.parse p s of
@@ -390,12 +334,7 @@ eitherDecodeWith p to s =
390 L.Done _ v -> case to v of
334 L.Done _ v -> case to v of
391 ISuccess a -> Right a
335 ISuccess a -> Right a
392 IError path msg -> Left (path, msg)
336 IError path msg -> Left (path, msg)
393− L.Fail _ ctx msg -> Left ([], buildMsg ctx msg)
337+ 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 #-}
338{-# INLINE eitherDecodeWith #-}
400
339
401eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
340eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
@@ -435,103 +374,37 @@ jsonEOF = json <* skipSpace <* endOfInput
435jsonEOF' :: Parser Value
374jsonEOF' :: Parser Value
436jsonEOF' = json' <* skipSpace <* endOfInput
375jsonEOF' = json' <* skipSpace <* endOfInput
437
376
438−-- | The only valid whitespace in a JSON document is space, newline,
377+word8 :: Word8 -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)
439−-- carriage return, and tab.
378+word8 w ptr = do
440−skipSpace :: Parser ()
379+ liftIO $ poke ptr w
441−skipSpace = A.skipWhile $ \w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09
380+ return $! ptr `plusPtr` 1
442−{-# INLINE skipSpace #-}
381+
443−
382+copy :: ByteString -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)
444−------------------ Copy-pasted and adapted from attoparsec ------------------
383+copy (PS fp off len) ptr =
445−
384+ liftIO . withForeignPtr fp $ \src -> do
446−-- A strict pair
385+ B.memcpy ptr (src `plusPtr` off) len
447−data SP = SP !Integer {-# UNPACK #-}!Int
386+ return $! ptr `plusPtr` len
448−
387+
449−decimal0 :: Parser Integer
388+charUtf8 :: Char -> Ptr Word8 -> Z.ZeptoT IO (Ptr Word8)
450−decimal0 = do
389+charUtf8 ch ptr
451− let zero = 48
390+ | ch < '\x80' = liftIO $ do
452− digits <- A.takeWhile1 isDigit_w8
391+ poke ptr (fromIntegral (ord ch))
453− if B.length digits > 1 && B.unsafeHead digits == zero
392+ return $! ptr `plusPtr` 1
454− then fail "leading zero"
393+ | ch < '\x800' = liftIO $ do
455− else return (bsToInteger digits)
394+ let (a,b) = ord2 ch
456−
395+ poke ptr a
457−-- | Parse a JSON number.
396+ poke (ptr `plusPtr` 1) b
458−scientific :: Parser Scientific
397+ return $! ptr `plusPtr` 2
459−scientific = do
398+ | ch < '\xffff' = liftIO $ do
460− let minus = 45
399+ let (a,b,c) = ord3 ch
461− plus = 43
400+ poke ptr a
462− sign <- A.peekWord8'
401+ poke (ptr `plusPtr` 1) b
463− let !positive = sign == plus || sign /= minus
402+ poke (ptr `plusPtr` 2) c
464− when (sign == plus || sign == minus) $
403+ return $! ptr `plusPtr` 3
465− void A.anyWord8
404+ | otherwise = liftIO $ do
466−
405+ let (a,b,c,d) = ord4 ch
467− n <- decimal0
406+ poke ptr a
468−
407+ poke (ptr `plusPtr` 1) b
469− let f fracDigits = SP (B.foldl' step n fracDigits)
408+ poke (ptr `plusPtr` 2) c
470− (negate $ B.length fracDigits)
409+ poke (ptr `plusPtr` 3) d
471− step a w = a * 10 + fromIntegral (w - 48)
410+ 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.hs+104−21
@@ -1,4 +1,14 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
2+
3+-- |
4+-- Module: Data.Aeson.Parser.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+-- Parsers for parsing dates and times.
2
12
3module Data.Aeson.Parser.Time
13module Data.Aeson.Parser.Time
4 (
14 (
@@ -11,51 +21,122 @@ module Data.Aeson.Parser.Time
11 , zonedTime
21 , zonedTime
12 ) where
22 ) where
13
23
14−import Prelude.Compat
24+import Control.Monad (when, void)
15−
25+import Data.Aeson.Internal.Time (toPico)
16−import Data.Attoparsec.Text (Parser)
26+import Data.Attoparsec.Text as A
27+import Data.Bits ((.&.))
28+import Data.Char (isDigit, ord)
29+import Data.Fixed (Pico)
30+import Data.Int (Int64)
31+import Data.Maybe (fromMaybe)
17import Data.Text (Text)
32import Data.Text (Text)
18−import Data.Time.Calendar (Day)
33+import Data.Time.Calendar (Day, fromGregorianValid)
19import Data.Time.Clock (UTCTime(..))
34import Data.Time.Clock (UTCTime(..))
20import qualified Data.Aeson.Types.Internal as Aeson
35import qualified Data.Aeson.Types.Internal as Aeson
21−import qualified Data.Attoparsec.Text as A
36+import qualified Data.Text as T
22−import qualified Data.Attoparsec.Time as T
23import qualified Data.Time.LocalTime as Local
37import qualified Data.Time.LocalTime as Local
24
38
39+#if !MIN_VERSION_base(4,8,0)
40+import Control.Applicative ((<$>), (<*>), (<*), (*>))
41+#endif
42+
25-- | Run an attoparsec parser as an aeson parser.
43-- | Run an attoparsec parser as an aeson parser.
26run :: Parser a -> Text -> Aeson.Parser a
44run :: Parser a -> Text -> Aeson.Parser a
27−run p t = case A.parseOnly (p <* A.endOfInput) t of
45+run p t = case A.parseOnly (p <* endOfInput) t of
28 Left err -> fail $ "could not parse date: " ++ err
46 Left err -> fail $ "could not parse date: " ++ err
29 Right r -> return r
47 Right r -> return r
30
48
31−-- | Parse a date of the form @[+,-]YYYY-MM-DD@.
49+-- | Parse a date of the form @YYYY-MM-DD@.
32day :: Parser Day
50day :: Parser Day
33−day = T.day
51+day = do
34−{-# INLINE day #-}
52+ y <- decimal <* char '-'
53+ m <- twoDigits <* char '-'
54+ d <- twoDigits
55+ maybe (fail "invalid date") return (fromGregorianValid y m d)
56+
57+-- | Parse a two-digit integer (e.g. day of month, hour).
58+twoDigits :: Parser Int
59+twoDigits = do
60+ a <- digit
61+ b <- digit
62+ let c2d c = ord c .&. 15
63+ return $! c2d a * 10 + c2d b
35
64
36-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
65-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
37timeOfDay :: Parser Local.TimeOfDay
66timeOfDay :: Parser Local.TimeOfDay
38−timeOfDay = T.timeOfDay
67+timeOfDay = do
39−{-# INLINE timeOfDay #-}
68+ h <- twoDigits
69+ m <- char ':' *> twoDigits
70+ s <- option 0 (char ':' *> seconds)
71+ if h < 24 && m < 60 && s < 61
72+ then return (Local.TimeOfDay h m s)
73+ else fail "invalid time"
74+
75+data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64
76+
77+-- | Parse a count of seconds, with the integer part being two digits
78+-- long.
79+seconds :: Parser Pico
80+seconds = do
81+ real <- twoDigits
82+ mc <- peekChar
83+ case mc of
84+ Just '.' -> do
85+ t <- anyChar *> takeWhile1 isDigit
86+ return $! parsePicos real t
87+ _ -> return $! fromIntegral real
88+ where
89+ parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
90+ where T n t' = T.foldl' step (T 12 (fromIntegral a0)) t
91+ step ma@(T m a) c
92+ | m <= 0 = ma
93+ | otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15)
40
94
41-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
95-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
42-- zero. (This makes some speedups possible.)
96-- zero. (This makes some speedups possible.)
43timeZone :: Parser (Maybe Local.TimeZone)
97timeZone :: Parser (Maybe Local.TimeZone)
44−timeZone = T.timeZone
98+timeZone = do
45−{-# INLINE timeZone #-}
99+ let maybeSkip c = do ch <- peekChar'; when (ch == c) (void anyChar)
100+ maybeSkip ' '
101+ ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
102+ if ch == 'Z'
103+ then return Nothing
104+ else do
105+ h <- twoDigits
106+ mm <- peekChar
107+ m <- case mm of
108+ Just ':' -> anyChar *> twoDigits
109+ Just d | isDigit d -> twoDigits
110+ _ -> return 0
111+ let off | ch == '-' = negate off0
112+ | otherwise = off0
113+ off0 = h * 60 + m
114+ case undefined of
115+ _ | off == 0 ->
116+ return Nothing
117+ | off < -720 || off > 840 || m > 59 ->
118+ fail "invalid time zone offset"
119+ | otherwise ->
120+ let !tz = Local.minutesToTimeZone off
121+ in return (Just tz)
46
122
47-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.
123-- | 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
124-- The space may be replaced with a @T@. The number of seconds is optional
49-- and may be followed by a fractional component.
125-- and may be followed by a fractional component.
50localTime :: Parser Local.LocalTime
126localTime :: Parser Local.LocalTime
51−localTime = T.localTime
127+localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay
52−{-# INLINE localTime #-}
128+ where daySep = satisfy (\c -> c == 'T' || c == ' ')
53
129
54-- | Behaves as 'zonedTime', but converts any time zone offset into a
130-- | Behaves as 'zonedTime', but converts any time zone offset into a
55-- UTC time.
131-- UTC time.
56utcTime :: Parser UTCTime
132utcTime :: Parser UTCTime
57−utcTime = T.utcTime
133+utcTime = do
58−{-# INLINE utcTime #-}
134+ lt@(Local.LocalTime d t) <- localTime
135+ mtz <- timeZone
136+ case mtz of
137+ Nothing -> let !tt = Local.timeOfDayToTime t
138+ in return (UTCTime d tt)
139+ Just tz -> return $! Local.localTimeToUTC tz lt
59
140
60-- | Parse a date with time zone info. Acceptable formats:
141-- | Parse a date with time zone info. Acceptable formats:
61--
142--
@@ -69,5 +150,7 @@ utcTime = T.utcTime
69-- two digits are hours, the @:@ is optional and the second two digits
150-- two digits are hours, the @:@ is optional and the second two digits
70-- (also optional) are minutes.
151-- (also optional) are minutes.
71zonedTime :: Parser Local.ZonedTime
152zonedTime :: Parser Local.ZonedTime
72−zonedTime = T.zonedTime
153+zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
73−{-# INLINE zonedTime #-}
154+
155+utc :: Local.TimeZone
156+utc = Local.TimeZone 0 False ""
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+877−1339
@@ -1,9 +1,5 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE FlexibleInstances #-}
1+{-# LANGUAGE CPP, FlexibleInstances, NamedFieldPuns,
4−{-# LANGUAGE NamedFieldPuns #-}
5−{-# LANGUAGE NoImplicitPrelude #-}
6−{-# LANGUAGE UndecidableInstances #-}
2+ NoImplicitPrelude, UndecidableInstances #-}
7#if __GLASGOW_HASKELL__ >= 800
3#if __GLASGOW_HASKELL__ >= 800
8-- a) THQ works on cross-compilers and unregisterised GHCs
4-- 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)
5-- b) may make compilation faster as no dynamic loading is ever needed (not sure about this)
@@ -13,7 +9,6 @@
13{-# LANGUAGE TemplateHaskell #-}
9{-# LANGUAGE TemplateHaskell #-}
14#endif
10#endif
15
11
16−#include "incoherent-compat.h"
17#include "overlapping-compat.h"
12#include "overlapping-compat.h"
18
13
19{-|
14{-|
@@ -85,72 +80,74 @@ $('deriveJSON' 'defaultOptions' ''(,,,))
85@
80@
86
81
87-}
82-}
83+
88module Data.Aeson.TH
84module Data.Aeson.TH
89− (
90− -- * Encoding configuration
85+ ( -- * Encoding configuration
91− Options(..)
92− , SumEncoding(..)
93− , defaultOptions
94− , defaultTaggedObject
86+ Options(..), SumEncoding(..), defaultOptions, defaultTaggedObject
95
87
96 -- * FromJSON and ToJSON derivation
88 -- * FromJSON and ToJSON derivation
97 , deriveJSON
89 , deriveJSON
98− , deriveJSON1
99− , deriveJSON2
100
90
101 , deriveToJSON
91 , deriveToJSON
102− , deriveToJSON1
103− , deriveToJSON2
104 , deriveFromJSON
92 , deriveFromJSON
105− , deriveFromJSON1
106− , deriveFromJSON2
107
93
108 , mkToJSON
94 , mkToJSON
109− , mkLiftToJSON
110− , mkLiftToJSON2
111 , mkToEncoding
95 , mkToEncoding
112− , mkLiftToEncoding
113− , mkLiftToEncoding2
114 , mkParseJSON
96 , mkParseJSON
115− , mkLiftParseJSON
116− , mkLiftParseJSON2
117 ) where
97 ) where
118
98
119−import Prelude.Compat
120−
121−import Control.Applicative ((<|>))
99+import Control.Applicative ( pure, (<$>), (<*>) )
122−import Data.Aeson (Object, (.:), FromJSON(..), FromJSON1(..), FromJSON2(..), ToJSON(..), ToJSON1(..), ToJSON2(..))
100+import Data.Aeson ( toJSON, Object, (.=), (.:), (.:?)
101+ , ToJSON, toEncoding, toJSON
102+ , FromJSON, parseJSON
103+ )
123−import Data.Aeson.Types (Options(..), Parser, SumEncoding(..), Value(..), defaultOptions, defaultTaggedObject)
104+import Data.Aeson.Types ( Value(..), Parser
105+ , Options(..)
106+ , SumEncoding(..)
107+ , defaultOptions
108+ , defaultTaggedObject
109+ )
124−import Data.Aeson.Types.Internal ((<?>), JSONPathElement(Key))
110+import Data.Aeson.Types.Internal (Encoding(..), (<?>), JSONPathElement(Key))
125−import Data.Aeson.Types.FromJSON (parseOptionalFieldWith)
126−import Data.Aeson.Types.ToJSON (fromPairs, pair)
127−import Control.Monad (liftM2, unless, when)
111+import Control.Monad ( liftM2, return, mapM, fail )
128−import Data.Foldable (foldr')
112+import Data.Bool ( Bool(False, True), otherwise, (&&), not )
129−#if MIN_VERSION_template_haskell(2,8,0) && !MIN_VERSION_template_haskell(2,10,0)
113+import Data.Either ( Either(Left, Right) )
130−import Data.List (nub)
114+import Data.Eq ( (==) )
131−#endif
115+import Data.Function ( ($), (.), flip )
116+import Data.Functor ( fmap )
117+import Data.Int ( Int )
118+import Data.List ( (++), all, any, find, foldl, foldl'
132−import Data.List (foldl', genericLength, intercalate, partition, union)
119+ , genericLength , intercalate , intersperse, length, map
120+ , partition, zip
121+ )
133−import Data.List.NonEmpty ((<|), NonEmpty((:|)))
122+import Data.Map ( Map )
134−import Data.Map (Map)
135−import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
123+import Data.Maybe ( Maybe(Nothing, Just), catMaybes )
136−import qualified Data.Monoid as Monoid
124+import Data.Monoid ( (<>), mconcat )
137−import Data.Set (Set)
138−import Language.Haskell.TH hiding (Arity)
125+import Language.Haskell.TH
139−import Language.Haskell.TH.Datatype
126+import Language.Haskell.TH.Syntax ( VarStrictType )
127+import Prelude ( String, (-), Integer, error, foldr1, fromIntegral
128+ , splitAt, zipWith
129+ )
140#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))
130#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))
131+import Data.Foldable ( foldr' )
132+import qualified Data.Map as M ( singleton )
133+import Data.List ( nub )
141−import Language.Haskell.TH.Syntax (mkNameG_tc)
134+import Language.Haskell.TH.Syntax ( mkNameG_tc )
135+import Prelude ( concatMap, uncurry )
142#endif
136#endif
137+#if MIN_VERSION_template_haskell(2,11,0)
138+import Prelude ( head )
139+#endif
143−import Text.Printf (printf)
140+import Text.Printf ( printf )
141+import Text.Show ( show )
144−import qualified Data.Aeson.Encoding.Internal as E
142+import qualified Data.Aeson as A
143+import qualified Data.Aeson.Encode.Builder as E
145−import qualified Data.Foldable as F (all)
144+import qualified Data.Aeson.Encode.Functions as E
146−import qualified Data.HashMap.Strict as H (difference, fromList, keys, lookup, toList)
145+import qualified Data.HashMap.Strict as H ( lookup, toList )
147−import qualified Data.List.NonEmpty as NE (length, reverse)
148−import qualified Data.Map as M (fromList, keys, lookup , singleton, size)
146+import qualified Data.Map as M ( fromList, findWithDefault )
149−import qualified Data.Semigroup as Semigroup (Option(..))
150−import qualified Data.Set as Set (empty, insert, member)
151−import qualified Data.Text as T (Text, pack, unpack)
147+import qualified Data.Text as T ( Text, pack, unpack )
152−import qualified Data.Vector as V (unsafeIndex, null, length, create, empty)
148+import qualified Data.Vector as V ( unsafeIndex, null, length, create, fromList )
153−import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)
149+import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )
150+
154
151
155--------------------------------------------------------------------------------
152--------------------------------------------------------------------------------
156-- Convenience
153-- Convenience
@@ -167,33 +164,11 @@ deriveJSON :: Options
167 -- ^ Name of the type for which to generate 'ToJSON' and 'FromJSON'
164 -- ^ Name of the type for which to generate 'ToJSON' and 'FromJSON'
168 -- instances.
165 -- instances.
169 -> Q [Dec]
166 -> Q [Dec]
170−deriveJSON = deriveJSONBoth deriveToJSON deriveFromJSON
167+deriveJSON opts name =
168+ liftM2 (++)
169+ (deriveToJSON opts name)
170+ (deriveFromJSON opts name)
171
171
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
172
198--------------------------------------------------------------------------------
173--------------------------------------------------------------------------------
199-- ToJSON
174-- ToJSON
@@ -216,361 +191,414 @@ deriveToJSON :: Options
216 -- ^ Name of the type for which to generate a 'ToJSON' instance
191 -- ^ Name of the type for which to generate a 'ToJSON' instance
217 -- declaration.
192 -- declaration.
218 -> Q [Dec]
193 -> Q [Dec]
219−deriveToJSON = deriveToJSONCommon toJSONClass
194+deriveToJSON opts name =
220−
195+ withType name $ \name' tvbs cons mbTys -> fmap (:[]) $ fromCons name' tvbs cons mbTys
221−-- | Generates a 'ToJSON1' instance declaration for the given data type or
196+ where
222−-- data family instance constructor.
197+ fromCons :: Name -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q Dec
223−deriveToJSON1 :: Options
198+ fromCons name' tvbs cons mbTys = do
224− -- ^ Encoding options.
199+ (instanceCxt, instanceType) <- buildTypeInstance name' ''ToJSON tvbs mbTys
225− -> Name
200+ instanceD (return instanceCxt)
226− -- ^ Name of the type for which to generate a 'ToJSON1' instance
201+ (return instanceType)
227− -- declaration.
202+ [ funD 'toJSON
228− -> Q [Dec]
203+ [ clause []
229−deriveToJSON1 = deriveToJSONCommon toJSON1Class
204+ (normalB $ consToValue opts cons)
230−
205+ []
231−-- | Generates a 'ToJSON2' instance declaration for the given data type or
206+ ]
232−-- data family instance constructor.
207+ , funD 'toEncoding
233−deriveToJSON2 :: Options
208+ [ clause []
234− -- ^ Encoding options.
209+ (normalB $ consToEncoding opts cons)
235− -> Name
210+ []
236− -- ^ Name of the type for which to generate a 'ToJSON2' instance
211+ ]
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− ]
212+ ]
251
213
252-- | Generates a lambda expression which encodes the given data type or
214-- | Generates a lambda expression which encodes the given data type or
253-- data family instance constructor as a 'Value'.
215-- data family instance constructor as a 'Value'.
254mkToJSON :: Options -- ^ Encoding options.
216mkToJSON :: Options -- ^ Encoding options.
255 -> Name -- ^ Name of the type to encode.
217 -> Name -- ^ Name of the type to encode.
256 -> Q Exp
218 -> Q Exp
257−mkToJSON = mkToJSONCommon toJSONClass
219+mkToJSON opts name = withType name (\_ _ cons _ -> consToValue opts cons)
258−
259−-- | Generates a lambda expression which encodes the given data type or
260−-- data family instance constructor as a 'Value' by using the given encoding
261−-- function on occurrences of the last type parameter.
262−mkLiftToJSON :: Options -- ^ Encoding options.
263− -> Name -- ^ Name of the type to encode.
264− -> Q Exp
265−mkLiftToJSON = mkToJSONCommon toJSON1Class
266−
267−-- | Generates a lambda expression which encodes the given data type or
268−-- data family instance constructor as a 'Value' by using the given encoding
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
220
281-- | Generates a lambda expression which encodes the given data type or
221-- | Generates a lambda expression which encodes the given data type or
282-- data family instance constructor as a JSON string.
222-- data family instance constructor as a JSON string.
283mkToEncoding :: Options -- ^ Encoding options.
223mkToEncoding :: Options -- ^ Encoding options.
284 -> Name -- ^ Name of the type to encode.
224 -> Name -- ^ Name of the type to encode.
285 -> Q Exp
225 -> Q Exp
286−mkToEncoding = mkToEncodingCommon toJSONClass
226+mkToEncoding opts name = withType name (\_ _ cons _ -> consToEncoding opts cons)
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
227
310-- | Helper function used by both 'deriveToJSON' and 'mkToJSON'. Generates
228-- | Helper function used by both 'deriveToJSON' and 'mkToJSON'. Generates
311−-- code to generate a 'Value' or 'Encoding' of a number of constructors. All
229+-- code to generate a 'Value' of a number of constructors. All constructors
312−-- constructors must be from the same type.
230+-- must be from the same type.
313−consToValue :: ToJSONFun
231+consToValue :: Options
314− -- ^ The method ('toJSON' or 'toEncoding') being derived.
315− -> JSONClass
316− -- ^ The ToJSON variant being derived.
317− -> Options
318− -- ^ Encoding options.
232+ -- ^ Encoding options.
319− -> [Type]
233+ -> [Con]
320− -- ^ The types from the data type/data family instance declaration
321− -> [ConstructorInfo]
322− -- ^ Constructors for which to generate JSON generating code.
234+ -- ^ Constructors for which to generate JSON generating code.
323− -> Q Exp
235+ -> Q Exp
324
236
325−consToValue _ _ _ _ [] = error $ "Data.Aeson.TH.consToValue: "
237+consToValue _ [] = error $ "Data.Aeson.TH.consToValue: "
326− ++ "Not a single constructor given!"
238+ ++ "Not a single constructor given!"
327
239
240+-- A single constructor is directly encoded. The constructor itself may be
241+-- forgotten.
328−consToValue target jc opts instTys cons = do
242+consToValue opts [con] = do
329 value <- newName "value"
243 value <- newName "value"
330− tjs <- newNameList "_tj" $ arityInt jc
244+ lam1E (varP value) $ caseE (varE value) [argsToValue opts False con]
331− tjls <- newNameList "_tjl" $ arityInt jc
245+
332− let zippedTJs = zip tjs tjls
246+consToValue opts cons = do
333− interleavedTJs = interleave tjs tjls
247+ value <- newName "value"
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)
248+ lam1E (varP value) $ caseE (varE value) matches
338 where
249 where
339− matches tvMap = case cons of
250+ 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 ->
251+ | allNullaryToStringTag opts && all isNullary cons =
344− [ match (conP conName []) (normalB $ conStr target opts conName) []
252+ [ match (conP conName []) (normalB $ conStr opts conName) []
345 | con <- cons
253 | con <- cons
346− , let conName = constructorName con
254+ , let conName = getConName con
347 ]
255 ]
348− | otherwise -> [argsToValue target jc tvMap opts True con | con <- cons]
256+ | otherwise = [argsToValue opts True con | con <- cons]
349
257
350−-- | Name of the constructor as a quoted 'Value' or 'Encoding'.
351−conStr :: ToJSONFun -> Options -> Name -> Q Exp
258+conStr :: Options -> Name -> Q Exp
352−conStr Value opts = appE [|String|] . conTxt opts
259+conStr opts = appE [|String|] . conTxt opts
353−conStr Encoding opts = appE [|E.text|] . conTxt opts
354
260
355−-- | Name of the constructor as a quoted 'Text'.
356conTxt :: Options -> Name -> Q Exp
261conTxt :: Options -> Name -> Q Exp
357−conTxt opts = appE [|T.pack|] . stringE . conString opts
262+conTxt opts = appE [|T.pack|] . conStringE opts
263+
264+conStringE :: Options -> Name -> Q Exp
265+conStringE opts = stringE . constructorTagModifier opts . nameBase
266+
267+-- | Helper function used by both 'deriveToJSON' and 'mkToEncoding'. Generates
268+-- code to write out a value for a number of constructors. All constructors
269+-- must be from the same type.
270+consToEncoding :: Options
271+ -- ^ Encoding options.
272+ -> [Con]
273+ -- ^ Constructors for which to generate JSON generating code.
274+ -> Q Exp
275+
276+consToEncoding _ [] = error $ "Data.Aeson.TH.consToEncoding: "
277+ ++ "Not a single constructor given!"
278+
279+-- A single constructor is directly encoded. The constructor itself may be
280+-- forgotten.
281+consToEncoding opts [con] = do
282+ value <- newName "value"
283+ lam1E (varP value) $ caseE (varE value) [argsToEncoding opts False con]
284+
285+-- Encode just the name of the constructor of a sum type iff all the
286+-- constructors are nullary.
287+consToEncoding opts cons = do
288+ value <- newName "value"
289+ lam1E (varP value) $ caseE (varE value) matches
290+ where
291+ matches
292+ | allNullaryToStringTag opts && all isNullary cons =
293+ [ match (conP conName [])
294+ (normalB $ [|Encoding|] `appE` encStr opts conName) []
295+ | con <- cons
296+ , let conName = getConName con
297+ ]
298+ | otherwise = [argsToEncoding opts True con | con <- cons]
358
299
359−-- | Name of the constructor.
360−conString :: Options -> Name -> String
300+encStr :: Options -> Name -> Q Exp
361−conString opts = constructorTagModifier opts . nameBase
301+encStr opts = appE [|E.text|] . conTxt opts
362
302
363-- | If constructor is nullary.
303-- | If constructor is nullary.
364−isNullary :: ConstructorInfo -> Bool
304+isNullary :: Con -> Bool
365−isNullary ConstructorInfo { constructorVariant = NormalConstructor
305+isNullary (NormalC _ []) = True
366− , constructorFields = tys } = null tys
367isNullary _ = False
306isNullary _ = False
368
307
369−-- | Wrap fields of a non-record constructor. See 'sumToValue'.
308+sumToValue :: 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 =
381− sumToValue target opts multiCons nullary conName
309+sumToValue opts multiCons conName exp
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 =
310 | multiCons =
411 case sumEncoding opts of
311 case sumEncoding opts of
412 TwoElemArray ->
312 TwoElemArray ->
413− array target [conStr target opts conName, value]
313+ [|Array|] `appE` ([|V.fromList|] `appE` listE [conStr opts conName, exp])
414 TaggedObject{tagFieldName, contentsFieldName} ->
314 TaggedObject{tagFieldName, contentsFieldName} ->
415− -- TODO: Maybe throw an error in case
315+ [|A.object|] `appE` listE
416− -- tagFieldName overwrites a field in pairs.
316+ [ infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)
417− let tag = pairE tagFieldName (conStr target opts conName)
418− content = pairs contentsFieldName
317+ , infixApp [|T.pack contentsFieldName|] [|(.=)|] exp
419− in fromPairsE $
318+ ]
420− if nullary then tag else infixApp tag [|(Monoid.<>)|] content
421 ObjectWithSingleField ->
319 ObjectWithSingleField ->
422− objectE [(conString opts conName, value)]
320+ [|A.object|] `appE` listE
321+ [ infixApp (conTxt opts conName) [|(.=)|] exp
322+ ]
323+
324+ | otherwise = exp
325+
326+nullarySumToValue :: Options -> Bool -> Name -> Q Exp
327+nullarySumToValue opts multiCons conName =
328+ case sumEncoding opts of
329+ TaggedObject{tagFieldName} ->
330+ [|A.object|] `appE` listE
423− UntaggedValue | nullary -> conStr target opts conName
331+ [ infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)
424− UntaggedValue -> value
332+ ]
425− | otherwise = value
333+ _ -> sumToValue opts multiCons conName [e|toJSON ([] :: [()])|]
426
334
427-- | Generates code to generate the JSON encoding of a single constructor.
335-- | Generates code to generate the JSON encoding of a single constructor.
428−argsToValue :: ToJSONFun -> JSONClass -> TyVarMap -> Options -> Bool -> ConstructorInfo -> Q Match
336+argsToValue :: Options -> Bool -> Con -> Q Match
337+-- Nullary constructors. Generates code that explicitly matches against the
338+-- constructor even though it doesn't contain data. This is useful to prevent
339+-- type errors.
340+argsToValue opts multiCons (NormalC conName []) =
341+ match (conP conName [])
342+ (normalB (nullarySumToValue opts multiCons conName))
343+ []
429
344
430-- Polyadic constructors with special case for unary constructors.
345-- Polyadic constructors with special case for unary constructors.
431−argsToValue target jc tvMap opts multiCons
346+argsToValue opts multiCons (NormalC conName ts) = do
432− ConstructorInfo { constructorName = conName
347+ let len = length ts
433− , constructorVariant = NormalConstructor
348+ args <- mapM newName ["arg" ++ show n | n <- [1..len]]
434− , constructorFields = argTys } = do
435− argTys' <- mapM resolveTypeSynonyms argTys
436− let len = length argTys'
437− args <- newNameList "arg" len
438− let js = case [ dispatchToJSON target jc conName tvMap argTy
439− `appE` varE arg
349+ js <- case [[|toJSON|] `appE` varE arg | arg <- args] of
440− | (arg, argTy) <- zip args argTys'
441− ] of
442− -- Single argument is directly converted.
350+ -- Single argument is directly converted.
443− [e] -> e
351+ [e] -> return e
444− -- Zero and multiple arguments are converted to a JSON array.
352+ -- Multiple arguments are converted to a JSON array.
445− es -> array target es
353+ es -> do
446−
354+ mv <- newName "mv"
355+ let newMV = bindS (varP mv)
356+ ([|VM.unsafeNew|] `appE`
357+ litE (integerL $ fromIntegral len))
358+ stmts = [ noBindS $
359+ [|VM.unsafeWrite|] `appE`
360+ (varE mv) `appE`
361+ litE (integerL ix) `appE`
362+ e
363+ | (ix, e) <- zip [(0::Integer)..] es
364+ ]
365+ ret = noBindS $ [|return|] `appE` varE mv
366+ return $ [|Array|] `appE`
367+ (varE 'V.create `appE`
368+ doE (newMV:stmts++[ret]))
447 match (conP conName $ map varP args)
369 match (conP conName $ map varP args)
448− (normalB $ opaqueSumToValue target opts multiCons (null argTys') conName js)
370+ (normalB $ sumToValue opts multiCons conName js)
449 []
371 []
450
372
451-- Records.
373-- 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
374+argsToValue opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts, not multiCons, ts) of
457− (True,True,[_]) -> argsToValue target jc tvMap opts multiCons
375+ (True,True,[(_,st,ty)]) -> argsToValue opts multiCons (NormalC conName [(st,ty)])
458− (info{constructorVariant = NormalConstructor})
459− _ -> do
376+ _ -> do
460− argTys' <- mapM resolveTypeSynonyms argTys
377+ args <- mapM newName ["arg" ++ show n | (_, n) <- zip ts [1 :: Integer ..]]
461− args <- newNameList "arg" $ length argTys'
378+ let exp = [|A.object|] `appE` pairs
379+
462− let pairs | omitNothingFields opts = infixApp maybeFields
380+ pairs | omitNothingFields opts = infixApp maybeFields
463− [|(Monoid.<>)|]
381+ [|(++)|]
464− restFields
382+ restFields
465− | otherwise = mconcatE (map pureToPair argCons)
383+ | otherwise = listE $ map toPair argCons
466−
384+
467− argCons = zip3 (map varE args) argTys' fields
385+ argCons = zip args ts
468−
386+
469− maybeFields = mconcatE (map maybeToPair maybes)
387+ maybeFields = [|catMaybes|] `appE` listE (map maybeToPair maybes)
470−
388+
471− restFields = mconcatE (map pureToPair rest)
389+ restFields = listE $ map toPair rest
472−
390+
473− (maybes0, rest0) = partition isMaybe argCons
391+ (maybes, rest) = partition isMaybe argCons
474− (options, rest) = partition isOption rest0
392+
475− maybes = maybes0 ++ map optionToMaybe options
393+ maybeToPair (arg, (field, _, _)) =
476−
394+ infixApp (infixE (Just $ toFieldName field)
477− maybeToPair = toPairLifted True
395+ [|(.=)|]
478− pureToPair = toPairLifted False
396+ Nothing)
479−
397+ [|(<$>)|]
480− toPairLifted lifted (arg, argTy, field) =
398+ (varE arg)
481− let toValue = dispatchToJSON target jc conName tvMap argTy
399+
482− fieldName = fieldLabel opts field
400+ toPair (arg, (field, _, _)) =
483− e arg' = pairE fieldName (toValue `appE` arg')
401+ infixApp (toFieldName field)
484− in if lifted
402+ [|(.=)|]
485− then do
403+ (varE arg)
486− x <- newName "x"
404+
487− [|maybe mempty|] `appE` lam1E (varP x) (e (varE x)) `appE` arg
405+ toFieldName field = [|T.pack|] `appE` fieldLabelExp opts field
406+
407+ match (conP conName $ map varP args)
408+ ( normalB
409+ $ if multiCons
410+ then case sumEncoding opts of
411+ TwoElemArray -> [|toJSON|] `appE` tupE [conStr opts conName, exp]
412+ TaggedObject{tagFieldName} ->
413+ [|A.object|] `appE`
414+ -- TODO: Maybe throw an error in case
415+ -- tagFieldName overwrites a field in pairs.
416+ infixApp (infixApp [|T.pack tagFieldName|]
417+ [|(.=)|]
418+ (conStr opts conName))
419+ [|(:)|]
420+ pairs
421+ ObjectWithSingleField ->
422+ [|A.object|] `appE` listE
423+ [ infixApp (conTxt opts conName) [|(.=)|] exp ]
488− else e arg
424+ else exp
489−
490− match (conP conName $ map varP args)
491− (normalB $ recordSumToValue target opts multiCons (null argTys) conName pairs)
492− []
425+ ) []
493
426
494-- Infix constructors.
427-- Infix constructors.
495−argsToValue target jc tvMap opts multiCons
428+argsToValue 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"
429 al <- newName "argL"
501 ar <- newName "argR"
430 ar <- newName "argR"
502 match (infixP (varP al) conName (varP ar))
431 match (infixP (varP al) conName (varP ar))
503 ( normalB
432 ( normalB
504− $ opaqueSumToValue target opts multiCons False conName
433+ $ sumToValue opts multiCons conName
505− $ array target
506− [ dispatchToJSON target jc conName tvMap aTy
507− `appE` varE a
434+ $ [|toJSON|] `appE` listE [ [|toJSON|] `appE` varE a
508− | (a, aTy) <- [(al,alTy), (ar,arTy)]
435+ | a <- [al,ar]
509− ]
436+ ]
510 )
437 )
511 []
438 []
439+-- Existentially quantified constructors.
440+argsToValue opts multiCons (ForallC _ _ con) =
441+ argsToValue opts multiCons con
512
442
513−isMaybe :: (a, Type, b) -> Bool
443+#if MIN_VERSION_template_haskell(2,11,0)
514−isMaybe (_, AppT (ConT t) _, _) = t == ''Maybe
444+-- GADTs.
515−isMaybe _ = False
445+argsToValue opts multiCons (GadtC conNames ts _) =
446+ argsToValue opts multiCons $ NormalC (head conNames) ts
516
447
517−isOption :: (a, Type, b) -> Bool
448+argsToValue opts multiCons (RecGadtC conNames ts _) =
518−isOption (_, AppT (ConT t) _, _) = t == ''Semigroup.Option
449+ argsToValue opts multiCons $ RecC (head conNames) ts
519−isOption _ = False
450+#endif
520
451
521−optionToMaybe :: (ExpQ, b, c) -> (ExpQ, b, c)
452+isMaybe :: (a, (b, c, Type)) -> Bool
522−optionToMaybe (a, b, c) = ([|Semigroup.getOption|] `appE` a, b, c)
453+isMaybe (_, (_, _, AppT (ConT t) _)) = t == ''Maybe
454+isMaybe _ = False
523
455
524(<^>) :: ExpQ -> ExpQ -> ExpQ
456(<^>) :: ExpQ -> ExpQ -> ExpQ
525−(<^>) a b = infixApp a [|(E.><)|] b
457+(<^>) a b = infixApp a [|(<>)|] b
526infixr 6 <^>
458infixr 6 <^>
527
459
460+(<:>) :: ExpQ -> ExpQ -> ExpQ
461+(<:>) a b = a <^> [|E.char7 ':'|] <^> b
462+infixr 5 <:>
463+
528(<%>) :: ExpQ -> ExpQ -> ExpQ
464(<%>) :: ExpQ -> ExpQ -> ExpQ
529−(<%>) a b = a <^> [|E.comma|] <^> b
465+(<%>) a b = a <^> [|E.char7 ','|] <^> b
530infixr 4 <%>
466infixr 4 <%>
531
467
532−-- | Wrap a list of quoted 'Value's in a quoted 'Array' (of type 'Value').
533−array :: ToJSONFun -> [ExpQ] -> ExpQ
468+array :: ExpQ -> ExpQ
534−array Encoding [] = [|E.emptyArray_|]
469+array exp = [|Encoding|] `appE` ([|E.char7 '['|] <^> exp <^> [|E.char7 ']'|])
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
470
554−-- | Wrap an associative list of keys and quoted values in a quoted 'Object'.
555−objectE :: [(String, ExpQ)] -> ExpQ
471+object :: ExpQ -> ExpQ
556−objectE = fromPairsE . mconcatE . fmap (uncurry pairE)
472+object exp = [|Encoding|] `appE` ([|E.char7 '{'|] <^> exp <^> [|E.char7 '}'|])
557
473
558−-- | 'mconcat' a list of fixed length.
474+sumToEncoding :: Options -> Bool -> Name -> Q Exp -> Q Exp
559−--
475+sumToEncoding opts multiCons conName exp
560−-- > mconcatE [ [|x|], [|y|], [|z|] ] = [| x <> (y <> z) |]
476+ | multiCons =
561−mconcatE :: [ExpQ] -> ExpQ
477+ let fexp = [|fromEncoding|] `appE` exp in
562−mconcatE [] = [|Monoid.mempty|]
478+ case sumEncoding opts of
563−mconcatE [x] = x
479+ TwoElemArray ->
564−mconcatE (x : xs) = infixApp x [|(Monoid.<>)|] (mconcatE xs)
480+ array (encStr opts conName <%> fexp)
481+ TaggedObject{tagFieldName, contentsFieldName} ->
482+ object $
483+ ([|E.text (T.pack tagFieldName)|] <:> encStr opts conName) <%>
484+ ([|E.text (T.pack contentsFieldName)|] <:> fexp)
485+ ObjectWithSingleField ->
486+ object (encStr opts conName <:> fexp)
565
487
566−fromPairsE :: ExpQ -> ExpQ
488+ | otherwise = exp
567−fromPairsE = ([|fromPairs|] `appE`)
568
489
569−-- | Create (an encoding of) a key-value pair.
490+nullarySumToEncoding :: Options -> Bool -> Name -> Q Exp
570−--
491+nullarySumToEncoding opts multiCons conName =
571−-- > pairE "k" [|v|] = [|pair "k" v|]
492+ case sumEncoding opts of
572−pairE :: String -> ExpQ -> ExpQ
493+ TaggedObject{tagFieldName} ->
573−pairE k v = [|pair k|] `appE` v
494+ object $
495+ ([|E.text (T.pack tagFieldName)|] <:> encStr opts conName)
496+ _ -> sumToEncoding opts multiCons conName [e|toEncoding ([] :: [()])|]
497+
498+-- | Generates code to generate the JSON encoding of a single constructor.
499+argsToEncoding :: Options -> Bool -> Con -> Q Match
500+-- Nullary constructors. Generates code that explicitly matches against the
501+-- constructor even though it doesn't contain data. This is useful to prevent
502+-- type errors.
503+argsToEncoding opts multiCons (NormalC conName []) =
504+ match (conP conName [])
505+ (normalB (nullarySumToEncoding opts multiCons conName))
506+ []
507+
508+-- Polyadic constructors with special case for unary constructors.
509+argsToEncoding opts multiCons (NormalC conName ts) = do
510+ let len = length ts
511+ args <- mapM newName ["arg" ++ show n | n <- [1..len]]
512+ js <- case args of
513+ -- Single argument is directly converted.
514+ [e] -> return ([|toEncoding|] `appE` varE e)
515+ -- Multiple arguments are converted to a JSON array.
516+ es ->
517+ return (array (foldr1 (<%>) [[|E.builder|] `appE` varE x | x <- es]))
518+ match (conP conName $ map varP args)
519+ (normalB $ sumToEncoding opts multiCons conName js)
520+ []
521+
522+-- Records.
523+argsToEncoding opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts, not multiCons, ts) of
524+ (True,True,[(_,st,ty)]) -> argsToEncoding opts multiCons (NormalC conName [(st,ty)])
525+ _ -> do
526+ args <- mapM newName ["arg" ++ show n | (_, n) <- zip ts [1 :: Integer ..]]
527+
528+ let exp = object objBody
529+
530+ objBody = [|mconcat|] `appE`
531+ ([|intersperse (E.char7 ',')|] `appE` pairs)
532+ pairs | omitNothingFields opts = infixApp maybeFields
533+ [|(<>)|]
534+ restFields
535+ | otherwise = listE (map toPair argCons)
536+
537+ argCons = zip args ts
538+
539+ maybeFields = [|catMaybes|] `appE` listE (map maybeToPair maybes)
540+
541+ restFields = listE (map toPair rest)
542+
543+ (maybes, rest) = partition isMaybe argCons
544+
545+ maybeToPair (arg, (field, _, _)) =
546+ infixApp
547+ (infixApp
548+ (infixE
549+ (Just $ toFieldName field <^> [|E.char7 ':'|])
550+ [|(<>)|]
551+ Nothing)
552+ [|(.)|]
553+ [|E.builder|])
554+ [|(<$>)|]
555+ (varE arg)
556+
557+ toPair (arg, (field, _, _)) =
558+ toFieldName field <:> [|E.builder|] `appE` varE arg
559+
560+ toFieldName field = [|E.text|] `appE`
561+ ([|T.pack|] `appE` fieldLabelExp opts field)
562+
563+ match (conP conName $ map varP args)
564+ ( normalB
565+ $ if multiCons
566+ then case sumEncoding opts of
567+ TwoElemArray -> array $
568+ encStr opts conName <%> [|fromEncoding|] `appE` exp
569+ TaggedObject{tagFieldName} -> object $
570+ ([|E.text (T.pack tagFieldName)|] <:>
571+ encStr opts conName) <%>
572+ objBody
573+ ObjectWithSingleField -> object $
574+ encStr opts conName <:> [|fromEncoding|] `appE` exp
575+ else exp
576+ ) []
577+
578+-- Infix constructors.
579+argsToEncoding opts multiCons (InfixC _ conName _) = do
580+ al <- newName "argL"
581+ ar <- newName "argR"
582+ match (infixP (varP al) conName (varP ar))
583+ ( normalB
584+ $ sumToEncoding opts multiCons conName
585+ $ [|toEncoding|] `appE` listE [ [|toJSON|] `appE` varE a
586+ | a <- [al,ar]
587+ ]
588+ )
589+ []
590+-- Existentially quantified constructors.
591+argsToEncoding opts multiCons (ForallC _ _ con) =
592+ argsToEncoding opts multiCons con
593+
594+#if MIN_VERSION_template_haskell(2,11,0)
595+-- GADTs.
596+argsToEncoding opts multiCons (GadtC conNames ts _) =
597+ argsToEncoding opts multiCons $ NormalC (head conNames) ts
598+
599+argsToEncoding opts multiCons (RecGadtC conNames ts _) =
600+ argsToEncoding opts multiCons $ RecC (head conNames) ts
601+#endif
574
602
575--------------------------------------------------------------------------------
603--------------------------------------------------------------------------------
576-- FromJSON
604-- FromJSON
@@ -584,112 +612,55 @@ deriveFromJSON :: Options
584 -- ^ Name of the type for which to generate a 'FromJSON' instance
612 -- ^ Name of the type for which to generate a 'FromJSON' instance
585 -- declaration.
613 -- declaration.
586 -> Q [Dec]
614 -> Q [Dec]
587−deriveFromJSON = deriveFromJSONCommon fromJSONClass
615+deriveFromJSON opts name =
588−
616+ withType name $ \name' tvbs cons mbTys -> fmap (:[]) $ fromCons name' tvbs cons mbTys
589−-- | Generates a 'FromJSON1' instance declaration for the given data type or
617+ where
590−-- data family instance constructor.
618+ fromCons :: Name -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q Dec
591−deriveFromJSON1 :: Options
619+ fromCons name' tvbs cons mbTys = do
592− -- ^ Encoding options.
620+ (instanceCxt, instanceType) <- buildTypeInstance name' ''FromJSON tvbs mbTys
593− -> Name
621+ instanceD (return instanceCxt)
594− -- ^ Name of the type for which to generate a 'FromJSON1' instance
622+ (return instanceType)
595− -- declaration.
623+ [ funD 'parseJSON
596− -> Q [Dec]
624+ [ clause []
597−deriveFromJSON1 = deriveFromJSONCommon fromJSON1Class
625+ (normalB $ consFromJSON name' opts cons)
598−
626+ []
599−-- | Generates a 'FromJSON2' instance declaration for the given data type or
627+ ]
600−-- data family instance constructor.
628+ ]
601−deriveFromJSON2 :: Options
602− -- ^ Encoding options.
603− -> Name
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
629
619-- | Generates a lambda expression which parses the JSON encoding of the given
630-- | Generates a lambda expression which parses the JSON encoding of the given
620-- data type or data family instance constructor.
631-- data type or data family instance constructor.
621mkParseJSON :: Options -- ^ Encoding options.
632mkParseJSON :: Options -- ^ Encoding options.
622 -> Name -- ^ Name of the encoded type.
633 -> Name -- ^ Name of the encoded type.
623 -> Q Exp
634 -> Q Exp
624−mkParseJSON = mkParseJSONCommon fromJSONClass
635+mkParseJSON opts name =
625−
636+ withType name (\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
637
648-- | Helper function used by both 'deriveFromJSON' and 'mkParseJSON'. Generates
638-- | Helper function used by both 'deriveFromJSON' and 'mkParseJSON'. Generates
649-- code to parse the JSON encoding of a number of constructors. All constructors
639-- code to parse the JSON encoding of a number of constructors. All constructors
650-- must be from the same type.
640-- must be from the same type.
651−consFromJSON :: JSONClass
641+consFromJSON :: Name
652− -- ^ The FromJSON variant being derived.
653− -> Name
654 -- ^ Name of the type to which the constructors belong.
642 -- ^ Name of the type to which the constructors belong.
655 -> Options
643 -> Options
656 -- ^ Encoding options
644 -- ^ Encoding options
657− -> [Type]
645+ -> [Con]
658− -- ^ The types from the data type/data family instance declaration
659− -> [ConstructorInfo]
660 -- ^ Constructors for which to generate JSON parsing code.
646 -- ^ Constructors for which to generate JSON parsing code.
661 -> Q Exp
647 -> Q Exp
662
648
663−consFromJSON _ _ _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
649+consFromJSON _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
664− ++ "Not a single constructor given!"
650+ ++ "Not a single constructor given!"
665
651
666−consFromJSON jc tName opts instTys cons = do
652+consFromJSON tName opts [con] = do
667 value <- newName "value"
653 value <- newName "value"
668− pjs <- newNameList "_pj" $ arityInt jc
654+ 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
655
676− where
656+consFromJSON tName opts cons = do
677− checkExi tvMap con = checkExistentialContext jc tvMap
657+ 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) $
658+ lam1E (varP value) $ caseE (varE value) $
689− if allNullaryToStringTag opts && all isNullary cons
659+ if allNullaryToStringTag opts && all isNullary cons
690− then allNullaryMatches
660+ then allNullaryMatches
691− else mixedMatches tvMap
661+ else mixedMatches
692
662
663+ where
693 allNullaryMatches =
664 allNullaryMatches =
694 [ do txt <- newName "txt"
665 [ do txt <- newName "txt"
695 match (conP 'String [varP txt])
666 match (conP 'String [varP txt])
@@ -697,17 +668,18 @@ consFromJSON jc tName opts instTys cons = do
697 [ liftM2 (,) (normalG $
668 [ liftM2 (,) (normalG $
698 infixApp (varE txt)
669 infixApp (varE txt)
699 [|(==)|]
670 [|(==)|]
671+ ([|T.pack|] `appE`
700− (conTxt opts conName)
672+ conStringE opts conName)
701 )
673 )
702 ([|pure|] `appE` conE conName)
674 ([|pure|] `appE` conE conName)
703 | con <- cons
675 | con <- cons
704− , let conName = constructorName con
676+ , let conName = getConName con
705 ]
677 ]
706 ++
678 ++
707 [ liftM2 (,)
679 [ liftM2 (,)
708 (normalG [|otherwise|])
680 (normalG [|otherwise|])
709 ( [|noMatchFail|]
681 ( [|noMatchFail|]
710− `appE` litE (stringL $ show tName)
682+ `appE` (litE $ stringL $ show tName)
711 `appE` ([|T.unpack|] `appE` varE txt)
683 `appE` ([|T.unpack|] `appE` varE txt)
712 )
684 )
713 ]
685 ]
@@ -716,31 +688,30 @@ consFromJSON jc tName opts instTys cons = do
716 , do other <- newName "other"
688 , do other <- newName "other"
717 match (varP other)
689 match (varP other)
718 (normalB $ [|noStringFail|]
690 (normalB $ [|noStringFail|]
719− `appE` litE (stringL $ show tName)
691+ `appE` (litE $ stringL $ show tName)
720 `appE` ([|valueConName|] `appE` varE other)
692 `appE` ([|valueConName|] `appE` varE other)
721 )
693 )
722 []
694 []
723 ]
695 ]
724
696
725− mixedMatches tvMap =
697+ mixedMatches =
726 case sumEncoding opts of
698 case sumEncoding opts of
727 TaggedObject {tagFieldName, contentsFieldName} ->
699 TaggedObject {tagFieldName, contentsFieldName} ->
728− parseObject $ parseTaggedObject tvMap tagFieldName contentsFieldName
700+ parseObject $ parseTaggedObject tagFieldName contentsFieldName
729− UntaggedValue -> error "UntaggedValue: Should be handled already"
730 ObjectWithSingleField ->
701 ObjectWithSingleField ->
731− parseObject $ parseObjectWithSingleField tvMap
702+ parseObject $ parseObjectWithSingleField
732 TwoElemArray ->
703 TwoElemArray ->
733 [ do arr <- newName "array"
704 [ do arr <- newName "array"
734 match (conP 'Array [varP arr])
705 match (conP 'Array [varP arr])
735− (guardedB
706+ (guardedB $
736 [ liftM2 (,) (normalG $ infixApp ([|V.length|] `appE` varE arr)
707 [ liftM2 (,) (normalG $ infixApp ([|V.length|] `appE` varE arr)
737 [|(==)|]
708 [|(==)|]
738 (litE $ integerL 2))
709 (litE $ integerL 2))
739− (parse2ElemArray tvMap arr)
710+ (parse2ElemArray arr)
740 , liftM2 (,) (normalG [|otherwise|])
711 , liftM2 (,) (normalG [|otherwise|])
741− ([|not2ElemArray|]
712+ (([|not2ElemArray|]
742− `appE` litE (stringL $ show tName)
713+ `appE` (litE $ stringL $ show tName)
743− `appE` ([|V.length|] `appE` varE arr))
714+ `appE` ([|V.length|] `appE` varE arr)))
744 ]
715 ]
745 )
716 )
746 []
717 []
@@ -748,7 +719,7 @@ consFromJSON jc tName opts instTys cons = do
748 match (varP other)
719 match (varP other)
749 ( normalB
720 ( normalB
750 $ [|noArrayFail|]
721 $ [|noArrayFail|]
751− `appE` litE (stringL $ show tName)
722+ `appE` (litE $ stringL $ show tName)
752 `appE` ([|valueConName|] `appE` varE other)
723 `appE` ([|valueConName|] `appE` varE other)
753 )
724 )
754 []
725 []
@@ -761,47 +732,22 @@ consFromJSON jc tName opts instTys cons = do
761 match (varP other)
732 match (varP other)
762 ( normalB
733 ( normalB
763 $ [|noObjectFail|]
734 $ [|noObjectFail|]
764− `appE` litE (stringL $ show tName)
735+ `appE` (litE $ stringL $ show tName)
765 `appE` ([|valueConName|] `appE` varE other)
736 `appE` ([|valueConName|] `appE` varE other)
766 )
737 )
767 []
738 []
768 ]
739 ]
769
740
770− parseTaggedObject tvMap typFieldName valFieldName obj = do
741+ parseTaggedObject typFieldName valFieldName obj = do
771 conKey <- newName "conKey"
742 conKey <- newName "conKey"
772 doE [ bindS (varP conKey)
743 doE [ bindS (varP conKey)
773 (infixApp (varE obj)
744 (infixApp (varE obj)
774 [|(.:)|]
745 [|(.:)|]
775 ([|T.pack|] `appE` stringE typFieldName))
746 ([|T.pack|] `appE` stringE typFieldName))
776− , noBindS $ parseContents tvMap conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject
747+ , noBindS $ parseContents conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject
777 ]
748 ]
778
749
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
750+ parse2ElemArray arr = do
805 conKey <- newName "conKey"
751 conKey <- newName "conKey"
806 conVal <- newName "conVal"
752 conVal <- newName "conVal"
807 let letIx n ix =
753 let letIx n ix =
@@ -816,8 +762,7 @@ consFromJSON jc tName opts instTys cons = do
816 (caseE (varE conKey)
762 (caseE (varE conKey)
817 [ do txt <- newName "txt"
763 [ do txt <- newName "txt"
818 match (conP 'String [varP txt])
764 match (conP 'String [varP txt])
819− (normalB $ parseContents tvMap
765+ (normalB $ parseContents txt
820− txt
821 (Right conVal)
766 (Right conVal)
822 'conNotFoundFail2ElemArray
767 'conNotFoundFail2ElemArray
823 )
768 )
@@ -826,30 +771,30 @@ consFromJSON jc tName opts instTys cons = do
826 match (varP other)
771 match (varP other)
827 ( normalB
772 ( normalB
828 $ [|firstElemNoStringFail|]
773 $ [|firstElemNoStringFail|]
829− `appE` litE (stringL $ show tName)
774+ `appE` (litE $ stringL $ show tName)
830 `appE` ([|valueConName|] `appE` varE other)
775 `appE` ([|valueConName|] `appE` varE other)
831 )
776 )
832 []
777 []
833 ]
778 ]
834 )
779 )
835
780
836− parseObjectWithSingleField tvMap obj = do
781+ parseObjectWithSingleField obj = do
837 conKey <- newName "conKey"
782 conKey <- newName "conKey"
838 conVal <- newName "conVal"
783 conVal <- newName "conVal"
839 caseE ([e|H.toList|] `appE` varE obj)
784 caseE ([e|H.toList|] `appE` varE obj)
840 [ match (listP [tupP [varP conKey, varP conVal]])
785 [ match (listP [tupP [varP conKey, varP conVal]])
841− (normalB $ parseContents tvMap conKey (Right conVal) 'conNotFoundFailObjectSingleField)
786+ (normalB $ parseContents conKey (Right conVal) 'conNotFoundFailObjectSingleField)
842 []
787 []
843 , do other <- newName "other"
788 , do other <- newName "other"
844 match (varP other)
789 match (varP other)
845 (normalB $ [|wrongPairCountFail|]
790 (normalB $ [|wrongPairCountFail|]
846− `appE` litE (stringL $ show tName)
791+ `appE` (litE $ stringL $ show tName)
847 `appE` ([|show . length|] `appE` varE other)
792 `appE` ([|show . length|] `appE` varE other)
848 )
793 )
849 []
794 []
850 ]
795 ]
851
796
852− parseContents tvMap conKey contents errorFun =
797+ parseContents conKey contents errorFun =
853 caseE (varE conKey)
798 caseE (varE conKey)
854 [ match wildP
799 [ match wildP
855 ( guardedB $
800 ( guardedB $
@@ -857,8 +802,7 @@ consFromJSON jc tName opts instTys cons = do
857 [|(==)|]
802 [|(==)|]
858 ([|T.pack|] `appE`
803 ([|T.pack|] `appE`
859 conNameExp opts con)
804 conNameExp opts con)
860− e <- checkExi tvMap con $
861− parseArgs jc tvMap tName opts con contents
805+ e <- parseArgs tName opts con contents
862 return (g, e)
806 return (g, e)
863 | con <- cons
807 | con <- cons
864 ]
808 ]
@@ -866,12 +810,12 @@ consFromJSON jc tName opts instTys cons = do
866 [ liftM2 (,)
810 [ liftM2 (,)
867 (normalG [e|otherwise|])
811 (normalG [e|otherwise|])
868 ( varE errorFun
812 ( varE errorFun
869− `appE` litE (stringL $ show tName)
813+ `appE` (litE $ stringL $ show tName)
870 `appE` listE (map ( litE
814 `appE` listE (map ( litE
871 . stringL
815 . stringL
872 . constructorTagModifier opts
816 . constructorTagModifier opts
873 . nameBase
817 . nameBase
874− . constructorName
818+ . getConName
875 ) cons
819 ) cons
876 )
820 )
877 `appE` ([|T.unpack|] `appE` varE conKey)
821 `appE` ([|T.unpack|] `appE` varE conKey)
@@ -885,13 +829,13 @@ parseNullaryMatches :: Name -> Name -> [Q Match]
885parseNullaryMatches tName conName =
829parseNullaryMatches tName conName =
886 [ do arr <- newName "arr"
830 [ do arr <- newName "arr"
887 match (conP 'Array [varP arr])
831 match (conP 'Array [varP arr])
888− (guardedB
832+ (guardedB $
889 [ liftM2 (,) (normalG $ [|V.null|] `appE` varE arr)
833 [ liftM2 (,) (normalG $ [|V.null|] `appE` varE arr)
890 ([|pure|] `appE` conE conName)
834 ([|pure|] `appE` conE conName)
891 , liftM2 (,) (normalG [|otherwise|])
835 , liftM2 (,) (normalG [|otherwise|])
892 (parseTypeMismatch tName conName
836 (parseTypeMismatch tName conName
893 (litE $ stringL "an empty Array")
837 (litE $ stringL "an empty Array")
894− (infixApp (litE $ stringL "Array of length ")
838+ (infixApp (litE $ stringL $ "Array of length ")
895 [|(++)|]
839 [|(++)|]
896 ([|show . V.length|] `appE` varE arr)
840 ([|show . V.length|] `appE` varE arr)
897 )
841 )
@@ -902,60 +846,30 @@ parseNullaryMatches tName conName =
902 , matchFailed tName conName "Array"
846 , matchFailed tName conName "Array"
903 ]
847 ]
904
848
905−parseUnaryMatches :: JSONClass -> TyVarMap -> Type -> Name -> [Q Match]
849+parseUnaryMatches :: Name -> [Q Match]
906−parseUnaryMatches jc tvMap argTy conName =
850+parseUnaryMatches conName =
907 [ do arg <- newName "arg"
851 [ do arg <- newName "arg"
908 match (varP arg)
852 match (varP arg)
909 ( normalB $ infixApp (conE conName)
853 ( normalB $ infixApp (conE conName)
910 [|(<$>)|]
854 [|(<$>)|]
911− (dispatchParseJSON jc conName tvMap argTy
912− `appE` varE arg)
855+ ([|parseJSON|] `appE` varE arg)
913 )
856 )
914 []
857 []
915 ]
858 ]
916
859
917−parseRecord :: JSONClass
860+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 =
861+parseRecord opts tName conName ts obj =
928− (if rejectUnknownFields opts
929− then infixApp checkUnknownRecords [|(>>)|]
930− else id) $
931 foldl' (\a b -> infixApp a [|(<*>)|] b)
862 foldl' (\a b -> infixApp a [|(<*>)|] b)
932 (infixApp (conE conName) [|(<$>)|] x)
863 (infixApp (conE conName) [|(<$>)|] x)
933 xs
864 xs
934 where
865 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|]
866 x:xs = [ [|lookupField|]
952− `appE` dispatchParseJSON jc conName tvMap argTy
953− `appE` litE (stringL $ show tName)
867+ `appE` (litE $ stringL $ show tName)
954− `appE` litE (stringL $ constructorTagModifier opts $ nameBase conName)
868+ `appE` (litE $ stringL $ constructorTagModifier opts $ nameBase conName)
955− `appE` varE obj
869+ `appE` (varE obj)
956− `appE` ( [|T.pack|] `appE` stringE (fieldLabel opts field)
870+ `appE` ( [|T.pack|] `appE` fieldLabelExp opts field
957 )
871 )
958− | (field, argTy) <- zip fields argTys
872+ | (field, _, _) <- ts
959 ]
873 ]
960
874
961getValField :: Name -> String -> [MatchQ] -> Q Exp
875getValField :: Name -> String -> [MatchQ] -> Q Exp
@@ -964,112 +878,84 @@ getValField obj valFieldName matches = do
964 doE [ bindS (varP val) $ infixApp (varE obj)
878 doE [ bindS (varP val) $ infixApp (varE obj)
965 [|(.:)|]
879 [|(.:)|]
966 ([|T.pack|] `appE`
880 ([|T.pack|] `appE`
967− litE (stringL valFieldName))
881+ (litE $ stringL valFieldName))
968 , noBindS $ caseE (varE val) matches
882 , noBindS $ caseE (varE val) matches
969 ]
883 ]
970
884
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.
885-- | 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.
886+parseArgs :: Name -- ^ Name of the type to which the constructor belongs.
980 -> Options -- ^ Encoding options.
887 -> Options -- ^ Encoding options.
981− -> ConstructorInfo -- ^ Constructor for which to generate JSON parsing code.
888+ -> Con -- ^ Constructor for which to generate JSON parsing code.
982 -> Either (String, Name) Name -- ^ Left (valFieldName, objName) or
889 -> Either (String, Name) Name -- ^ Left (valFieldName, objName) or
983 -- Right valName
890 -- Right valName
984 -> Q Exp
891 -> Q Exp
985-- Nullary constructors.
892-- Nullary constructors.
986−parseArgs _ _ _ _
893+parseArgs _ _ (NormalC conName []) (Left _) =
987− ConstructorInfo { constructorName = conName
988− , constructorVariant = NormalConstructor
989− , constructorFields = [] }
990− (Left _) =
991− [|pure|] `appE` conE conName
894+ [|pure|] `appE` conE conName
992−parseArgs _ _ tName _
895+parseArgs tName _ (NormalC conName []) (Right valName) =
993− ConstructorInfo { constructorName = conName
994− , constructorVariant = NormalConstructor
995− , constructorFields = [] }
996− (Right valName) =
997− caseE (varE valName) $ parseNullaryMatches tName conName
896+ caseE (varE valName) $ parseNullaryMatches tName conName
998
897
999-- Unary constructors.
898-- Unary constructors.
1000−parseArgs jc tvMap _ _
899+parseArgs _ _ (NormalC conName [_]) (Left (valFieldName, obj)) =
1001− ConstructorInfo { constructorName = conName
900+ getValField obj valFieldName $ parseUnaryMatches conName
1002− , constructorVariant = NormalConstructor
901+parseArgs _ _ (NormalC conName [_]) (Right valName) =
1003− , constructorFields = [argTy] }
1004− contents = do
1005− argTy' <- resolveTypeSynonyms argTy
1006− matchCases contents $ parseUnaryMatches jc tvMap argTy' conName
902+ caseE (varE valName) $ parseUnaryMatches conName
1007
903
1008-- Polyadic constructors.
904-- Polyadic constructors.
1009−parseArgs jc tvMap tName _
905+parseArgs tName _ (NormalC conName ts) (Left (valFieldName, obj)) =
1010− ConstructorInfo { constructorName = conName
906+ getValField obj valFieldName $ parseProduct tName conName $ genericLength ts
1011− , constructorVariant = NormalConstructor
907+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
908+ caseE (varE valName) $ parseProduct tName conName $ genericLength ts
1017
909
1018-- Records.
910-- Records.
1019−parseArgs jc tvMap tName opts
911+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
912+ 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
913+parseArgs tName opts (RecC conName ts) (Right valName) = case (unwrapUnaryRecords opts,ts) of
1032− (True,[_])-> parseArgs jc tvMap tName opts
914+ (True,[(_,st,ty)])-> parseArgs tName opts (NormalC conName [(st,ty)]) (Right valName)
1033− (info{constructorVariant = NormalConstructor})
1034− (Right valName)
1035− _ -> do
915+ _ -> do
1036− obj <- newName "recObj"
916+ obj <- newName "recObj"
1037− argTys' <- mapM resolveTypeSynonyms argTys
1038− caseE (varE valName)
917+ caseE (varE valName)
1039− [ match (conP 'Object [varP obj]) (normalB $
918+ [ 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"
919+ , matchFailed tName conName "Object"
1042− ]
920+ ]
1043
921
1044-- Infix constructors. Apart from syntax these are the same as
922-- Infix constructors. Apart from syntax these are the same as
1045-- polyadic constructors.
923-- polyadic constructors.
1046−parseArgs jc tvMap tName _
924+parseArgs tName _ (InfixC _ conName _) (Left (valFieldName, obj)) =
1047− ConstructorInfo { constructorName = conName
925+ getValField obj valFieldName $ parseProduct tName conName 2
1048− , constructorVariant = InfixConstructor
926+parseArgs tName _ (InfixC _ conName _) (Right valName) =
1049− , constructorFields = argTys }
927+ caseE (varE valName) $ parseProduct tName conName 2
1050− contents = do
928+
1051− argTys' <- mapM resolveTypeSynonyms argTys
929+-- Existentially quantified constructors. We ignore the quantifiers
1052− matchCases contents $ parseProduct jc tvMap argTys' tName conName 2
930+-- and proceed with the contained constructor.
931+parseArgs tName opts (ForallC _ _ con) contents =
932+ parseArgs tName opts con contents
933+
934+#if MIN_VERSION_template_haskell(2,11,0)
935+-- GADTs. We ignore the refined return type and proceed as if it were a
936+-- NormalC or RecC.
937+parseArgs tName opts (GadtC conNames ts _) contents =
938+ parseArgs tName opts (NormalC (head conNames) ts) contents
939+
940+parseArgs tName opts (RecGadtC conNames ts _) contents =
941+ parseArgs tName opts (RecC (head conNames) ts) contents
942+#endif
1053
943
1054-- | Generates code to parse the JSON encoding of an n-ary
944-- | Generates code to parse the JSON encoding of an n-ary
1055-- constructor.
945-- 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.
946+parseProduct :: Name -- ^ Name of the type to which the constructor belongs.
1061 -> Name -- ^ 'Con'structor name.
947 -> Name -- ^ 'Con'structor name.
1062 -> Integer -- ^ 'Con'structor arity.
948 -> Integer -- ^ 'Con'structor arity.
1063 -> [Q Match]
949 -> [Q Match]
1064−parseProduct jc tvMap argTys tName conName numArgs =
950+parseProduct tName conName numArgs =
1065 [ do arr <- newName "arr"
951 [ do arr <- newName "arr"
1066 -- List of: "parseJSON (arr `V.unsafeIndex` <IX>)"
952 -- List of: "parseJSON (arr `V.unsafeIndex` <IX>)"
1067− let x:xs = [ dispatchParseJSON jc conName tvMap argTy
953+ let x:xs = [ [|parseJSON|]
1068 `appE`
954 `appE`
1069 infixApp (varE arr)
955 infixApp (varE arr)
1070 [|V.unsafeIndex|]
956 [|V.unsafeIndex|]
1071 (litE $ integerL ix)
957 (litE $ integerL ix)
1072− | (argTy, ix) <- zip argTys [0 .. numArgs - 1]
958+ | ix <- [0 .. numArgs - 1]
1073 ]
959 ]
1074 match (conP 'Array [varP arr])
960 match (conP 'Array [varP arr])
1075 (normalB $ condE ( infixApp ([|V.length|] `appE` varE arr)
961 (normalB $ condE ( infixApp ([|V.length|] `appE` varE arr)
@@ -1082,7 +968,7 @@ parseProduct jc tvMap argTys tName conName numArgs =
1082 )
968 )
1083 ( parseTypeMismatch tName conName
969 ( parseTypeMismatch tName conName
1084 (litE $ stringL $ "Array of length " ++ show numArgs)
970 (litE $ stringL $ "Array of length " ++ show numArgs)
1085− ( infixApp (litE $ stringL "Array of length ")
971+ ( infixApp (litE $ stringL $ "Array of length ")
1086 [|(++)|]
972 [|(++)|]
1087 ([|show . V.length|] `appE` varE arr)
973 ([|show . V.length|] `appE` varE arr)
1088 )
974 )
@@ -1092,6 +978,7 @@ parseProduct jc tvMap argTys tName conName numArgs =
1092 , matchFailed tName conName "Array"
978 , matchFailed tName conName "Array"
1093 ]
979 ]
1094
980
981+
1095--------------------------------------------------------------------------------
982--------------------------------------------------------------------------------
1096-- Parsing errors
983-- Parsing errors
1097--------------------------------------------------------------------------------
984--------------------------------------------------------------------------------
@@ -1116,27 +1003,17 @@ parseTypeMismatch tName conName expected actual =
1116 , actual
1003 , actual
1117 ]
1004 ]
1118
1005
1119−class LookupField a where
1006+class (FromJSON a) => LookupField a where
1120− lookupField :: (Value -> Parser a) -> String -> String
1121− -> Object -> T.Text -> Parser a
1007+ lookupField :: String -> String -> Object -> T.Text -> Parser a
1122−
1123−instance OVERLAPPABLE_ LookupField a where
1124− lookupField = lookupFieldWith
1125
1008
1126−instance INCOHERENT_ LookupField (Maybe a) where
1009+instance OVERLAPPABLE_ (FromJSON a) => LookupField a where
1127− lookupField pj _ _ = parseOptionalFieldWith pj
1010+ lookupField tName rec obj key =
1011+ case H.lookup key obj of
1012+ Nothing -> unknownFieldFail tName rec (T.unpack key)
1013+ Just v -> parseJSON v <?> Key key
1128
1014
1129−instance INCOHERENT_ LookupField (Semigroup.Option a) where
1015+instance (FromJSON a) => LookupField (Maybe a) where
1130− lookupField pj tName rec obj key =
1016+ lookupField _ _ = (.:?)
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
1017
1141unknownFieldFail :: String -> String -> String -> Parser fail
1018unknownFieldFail :: String -> String -> String -> Parser fail
1142unknownFieldFail tName rec key =
1019unknownFieldFail tName rec key =
@@ -1187,295 +1064,284 @@ parseTypeMismatch' conName tName expected actual =
1187 fail $ printf "When parsing the constructor %s of type %s expected %s but got %s."
1064 fail $ printf "When parsing the constructor %s of type %s expected %s but got %s."
1188 conName tName expected actual
1065 conName tName expected actual
1189
1066
1067+
1190--------------------------------------------------------------------------------
1068--------------------------------------------------------------------------------
1191−-- Shared ToJSON and FromJSON code
1069+-- Utility functions
1192--------------------------------------------------------------------------------
1070--------------------------------------------------------------------------------
1193
1071
1194−-- | Functionality common to 'deriveJSON', 'deriveJSON1', and 'deriveJSON2'.
1072+-- | Boilerplate for top level splices.
1195−deriveJSONBoth :: (Options -> Name -> Q [Dec])
1073+--
1196− -- ^ Function which derives a flavor of 'ToJSON'.
1074+-- The given 'Name' must meet one of two criteria:
1197− -> (Options -> Name -> Q [Dec])
1075+--
1198− -- ^ Function which derives a flavor of 'FromJSON'.
1076+-- 1. It must be the name of a type constructor of a plain data type or newtype.
1199− -> Options
1077+-- 2. It must be the name of a data family instance or newtype instance constructor.
1200− -- ^ Encoding options.
1078+
1201− -> Name
1079+-- Any other value will result in an exception.
1202− -- ^ Name of the type for which to generate 'ToJSON' and 'FromJSON'
1080+withType :: Name
1203− -- instances.
1081+ -> (Name -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q a)
1204− -> Q [Dec]
1082+ -- ^ Function that generates the actual code. Will be applied
1205−deriveJSONBoth dtj dfj opts name =
1083+ -- to the datatype/data family 'Name', type variable binders and
1206− liftM2 (++) (dtj opts name) (dfj opts name)
1084+ -- constructors extracted from the given 'Name'. If the 'Name' is
1207−
1085+ -- from a data family instance constructor, it will also have its
1208−-- | Functionality common to @deriveToJSON(1)(2)@ and @deriveFromJSON(1)(2)@.
1086+ -- instantiated types; otherwise, it will be 'Nothing'.
1209−deriveJSONClass :: [(JSONFun, JSONClass -> Name -> Options -> [Type]
1087+ -> Q a
1210− -> [ConstructorInfo] -> Q Exp)]
1088+ -- ^ Resulting value in the 'Q'uasi monad.
1211− -- ^ The class methods and the functions which derive them.
1089+withType name f = do
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
1090+ info <- reify name
1222− case info of
1091+ case info of
1223− DatatypeInfo { datatypeContext = ctxt
1092+ TyConI dec ->
1224− , datatypeName = parentName
1093+ case dec of
1225−#if MIN_VERSION_th_abstraction(0,3,0)
1094+#if MIN_VERSION_template_haskell(2,11,0)
1226− , datatypeInstTypes = instTys
1095+ DataD _ _ tvbs _ cons _ -> f name tvbs cons Nothing
1096+ NewtypeD _ _ tvbs _ con _ -> f name tvbs [con] Nothing
1227#else
1097#else
1228− , datatypeVars = instTys
1098+ DataD _ _ tvbs cons _ -> f name tvbs cons Nothing
1099+ NewtypeD _ _ tvbs con _ -> f name tvbs [con] Nothing
1229#endif
1100#endif
1230− , datatypeVariant = variant
1101+ other -> error $ ns ++ "Unsupported type: " ++ show other
1231− , datatypeCons = cons
1102+#if MIN_VERSION_template_haskell(2,11,0)
1232− } -> do
1103+ DataConI _ _ parentName -> 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
1104#else
1264− , datatypeVars = instTys
1105+ DataConI _ _ parentName _ -> do
1265#endif
1106#endif
1266− , datatypeVariant = variant
1107+ parentInfo <- reify parentName
1267− , datatypeCons = cons
1108+ case parentInfo of
1268− } -> do
1109+#if MIN_VERSION_template_haskell(2,11,0)
1269− -- We force buildTypeInstance here since it performs some checks for whether
1110+ FamilyI (DataFamilyD _ tvbs _) decs ->
1270− -- or not the provided datatype's kind matches the derived method's
1111+#else
1271− -- typeclass, and produces errors if it can't.
1112+ FamilyI (FamilyD DataFam _ tvbs _) decs ->
1272− !_ <- buildTypeInstance parentName jc ctxt instTys variant
1113+#endif
1273− consFun jc parentName opts instTys cons
1114+ let instDec = flip find decs $ \dec -> case dec of
1274−
1115+#if MIN_VERSION_template_haskell(2,11,0)
1275−dispatchFunByType :: JSONClass
1116+ DataInstD _ _ _ _ cons _ -> any ((name ==) . getConName) cons
1276− -> JSONFun
1117+ NewtypeInstD _ _ _ _ con _ -> name == getConName con
1277− -> Name
1118+#else
1278− -> TyVarMap
1119+ DataInstD _ _ _ cons _ -> any ((name ==) . getConName) cons
1279− -> Bool -- True if we are using the function argument that works
1120+ NewtypeInstD _ _ _ con _ -> name == getConName con
1280− -- on lists (e.g., [a] -> Value). False is we are using
1121+#endif
1281− -- the function argument that works on single values
1122+ _ -> error $ ns ++ "Must be a data or newtype instance."
1282− -- (e.g., a -> Value).
1123+ in case instDec of
1283− -> Type
1124+#if MIN_VERSION_template_haskell(2,11,0)
1284− -> Q Exp
1125+ Just (DataInstD _ _ instTys _ cons _) -> f parentName tvbs cons $ Just instTys
1285−dispatchFunByType _ jf _ tvMap list (VarT tyName) =
1126+ Just (NewtypeInstD _ _ instTys _ con _) -> f parentName tvbs [con] $ Just instTys
1286− varE $ case M.lookup tyName tvMap of
1127+#else
1287− Just (tfjExp, tfjlExp) -> if list then tfjlExp else tfjExp
1128+ Just (DataInstD _ _ instTys cons _) -> f parentName tvbs cons $ Just instTys
1288− Nothing -> jsonFunValOrListName list jf Arity0
1129+ Just (NewtypeInstD _ _ instTys con _) -> f parentName tvbs [con] $ Just instTys
1289−dispatchFunByType jc jf conName tvMap list (SigT ty _) =
1130+#endif
1290− dispatchFunByType jc jf conName tvMap list ty
1131+ _ -> error $ ns ++
1291−dispatchFunByType jc jf conName tvMap list (ForallT _ _ ty) =
1132+ "Could not find data or newtype instance constructor."
1292− dispatchFunByType jc jf conName tvMap list ty
1133+ _ -> error $ ns ++ "Data constructor " ++ show name ++
1293−dispatchFunByType jc jf conName tvMap list ty = do
1134+ " is not from a data family instance constructor."
1294− let tyCon :: Type
1135+#if MIN_VERSION_template_haskell(2,11,0)
1295− tyArgs :: [Type]
1136+ FamilyI DataFamilyD{} _ ->
1296− tyCon :| tyArgs = unapplyTy ty
1137+#else
1297−
1138+ FamilyI (FamilyD DataFam _ _ _) _ ->
1298− numLastArgs :: Int
1139+#endif
1299− numLastArgs = min (arityInt jc) (length tyArgs)
1140+ error $ ns ++
1300−
1141+ "Cannot use a data family name. Use a data family instance constructor instead."
1301− lhsArgs, rhsArgs :: [Type]
1142+ _ -> error $ ns ++ "I need the name of a plain data type constructor, "
1302− (lhsArgs, rhsArgs) = splitAt (length tyArgs - numLastArgs) tyArgs
1143+ ++ "or a data family instance constructor."
1303−
1144+ where
1304− tyVarNames :: [Name]
1145+ ns :: String
1305− tyVarNames = M.keys tvMap
1146+ ns = "Data.Aeson.TH.withType: "
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−
1327−--------------------------------------------------------------------------------
1328−-- Utility functions
1329−--------------------------------------------------------------------------------
1330
1147
1331−-- For the given Types, generate an instance context and head.
1148+-- | Infer the context and instance head needed for a FromJSON or ToJSON instance.
1332buildTypeInstance :: Name
1149buildTypeInstance :: Name
1333 -- ^ The type constructor or data family name
1150 -- ^ The type constructor or data family name
1334− -> JSONClass
1151+ -> Name
1335− -- ^ The typeclass to derive
1152+ -- ^ The typeclass name ('ToJSON' or 'FromJSON')
1336− -> Cxt
1153+ -> [TyVarBndr]
1337− -- ^ The datatype context
1154+ -- ^ The type variables from the data type/data family declaration
1338− -> [Type]
1155+ -> Maybe [Type]
1339− -- ^ The types to instantiate the instance with
1156+ -- ^ 'Just' the types used to instantiate a data family instance,
1340− -> DatatypeVariant
1157+ -- or 'Nothing' if it's a plain data type
1341− -- ^ Are we dealing with a data family instance or not
1342 -> Q (Cxt, Type)
1158 -> Q (Cxt, Type)
1159+ -- ^ The resulting 'Cxt' and 'Type' to use in a class instance
1160+-- Plain data type/newtype case
1343−buildTypeInstance tyConName jc dataCxt varTysOrig variant = do
1161+buildTypeInstance tyConName constraint tvbs Nothing =
1344− -- Make sure to expand through type/kind synonyms! Otherwise, the
1162+ let varTys :: [Type]
1345− -- eta-reduction check might get tripped up over type variables in a
1163+ varTys = map tvbToType tvbs
1346− -- synonym that are actually dropped.
1164+ in buildTypeInstanceFromTys tyConName constraint varTys False
1347− -- (See GHC Trac #11416 for a scenario where this actually happened.)
1165+-- Data family instance case
1348− varTysExp <- mapM resolveTypeSynonyms varTysOrig
1166+--
1349−
1167+-- The CPP is present to work around a couple of annoying old GHC bugs.
1350− let remainingLength :: Int
1168+-- See Note [Polykinded data families in Template Haskell]
1351− remainingLength = length varTysOrig - arityInt jc
1169+buildTypeInstance dataFamName constraint tvbs (Just instTysAndKinds) = do
1352−
1170+#if !(MIN_VERSION_template_haskell(2,8,0)) || MIN_VERSION_template_haskell(2,10,0)
1353− droppedTysExp :: [Type]
1171+ let instTys :: [Type]
1354− droppedTysExp = drop remainingLength varTysExp
1172+ instTys = zipWith stealKindForType tvbs instTysAndKinds
1355−
1173+#else
1356− droppedStarKindStati :: [StarKindStatus]
1174+ let kindVarNames :: [Name]
1357− droppedStarKindStati = map canRealizeKindStar droppedTysExp
1175+ kindVarNames = nub $ concatMap (tyVarNamesOfType . tvbKind) tvbs
1358−
1176+
1359− -- Check there are enough types to drop and that all of them are either of
1177+ -- Gets all of the type/kind variable names mentioned somewhere in a Type.
1360− -- kind * or kind k (for some kind variable k). If not, throw an error.
1178+ tyVarNamesOfType :: Type -> [Name]
1361− when (remainingLength < 0 || elem NotKindStar droppedStarKindStati) $
1179+ tyVarNamesOfType = go
1362− derivingKindError jc tyConName
1180+ where
1363−
1181+ go :: Type -> [Name]
1364− let droppedKindVarNames :: [Name]
1182+ go (AppT t1 t2) = go t1 ++ go t2
1365− droppedKindVarNames = catKindVarNames droppedStarKindStati
1183+ go (SigT t k) = go t ++ go k
1366−
1184+ go (VarT n) = [n]
1367− -- Substitute kind * for any dropped kind variables
1185+ go _ = []
1368− varTysExpSubst :: [Type]
1186+
1369− varTysExpSubst = map (substNamesWithKindStar droppedKindVarNames) varTysExp
1187+ numKindVars :: Int
1370−
1188+ numKindVars = length kindVarNames
1371− remainingTysExpSubst, droppedTysExpSubst :: [Type]
1189+
1372− (remainingTysExpSubst, droppedTysExpSubst) =
1190+ givenKinds, givenKinds' :: [Kind]
1373− splitAt remainingLength varTysExpSubst
1191+ givenTys :: [Type]
1374−
1192+ (givenKinds, givenTys) = splitAt numKindVars instTysAndKinds
1375− -- All of the type variables mentioned in the dropped types
1193+ givenKinds' = map sanitizeStars givenKinds
1376− -- (post-synonym expansion)
1194+
1377− droppedTyVarNames :: [Name]
1195+ -- A GHC 7.6-specific bug requires us to replace all occurrences of
1378− droppedTyVarNames = freeVariables droppedTysExpSubst
1196+ -- (ConT GHC.Prim.*) with StarT, or else Template Haskell will reject it.
1197+ -- Luckily, (ConT GHC.Prim.*) only seems to occur in this one spot.
1198+ sanitizeStars :: Kind -> Kind
1199+ sanitizeStars = go
1200+ where
1201+ go :: Kind -> Kind
1202+ go (AppT t1 t2) = AppT (go t1) (go t2)
1203+ go (SigT t k) = SigT (go t) (go k)
1204+ go (ConT n) | n == starKindName = StarT
1205+ go t = t
1206+
1207+ -- It's quite awkward to import * from GHC.Prim, so we'll just
1208+ -- hack our way around it.
1209+ starKindName :: Name
1210+ starKindName = mkNameG_tc "ghc-prim" "GHC.Prim" "*"
1211+
1212+ -- Generate a list of fresh names with a common prefix, and numbered suffixes.
1213+ newNameList :: String -> Int -> Q [Name]
1214+ newNameList prefix n = mapM (newName . (prefix ++) . show) [1..n]
1215+
1216+ -- If we run this code with GHC 7.8, we might have to generate extra type
1217+ -- variables to compensate for any type variables that Template Haskell
1218+ -- eta-reduced away.
1219+ -- See Note [Polykinded data families in Template Haskell]
1220+ xTypeNames <- newNameList "tExtra" (length tvbs - length givenTys)
1221+
1222+ let xTys :: [Type]
1223+ xTys = map VarT xTypeNames
1224+ -- ^ Because these type variables were eta-reduced away, we can only
1225+ -- determine their kind by using stealKindForType. Therefore, we mark
1226+ -- them as VarT to ensure they will be given an explicit kind annotation
1227+ -- (and so the kind inference machinery has the right information).
1228+
1229+ substNameWithKind :: Name -> Kind -> Type -> Type
1230+ substNameWithKind n k = substType (M.singleton n k)
1231+
1232+ substNamesWithKinds :: [(Name, Kind)] -> Type -> Type
1233+ substNamesWithKinds nks t = foldr' (uncurry substNameWithKind) t nks
1234+
1235+ -- The types from the data family instance might not have explicit kind
1236+ -- annotations, which the kind machinery needs to work correctly. To
1237+ -- compensate, we use stealKindForType to explicitly annotate any
1238+ -- types without kind annotations.
1239+ instTys :: [Type]
1240+ instTys = map (substNamesWithKinds (zip kindVarNames givenKinds'))
1241+ -- Note that due to a GHC 7.8-specific bug
1242+ -- (see Note [Polykinded data families in Template Haskell]),
1243+ -- there may be more kind variable names than there are kinds
1244+ -- to substitute. But this is OK! If a kind is eta-reduced, it
1245+ -- means that is was not instantiated to something more specific,
1246+ -- so we need not substitute it. Using stealKindForType will
1247+ -- grab the correct kind.
1248+ $ zipWith stealKindForType tvbs (givenTys ++ xTys)
1249+#endif
1250+ buildTypeInstanceFromTys dataFamName constraint instTys True
1379
1251
1380− -- If any of the dropped types were polykinded, ensure that they are of kind *
1252+-- For the given Types, generate an instance context and head.
1381− -- after substituting * for the dropped kind variables. If not, throw an error.
1253+buildTypeInstanceFromTys :: Name
1382− unless (all hasKindStar droppedTysExpSubst) $
1254+ -- ^ The type constructor or data family name
1383− derivingKindError jc tyConName
1255+ -> Name
1256+ -- ^ The typeclass name ('ToJSON' or 'FromJSON')
1257+ -> [Type]
1258+ -- ^ The types to instantiate the instance with
1259+ -> Bool
1260+ -- ^ True if it's a data family, False otherwise
1261+ -> Q (Cxt, Type)
1262+buildTypeInstanceFromTys tyConName constraint varTysOrig isDataFamily = do
1263+ -- Make sure to expand through type/kind synonyms! Otherwise, we won't
1264+ -- be able to infer constraints as accurately.
1265+ varTysExp <- mapM expandSyn varTysOrig
1384
1266
1385 let preds :: [Maybe Pred]
1267 let preds :: [Maybe Pred]
1386− kvNames :: [[Name]]
1387− kvNames' :: [Name]
1388− -- Derive instance constraints (and any kind variables which are specialized
1268+ -- Derive instance constraints for type variables of kind *
1389− -- to * in those constraints)
1390− (preds, kvNames) = unzip $ map (deriveConstraint jc) remainingTysExpSubst
1269+ preds = map (deriveConstraint constraint) varTysExp
1391− kvNames' = concat kvNames
1270+
1392−
1271+ varTys :: [Type]
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
1272 -- See Note [Kind signatures in derived instances] for an explanation
1428 -- of the isDataFamily check.
1273 -- of the isDataFamily check.
1429− remainingTysOrigSubst' =
1274+ varTys =
1430 if isDataFamily
1275 if isDataFamily
1431− then remainingTysOrigSubst
1276+ then varTysOrig
1432− else map unSigT remainingTysOrigSubst
1277+ else map unSigT varTysOrig
1433
1278
1434 instanceCxt :: Cxt
1279 instanceCxt :: Cxt
1435 instanceCxt = catMaybes preds
1280 instanceCxt = catMaybes preds
1436
1281
1437 instanceType :: Type
1282 instanceType :: Type
1438− instanceType = AppT (ConT $ jsonClassName jc)
1283+ instanceType = AppT (ConT constraint)
1439− $ applyTyCon tyConName remainingTysOrigSubst'
1284+ $ applyTyCon tyConName varTys
1440−
1285+
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)
1286 return (instanceCxt, instanceType)
1450
1287
1451−-- | Attempt to derive a constraint on a Type. If successful, return
1288+-- | Attempt to derive a constraint on a Type. If it's of kind *,
1452−-- Just the constraint and any kind variable names constrained to *.
1453−-- Otherwise, return Nothing and the empty list.
1289+-- we give it Just a ToJSON/FromJSON constraint. Otherwise, return Nothing.
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])
1290+deriveConstraint :: Name -> Type -> Maybe Pred
1458−deriveConstraint jc t
1291+deriveConstraint constraint t
1459− | not (isTyVar t) = (Nothing, [])
1460− | hasKindStar t = (Just (applyCon (jcConstraint Arity0) tName), [])
1292+ | isTyVar t && hasKindStar t = Just $ applyCon constraint $ varTToName t
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, [])
1293+ | otherwise = Nothing
1468− where
1469− tName :: Name
1470− tName = varTToName t
1471
1294
1472− jcArity :: Arity
1295+{-
1473− jcArity = arity jc
1296+Note [Polykinded data families in Template Haskell]
1297+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1474
1298
1475− jcConstraint :: Arity -> Name
1299+In order to come up with the correct instance context and head for an instance, e.g.,
1476− jcConstraint = jsonClassName . JSONClass (direction jc)
1300+
1301+ instance C a => C (Data a) where ...
1302+
1303+We need to know the exact types and kinds used to instantiate the instance. For
1304+plain old datatypes, this is simple: every type must be a type variable, and
1305+Template Haskell reliably tells us the type variables and their kinds.
1306+
1307+Doing the same for data families proves to be much harder for three reasons:
1308+
1309+1. On any version of Template Haskell, it may not tell you what an instantiated
1310+ type's kind is. For instance, in the following data family instance:
1311+
1312+ data family Fam (f :: * -> *) (a :: *)
1313+ data instance Fam f a
1314+
1315+ Then if we use TH's reify function, it would tell us the TyVarBndrs of the
1316+ data family declaration are:
1317+
1318+ [KindedTV f (AppT (AppT ArrowT StarT) StarT),KindedTV a StarT]
1319+
1320+ and the instantiated types of the data family instance are:
1321+
1322+ [VarT f1,VarT a1]
1323+
1324+ We can't just pass [VarT f1,VarT a1] to buildTypeInstanceFromTys, since we
1325+ have no way of knowing their kinds. Luckily, the TyVarBndrs tell us what the
1326+ kind is in case an instantiated type isn't a SigT, so we use the stealKindForType
1327+ function to ensure all of the instantiated types are SigTs before passing them
1328+ to buildTypeInstanceFromTys.
1329+2. On GHC 7.6 and 7.8, a bug is present in which Template Haskell lists all of
1330+ the specified kinds of a data family instance efore any of the instantiated
1331+ types. Fortunately, this is easy to deal with: you simply count the number of
1332+ distinct kind variables in the data family declaration, take that many elements
1333+ from the front of the Types list of the data family instance, substitute the
1334+ kind variables with their respective instantiated kinds (which you took earlier),
1335+ and proceed as normal.
1336+3. On GHC 7.8, an even uglier bug is present (GHC Trac #9692) in which Template
1337+ Haskell might not even list all of the Types of a data family instance, since
1338+ they are eta-reduced away! And yes, kinds can be eta-reduced too.
1339+
1340+ The simplest workaround is to count how many instantiated types are missing from
1341+ the list and generate extra type variables to use in their place. Luckily, we
1342+ needn't worry much if its kind was eta-reduced away, since using stealKindForType
1343+ will get it back.
1477
1344
1478−{-
1479Note [Kind signatures in derived instances]
1345Note [Kind signatures in derived instances]
1480~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1346~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1481
1347
@@ -1507,145 +1373,53 @@ knowing which instance we are talking about. To avoid this scenario, we always
1507include explicit kind signatures in data family instances. There is a chance that
1373include explicit kind signatures in data family instances. There is a chance that
1508the inferred kind signatures will be incorrect, but if so, we can always fall back
1374the inferred kind signatures will be incorrect, but if so, we can always fall back
1509on the mk- functions.
1375on 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-}
1376-}
1555
1377
1556−checkExistentialContext :: JSONClass -> TyVarMap -> Cxt -> Name
1378+-- | If a VarT is missing an explicit kind signature, steal it from a TyVarBndr.
1557− -> Q a -> Q a
1379+stealKindForType :: TyVarBndr -> Type -> Type
1558−checkExistentialContext jc tvMap ctxt conName q =
1380+stealKindForType tvb t@VarT{} = SigT t (tvbKind tvb)
1559− if (any (`predMentionsName` M.keys tvMap) ctxt
1381+stealKindForType _ t = t
1560− || M.size tvMap < arityInt jc)
1561− && not (allowExQuant jc)
1562− then existentialContextError conName
1563− else q
1564
1382
1565−{-
1383+-- | Extracts the kind from a type variable binder.
1566−Note [Matching functions with GADT type variables]
1384+tvbKind :: TyVarBndr -> Kind
1567−~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1385+#if MIN_VERSION_template_haskell(2,8,0)
1568−
1386+tvbKind (PlainTV _ ) = StarT
1569−When deriving ToJSON2, there is a tricky corner case to consider:
1387+#else
1570−
1388+tvbKind (PlainTV _ ) = StarK
1571− data Both a b where
1389+#endif
1572− BothCon :: x -> x -> Both x x
1390+tvbKind (KindedTV _ k) = k
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
1391
1592−-- A mapping of type variable Names to their encoding/decoding function Names.
1392+tvbToType :: TyVarBndr -> Type
1593−-- For example, in a ToJSON2 declaration, a TyVarMap might look like
1393+tvbToType (PlainTV n) = VarT n
1594−--
1394+tvbToType (KindedTV n k) = SigT (VarT n) k
1595−-- { a ~> (tj1, tjl1)
1596−-- , b ~> (tj2, tjl2) }
1597−--
1598−-- where a and b are the last two type variables of the datatype, tj1 and tjl1 are
1599−-- the function arguments of types (a -> Value) and ([a] -> Value), and tj2 and tjl2
1600−-- are the function arguments of types (b -> Value) and ([b] -> Value).
1601−type TyVarMap = Map Name (Name, Name)
1602
1395
1603-- | Returns True if a Type has kind *.
1396-- | Returns True if a Type has kind *.
1604hasKindStar :: Type -> Bool
1397hasKindStar :: Type -> Bool
1605hasKindStar VarT{} = True
1398hasKindStar VarT{} = True
1399+#if MIN_VERSION_template_haskell(2,8,0)
1606hasKindStar (SigT _ StarT) = True
1400hasKindStar (SigT _ StarT) = True
1401+#else
1402+hasKindStar (SigT _ StarK) = True
1403+#endif
1607hasKindStar _ = False
1404hasKindStar _ = False
1608
1405
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
1406-- | Extract the Name from a type variable. If the argument Type is not a
1642-- type variable, throw an error.
1407-- type variable, throw an error.
1643varTToName :: Type -> Name
1408varTToName :: Type -> Name
1409+varTToName (VarT n) = n
1410+varTToName (SigT t _) = varTToName t
1644−varTToName = fromMaybe (error "Not a type variable!") . varTToNameMaybe
1411+varTToName _ = error "Not a type variable!"
1645−
1412+
1646−interleave :: [a] -> [a] -> [a]
1413+-- | Extracts the name from a constructor.
1647−interleave (a1:a1s) (a2:a2s) = a1:a2:interleave a1s a2s
1414+getConName :: Con -> Name
1648−interleave _ _ = []
1415+getConName (NormalC name _) = name
1416+getConName (RecC name _) = name
1417+getConName (InfixC _ name _) = name
1418+getConName (ForallC _ _ con) = getConName con
1419+#if MIN_VERSION_template_haskell(2,11,0)
1420+getConName (GadtC names _ _) = head names
1421+getConName (RecGadtC names _ _) = head names
1422+#endif
1649
1423
1650-- | Fully applies a type constructor to its type variables.
1424-- | Fully applies a type constructor to its type variables.
1651applyTyCon :: Name -> [Type] -> Type
1425applyTyCon :: Name -> [Type] -> Type
@@ -1657,122 +1431,24 @@ isTyVar (VarT _) = True
1657isTyVar (SigT t _) = isTyVar t
1431isTyVar (SigT t _) = isTyVar t
1658isTyVar _ = False
1432isTyVar _ = False
1659
1433
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
1664− return $ case info of
1665−#if MIN_VERSION_template_haskell(2,11,0)
1666− FamilyI OpenTypeFamilyD{} _ -> True
1667−#else
1668− FamilyI (FamilyD TypeFam _ _ _) _ -> True
1669−#endif
1670− FamilyI ClosedTypeFamilyD{} _ -> True
1671− _ -> False
1672−isTyFamily _ = return False
1673−
1674-- | Peel off a kind signature from a Type (if it has one).
1434-- | Peel off a kind signature from a Type (if it has one).
1675unSigT :: Type -> Type
1435unSigT :: Type -> Type
1676unSigT (SigT t _) = t
1436unSigT (SigT t _) = t
1677unSigT t = t
1437unSigT t = t
1678
1438
1679−-- | Are all of the items in a list (which have an ordering) distinct?
1680−--
1681−-- This uses Set (as opposed to nub) for better asymptotic time complexity.
1682−allDistinct :: Ord a => [a] -> Bool
1683−allDistinct = allDistinct' Set.empty
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−
1763-- | Makes a string literal expression from a constructor's name.
1439-- | Makes a string literal expression from a constructor's name.
1764−conNameExp :: Options -> ConstructorInfo -> Q Exp
1440+conNameExp :: Options -> Con -> Q Exp
1765conNameExp opts = litE
1441conNameExp opts = litE
1766 . stringL
1442 . stringL
1767 . constructorTagModifier opts
1443 . constructorTagModifier opts
1768 . nameBase
1444 . nameBase
1769− . constructorName
1445+ . getConName
1770
1446
1771−-- | Extracts a record field label.
1447+-- | Creates a string literal expression from a record field label.
1772−fieldLabel :: Options -- ^ Encoding options
1448+fieldLabelExp :: Options -- ^ Encoding options
1773− -> Name
1449+ -> Name
1774− -> String
1450+ -> Q Exp
1775−fieldLabel opts = fieldLabelModifier opts . nameBase
1451+fieldLabelExp opts = litE . stringL . fieldLabelModifier opts . nameBase
1776
1452
1777-- | The name of the outermost 'Value' constructor.
1453-- | The name of the outermost 'Value' constructor.
1778valueConName :: Value -> String
1454valueConName :: Value -> String
@@ -1791,201 +1467,63 @@ applyCon con t =
1791 ClassP con [VarT t]
1467 ClassP con [VarT t]
1792#endif
1468#endif
1793
1469
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-------------------------------------------------------------------------------
1470-------------------------------------------------------------------------------
1811-- Expanding type synonyms
1471-- Expanding type synonyms
1812-------------------------------------------------------------------------------
1472-------------------------------------------------------------------------------
1813
1473
1814−applySubstitutionKind :: Map Name Kind -> Type -> Type
1474+-- | Expands all type synonyms in a type. Written by Dan Rosén in the
1815−applySubstitutionKind = applySubstitution
1475+-- @genifunctors@ package (licensed under BSD3).
1816−
1476+expandSyn :: Type -> Q Type
1817−substNameWithKind :: Name -> Kind -> Type -> Type
1477+expandSyn (ForallT tvs ctx t) = fmap (ForallT tvs ctx) $ expandSyn t
1818−substNameWithKind n k = applySubstitutionKind (M.singleton n k)
1478+expandSyn t@AppT{} = expandSynApp t []
1819−
1479+expandSyn t@ConT{} = expandSynApp t []
1820−substNamesWithKindStar :: [Name] -> Type -> Type
1480+expandSyn (SigT t k) = do t' <- expandSyn t
1821−substNamesWithKindStar ns t = foldr' (`substNameWithKind` starK) t ns
1481+ k' <- expandSynKind k
1822−
1482+ return (SigT t' k')
1823−-------------------------------------------------------------------------------
1483+expandSyn t = return t
1824−-- Error messages
1484+
1825−-------------------------------------------------------------------------------
1485+expandSynKind :: Kind -> Q Kind
1826−
1486+#if MIN_VERSION_template_haskell(2,8,0)
1827−-- | Either the given data type doesn't have enough type variables, or one of
1487+expandSynKind = expandSyn
1828−-- the type variables to be eta-reduced cannot realize kind *.
1488+#else
1829−derivingKindError :: JSONClass -> Name -> Q a
1489+expandSynKind = return -- There are no kind synonyms to deal with
1830−derivingKindError jc tyConName = fail
1490+#endif
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
1491
1969−-- | Whether a type is not of kind *, is of kind *, or is a kind variable.
1492+expandSynApp :: Type -> [Type] -> Q Type
1970−data StarKindStatus = NotKindStar
1493+expandSynApp (AppT t1 t2) ts = do
1971− | KindStar
1494+ t2' <- expandSyn t2
1972− | IsKindVar Name
1495+ expandSynApp t1 (t2':ts)
1973− deriving Eq
1496+expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl' AppT ListT ts
1974−
1497+expandSynApp t@(ConT n) ts = do
1975−-- | Does a Type have kind * or k (for some kind variable k)?
1498+ info <- reify n
1976−canRealizeKindStar :: Type -> StarKindStatus
1499+ case info of
1977−canRealizeKindStar t = case t of
1500+ TyConI (TySynD _ tvs rhs) ->
1978− _ | hasKindStar t -> KindStar
1501+ let (ts', ts'') = splitAt (length tvs) ts
1979− SigT _ (VarT k) -> IsKindVar k
1502+ subs = mkSubst tvs ts'
1980− _ -> NotKindStar
1503+ rhs' = substType subs rhs
1981−
1504+ in expandSynApp rhs' ts''
1982−-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
1505+ _ -> return $ foldl' AppT t ts
1983−-- Otherwise, returns 'Nothing'.
1506+expandSynApp t ts = do
1984−starKindStatusToName :: StarKindStatus -> Maybe Name
1507+ t' <- expandSyn t
1985−starKindStatusToName (IsKindVar n) = Just n
1508+ return $ foldl' AppT t' ts
1986−starKindStatusToName _ = Nothing
1509+
1987−
1510+type TypeSubst = Map Name Type
1988−-- | Concat together all of the StarKindStatuses that are IsKindVar and extract
1511+
1989−-- the kind variables' Names out.
1512+mkSubst :: [TyVarBndr] -> [Type] -> TypeSubst
1990−catKindVarNames :: [StarKindStatus] -> [Name]
1513+mkSubst vs ts =
1991−catKindVarNames = mapMaybe starKindStatusToName
1514+ let vs' = map un vs
1515+ un (PlainTV v) = v
1516+ un (KindedTV v _) = v
1517+ in M.fromList $ zip vs' ts
1518+
1519+substType :: TypeSubst -> Type -> Type
1520+substType subs (ForallT v c t) = ForallT v c $ substType subs t
1521+substType subs t@(VarT n) = M.findWithDefault t n subs
1522+substType subs (AppT t1 t2) = AppT (substType subs t1) (substType subs t2)
1523+substType subs (SigT t k) = SigT (substType subs t)
1524+#if MIN_VERSION_template_haskell(2,8,0)
1525+ (substType subs k)
1526+#else
1527+ k
1528+#endif
1529+substType _ t = t
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+13−63
@@ -1,4 +1,3 @@
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-2016 Bryan O'Sullivan
@@ -26,7 +25,6 @@ module Data.Aeson.Types
26 -- * Convenience types and functions
25 -- * Convenience types and functions
27 , DotNetTime(..)
26 , DotNetTime(..)
28 , typeMismatch
27 , typeMismatch
29− , unexpected
30 -- * Type conversion
28 -- * Type conversion
31 , Parser
29 , Parser
32 , Result(..)
30 , Result(..)
@@ -38,26 +36,14 @@ module Data.Aeson.Types
38 , ToJSON(..)
36 , ToJSON(..)
39 , KeyValue(..)
37 , KeyValue(..)
40 , modifyFailure
38 , modifyFailure
41− , prependFailure
42− , parserThrowError
43− , parserCatchError
44
39
45 -- ** Keys for maps
40 -- ** Keys for maps
46 , ToJSONKey(..)
41 , ToJSONKey(..)
47 , ToJSONKeyFunction(..)
42 , ToJSONKeyFunction(..)
48− , toJSONKeyText
49− , contramapToJSONKeyFunction
50 , FromJSONKey(..)
43 , FromJSONKey(..)
51 , FromJSONKeyFunction(..)
44 , FromJSONKeyFunction(..)
52 , fromJSONKeyCoerce
45 , fromJSONKeyCoerce
53 , coerceFromJSONKeyFunction
46 , coerceFromJSONKeyFunction
54− , mapFromJSONKeyFunction
55−
56− -- *** Generic keys
57− , GToJSONKey()
58− , genericToJSONKey
59− , GFromJSONKey()
60− , genericFromJSONKey
61
47
62 -- ** Liftings to unary and binary type constructors
48 -- ** Liftings to unary and binary type constructors
63 , FromJSON1(..)
49 , FromJSON1(..)
@@ -73,26 +59,19 @@ module Data.Aeson.Types
73
59
74 -- ** Generic JSON classes
60 -- ** Generic JSON classes
75 , GFromJSON(..)
61 , GFromJSON(..)
76− , FromArgs(..)
77− , GToJSON
62+ , GToJSON(..)
78− , GToEncoding
63+ , GToEncoding(..)
79− , ToArgs(..)
80− , Zero
81− , One
82 , genericToJSON
64 , genericToJSON
83− , genericLiftToJSON
84 , genericToEncoding
65 , genericToEncoding
85− , genericLiftToEncoding
86 , genericParseJSON
66 , genericParseJSON
87− , genericLiftParseJSON
88
67
89 -- * Inspecting @'Value's@
68 -- * Inspecting @'Value's@
90 , withObject
69 , withObject
91 , withText
70 , withText
92 , withArray
71 , withArray
72+ , withNumber
93 , withScientific
73 , withScientific
94 , withBool
74 , withBool
95− , withEmbeddedJSON
96
75
97 , pairs
76 , pairs
98 , foldable
77 , foldable
@@ -101,62 +80,33 @@ module Data.Aeson.Types
101 , (.:!)
80 , (.:!)
102 , (.!=)
81 , (.!=)
103 , object
82 , object
104− , parseField
105− , parseFieldMaybe
106− , parseFieldMaybe'
107− , explicitParseField
108− , explicitParseFieldMaybe
109− , explicitParseFieldMaybe'
110
83
111 , listEncoding
84 , listEncoding
112 , listValue
85 , listValue
113 , listParser
86 , listParser
114
87
115 -- * Generic and TH encoding configuration
88 -- * Generic and TH encoding configuration
116− , Options
89+ , 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(..)
90 , SumEncoding(..)
131 , camelTo
91 , camelTo
132 , camelTo2
92 , camelTo2
133 , defaultOptions
93 , defaultOptions
134 , defaultTaggedObject
94 , 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
95 ) where
148
96
149−import Prelude.Compat
97+import Data.Aeson.Types.Generic ()
150−
151−import Data.Aeson.Encoding (Encoding, unsafeToEncoding, fromEncoding, Series, pairs)
152−import Data.Aeson.Types.Class
98+import Data.Aeson.Types.Instances
153import Data.Aeson.Types.Internal
99import Data.Aeson.Types.Internal
100+
154−import Data.Foldable (toList)
101+import Data.Foldable (Foldable, toList)
102+import Data.Aeson.Encode.Functions (brackets)
155
103
156-- | Encode a 'Foldable' as a JSON array.
104-- | Encode a 'Foldable' as a JSON array.
157foldable :: (Foldable t, ToJSON a) => t a -> Encoding
105foldable :: (Foldable t, ToJSON a) => t a -> Encoding
158foldable = toEncoding . toList
106foldable = toEncoding . toList
159{-# INLINE foldable #-}
107{-# INLINE foldable #-}
160
108
161−-- $optionsFields
109+-- | Encode a series of key/value pairs, separated by commas.
162−-- The functions here are in fact record fields of the 'Options' type.
110+pairs :: Series -> Encoding
111+pairs = brackets '{' '}'
112+{-# INLINE pairs #-}
Data/Aeson/Types/Class.hs+518−58
@@ -1,11 +1,5 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP, GADTs, DefaultSignatures, FlexibleContexts, DeriveFunctor,
2−{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE GADTs #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−{-# LANGUAGE NoImplicitPrelude #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
2+ ScopedTypeVariables #-}
9
3
10-- |
4-- |
11-- Module: Data.Aeson.Types.Class
5-- Module: Data.Aeson.Types.Class
@@ -36,74 +30,540 @@ module Data.Aeson.Types.Class
36 , toEncoding2
30 , toEncoding2
37 -- * Generic JSON classes
31 -- * Generic JSON classes
38 , GFromJSON(..)
32 , GFromJSON(..)
39− , FromArgs(..)
40− , GToJSON
33+ , GToJSON(..)
41− , GToEncoding
34+ , GToEncoding(..)
42− , ToArgs(..)
43− , Zero
44− , One
45 , genericToJSON
35 , genericToJSON
46− , genericLiftToJSON
47 , genericToEncoding
36 , genericToEncoding
48− , genericLiftToEncoding
49 , genericParseJSON
37 , genericParseJSON
50− , genericLiftParseJSON
51 -- * Classes and types for map keys
38 -- * Classes and types for map keys
52 , ToJSONKey(..)
39 , ToJSONKey(..)
53 , ToJSONKeyFunction(..)
40 , ToJSONKeyFunction(..)
54− , toJSONKeyText
55 , contramapToJSONKeyFunction
41 , contramapToJSONKeyFunction
56 , FromJSONKey(..)
42 , FromJSONKey(..)
57 , FromJSONKeyFunction(..)
43 , FromJSONKeyFunction(..)
58 , fromJSONKeyCoerce
44 , fromJSONKeyCoerce
59 , coerceFromJSONKeyFunction
45 , coerceFromJSONKeyFunction
60 , mapFromJSONKeyFunction
46 , mapFromJSONKeyFunction
61− -- ** Generic keys
62− , GToJSONKey()
63− , genericToJSONKey
64− , GFromJSONKey()
65− , genericFromJSONKey
66 -- * Object key-value pairs
47 -- * Object key-value pairs
67 , KeyValue(..)
48 , KeyValue(..)
68−
49+ -- * Functions needed for documentation
50+ , typeMismatch
69− -- * List functions
51+ -- * Encoding functions
70 , listEncoding
52 , listEncoding
71 , listValue
53 , listValue
72 , listParser
54 , 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
55 ) where
99
56
57+import Data.Aeson.Types.Internal
58+import Data.Monoid ((<>))
59+import Data.Text (Text)
60+import GHC.Generics (Generic, Rep, from, to)
61+import Data.Aeson.Encode.Builder (emptyArray_)
62+import qualified Data.ByteString.Builder as B
63+import qualified Data.Aeson.Encode.Builder as E
64+import qualified Data.Vector as V
65+
66+#if !MIN_VERSION_base(4,8,0)
67+import Data.Monoid (mempty)
68+#endif
69+
70+-- Coercible derivations aren't as powerful on GHC 7.8, though supported.
71+#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 709)
72+
73+#if HAS_COERCIBLE
74+import Data.Coerce (Coercible, coerce)
75+coerce' :: Coercible a b => a -> b
76+coerce' = coerce
77+#else
78+import Unsafe.Coerce (unsafeCoerce)
79+coerce' :: a -> b
80+coerce' = unsafeCoerce
81+#endif
82+
83+-- | Class of generic representation types ('Rep') that can be converted to
84+-- JSON.
85+class GToJSON f where
86+ -- | This method (applied to 'defaultOptions') is used as the
87+ -- default generic implementation of 'toJSON'.
88+ gToJSON :: Options -> f a -> Value
89+
90+-- | Class of generic representation types ('Rep') that can be converted to
91+-- a JSON 'Encoding'.
92+class GToEncoding f where
93+ -- | This method (applied to 'defaultOptions') can be used as the
94+ -- default generic implementation of 'toEncoding'.
95+ gToEncoding :: Options -> f a -> Encoding
96+
97+-- | Class of generic representation types ('Rep') that can be converted from JSON.
98+class GFromJSON f where
99+ -- | This method (applied to 'defaultOptions') is used as the
100+ -- default generic implementation of 'parseJSON'.
101+ gParseJSON :: Options -> Value -> Parser (f a)
102+
103+-- | A configurable generic JSON creator. This function applied to
104+-- 'defaultOptions' is used as the default for 'toJSON' when the type
105+-- is an instance of 'Generic'.
106+genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value
107+genericToJSON opts = gToJSON opts . from
108+
109+-- | A configurable generic JSON encoder. This function applied to
110+-- 'defaultOptions' is used as the default for 'toEncoding' when the type
111+-- is an instance of 'Generic'.
112+genericToEncoding :: (Generic a, GToEncoding (Rep a)) => Options -> a -> Encoding
113+genericToEncoding opts = gToEncoding opts . from
114+
115+-- | A configurable generic JSON decoder. This function applied to
116+-- 'defaultOptions' is used as the default for 'parseJSON' when the
117+-- type is an instance of 'Generic'.
118+genericParseJSON :: (Generic a, GFromJSON (Rep a)) => Options -> Value -> Parser a
119+genericParseJSON opts = fmap to . gParseJSON opts
120+
121+-- | A type that can be converted to JSON.
122+--
123+-- An example type and instance:
124+--
125+-- @
126+-- \-- Allow ourselves to write 'Text' literals.
127+-- {-\# LANGUAGE OverloadedStrings #-}
128+--
129+-- data Coord = Coord { x :: Double, y :: Double }
130+--
131+-- instance ToJSON Coord where
132+-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
133+--
134+-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
135+-- @
136+--
137+-- Instead of manually writing your 'ToJSON' instance, there are two options
138+-- to do it automatically:
139+--
140+-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
141+-- instance at compile time. The generated instance is optimized for your type
142+-- so will probably be more efficient than the following two options:
143+--
144+-- * The compiler can provide a default generic implementation for
145+-- 'toJSON'.
146+--
147+-- To use the second, simply add a @deriving 'Generic'@ clause to your
148+-- datatype and declare a 'ToJSON' instance for your datatype without giving
149+-- definitions for 'toJSON' or 'toEncoding'.
150+--
151+-- For example, the previous example can be simplified to a more
152+-- minimal instance:
153+--
154+-- @
155+-- {-\# LANGUAGE DeriveGeneric \#-}
156+--
157+-- import "GHC.Generics"
158+--
159+-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
160+--
161+-- instance ToJSON Coord where
162+-- toEncoding = 'genericToEncoding' 'defaultOptions'
163+-- @
164+--
165+-- Why do we provide an implementation for 'toEncoding' here? The
166+-- 'toEncoding' function is a relatively new addition to this class.
167+-- To allow users of older versions of this library to upgrade without
168+-- having to edit all of their instances or encounter surprising
169+-- incompatibilities, the default implementation of 'toEncoding' uses
170+-- 'toJSON'. This produces correct results, but since it performs an
171+-- intermediate conversion to a 'Value', it will be less efficient
172+-- than directly emitting an 'Encoding'. Our one-liner definition of
173+-- 'toEncoding' above bypasses the intermediate 'Value'.
174+--
175+-- If @DefaultSignatures@ doesn't give exactly the results you want,
176+-- you can customize the generic encoding with only a tiny amount of
177+-- effort, using 'genericToJSON' and 'genericToEncoding' with your
178+-- preferred 'Options':
179+--
180+-- @
181+-- instance ToJSON Coord where
182+-- toJSON = 'genericToJSON' 'defaultOptions'
183+-- toEncoding = 'genericToEncoding' 'defaultOptions'
184+-- @
185+class ToJSON a where
186+ -- | Convert a Haskell value to a JSON-friendly intermediate type.
187+ toJSON :: a -> Value
188+
189+ default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value
190+ toJSON = genericToJSON defaultOptions
191+
192+ -- | Encode a Haskell value as JSON.
193+ --
194+ -- The default implementation of this method creates an
195+ -- intermediate 'Value' using 'toJSON'. This provides
196+ -- source-level compatibility for people upgrading from older
197+ -- versions of this library, but obviously offers no performance
198+ -- advantage.
199+ --
200+ -- To benefit from direct encoding, you /must/ provide an
201+ -- implementation for this method. The easiest way to do so is by
202+ -- having your types implement 'Generic' using the @DeriveGeneric@
203+ -- extension, and then have GHC generate a method body as follows.
204+ --
205+ -- @
206+ -- instance ToJSON Coord where
207+ -- toEncoding = 'genericToEncoding' 'defaultOptions'
208+ -- @
209+
210+ toEncoding :: a -> Encoding
211+ toEncoding = Encoding . E.encodeToBuilder . toJSON
212+ {-# INLINE toEncoding #-}
213+
214+ toJSONList :: [a] -> Value
215+ toJSONList = listValue toJSON
216+ {-# INLINE toJSONList #-}
217+
218+ toEncodingList :: [a] -> Encoding
219+ toEncodingList [] = emptyArray_
220+ toEncodingList (x:xs) = Encoding $
221+ B.char7 '[' <> builder x <> commas xs <> B.char7 ']'
222+ where
223+ commas = foldr (\v vs -> B.char7 ',' <> builder v <> vs) mempty
224+ builder = fromEncoding . toEncoding
225+ {-# INLINE toEncodingList #-}
226+
227+-- | A type that can be converted from JSON, with the possibility of
228+-- failure.
229+--
230+-- In many cases, you can get the compiler to generate parsing code
231+-- for you (see below). To begin, let's cover writing an instance by
232+-- hand.
233+--
234+-- There are various reasons a conversion could fail. For example, an
235+-- 'Object' could be missing a required key, an 'Array' could be of
236+-- the wrong size, or a value could be of an incompatible type.
237+--
238+-- The basic ways to signal a failed conversion are as follows:
239+--
240+-- * 'empty' and 'mzero' work, but are terse and uninformative
241+--
242+-- * 'fail' yields a custom error message
243+--
244+-- * 'typeMismatch' produces an informative message for cases when the
245+-- value encountered is not of the expected type
246+--
247+-- An example type and instance:
248+--
249+-- @
250+-- \-- Allow ourselves to write 'Text' literals.
251+-- {-\# LANGUAGE OverloadedStrings #-}
252+--
253+-- data Coord = Coord { x :: Double, y :: Double }
254+--
255+-- instance FromJSON Coord where
256+-- parseJSON ('Object' v) = Coord '<$>'
257+-- v '.:' \"x\" '<*>'
258+-- v '.:' \"y\"
259+--
260+-- \-- We do not expect a non-'Object' value here.
261+-- \-- We could use 'mzero' to fail, but 'typeMismatch'
262+-- \-- gives a much more informative error message.
263+-- parseJSON invalid = 'typeMismatch' \"Coord\" invalid
264+-- @
265+--
266+-- Instead of manually writing your 'FromJSON' instance, there are two options
267+-- to do it automatically:
268+--
269+-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
270+-- instance at compile time. The generated instance is optimized for your type
271+-- so will probably be more efficient than the following two options:
272+--
273+-- * The compiler can provide a default generic implementation for
274+-- 'parseJSON'.
275+--
276+-- To use the second, simply add a @deriving 'Generic'@ clause to your
277+-- datatype and declare a 'FromJSON' instance for your datatype without giving
278+-- a definition for 'parseJSON'.
279+--
280+-- For example, the previous example can be simplified to just:
281+--
282+-- @
283+-- {-\# LANGUAGE DeriveGeneric \#-}
284+--
285+-- import "GHC.Generics"
286+--
287+-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
288+--
289+-- instance FromJSON Coord
290+-- @
291+--
292+-- If @DefaultSignatures@ doesn't give exactly the results you want,
293+-- you can customize the generic decoding with only a tiny amount of
294+-- effort, using 'genericParseJSON' with your preferred 'Options':
295+--
296+-- @
297+-- instance FromJSON Coord where
298+-- parseJSON = 'genericParseJSON' 'defaultOptions'
299+-- @
300+
301+class FromJSON a where
302+ parseJSON :: Value -> Parser a
303+
304+ default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
305+ parseJSON = genericParseJSON defaultOptions
306+
307+ parseJSONList :: Value -> Parser [a]
308+ parseJSONList (Array a)
309+ = sequence
310+ . zipWith parseIndexedJSON [0..]
311+ . V.toList
312+ $ a
313+ where
314+ parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a
315+ parseIndexedJSON idx value = parseJSON value <?> Index idx
316+
317+ parseJSONList v = typeMismatch "[a]" v
318+
319+-------------------------------------------------------------------------------
320+-- Object key-value pairs
321+-------------------------------------------------------------------------------
322+
323+-- | A key-value pair for encoding a JSON object.
324+class KeyValue kv where
325+ (.=) :: ToJSON v => Text -> v -> kv
326+ infixr 8 .=
327+
328+-------------------------------------------------------------------------------
329+-- Classes and types for map keys
330+-------------------------------------------------------------------------------
331+
332+class ToJSONKey a where
333+ toJSONKey :: ToJSONKeyFunction a
334+ default toJSONKey :: ToJSON a => ToJSONKeyFunction a
335+ toJSONKey = ToJSONKeyValue (toJSON, toEncoding)
336+ toJSONKeyList :: ToJSONKeyFunction [a]
337+ default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
338+ toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)
339+
340+class FromJSONKey a where
341+ fromJSONKey :: FromJSONKeyFunction a
342+ default fromJSONKey :: FromJSON a => FromJSONKeyFunction a
343+ fromJSONKey = FromJSONKeyValue parseJSON
344+ fromJSONKeyList :: FromJSONKeyFunction [a]
345+ default fromJSONKeyList :: FromJSON a => FromJSONKeyFunction [a]
346+ fromJSONKeyList = FromJSONKeyValue parseJSON
347+
348+data ToJSONKeyFunction a
349+ = ToJSONKeyText (a -> Text, a -> Encoding)
350+ | ToJSONKeyValue (a -> Value, a -> Encoding)
351+
352+-- | With GHC 7.8 + we carry around 'Coercible Text a' dictionary,
353+-- to have even some amount of safety net.
354+-- Unfortunately we cannot enforce that 'Hashable' instance agree on the type level
355+--
356+-- ATM this type is intentionally not exported. FromJSONKeyFunction can be inspected,
357+-- but cannot be constructed.
358+data CoerceText a where
359+#if HAS_COERCIBLE
360+ CoerceText :: Coercible Text a => CoerceText a
361+#else
362+ CoerceText :: CoerceText a
363+#endif
364+
365+data FromJSONKeyFunction a
366+ = FromJSONKeyCoerce (CoerceText a)
367+ | FromJSONKeyText (Text -> a)
368+ | FromJSONKeyTextParser (Text -> Parser a)
369+ | FromJSONKeyValue (Value -> Parser a)
370+
371+instance Functor FromJSONKeyFunction where
372+ fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce')
373+ fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)
374+ fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)
375+ fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)
376+
377+-- | Construct 'FromJSONKeyFunction' for types coercible from 'Text'. This
378+-- conversion is still unsafe, as 'Hashable' and 'Eq' instances of @a@ should be
379+-- compatible with 'Text' i.e. hash values be equal for wrapped values as well.
380+fromJSONKeyCoerce ::
381+#if HAS_COERCIBLE
382+ Coercible Text a =>
383+#endif
384+ FromJSONKeyFunction a
385+fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
386+
387+coerceFromJSONKeyFunction ::
388+#if HAS_COERCIBLE
389+ Coercible a b =>
390+#endif
391+ FromJSONKeyFunction a -> FromJSONKeyFunction b
392+coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText
393+coerceFromJSONKeyFunction (FromJSONKeyText f) = FromJSONKeyText (coerce' . f)
394+coerceFromJSONKeyFunction (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap coerce' . f)
395+coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fmap coerce' . f)
396+
397+{-# RULES
398+ "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).
399+ fmap id x = x
400+ #-}
401+#if HAS_COERCIBLE
402+{-# RULES
403+ "FromJSONKeyCoerce: fmap coerce" forall x .
404+ fmap coerce x = coerceFromJSONKeyFunction x
405+ #-}
406+#endif
407+
408+contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
409+contramapToJSONKeyFunction h x = case x of
410+ ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)
411+ ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)
412+
413+mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
414+mapFromJSONKeyFunction = fmap
415+
416+-------------------------------------------------------------------------------
417+-- Functions needed for documentation
418+-------------------------------------------------------------------------------
419+
420+-- | Fail parsing due to a type mismatch, with a descriptive message.
421+--
422+-- Example usage:
423+--
424+-- @
425+-- instance FromJSON Coord where
426+-- parseJSON ('Object' v) = {- type matches, life is good -}
427+-- parseJSON wat = 'typeMismatch' \"Coord\" wat
428+-- @
429+typeMismatch :: String -- ^ The name of the type you are trying to parse.
430+ -> Value -- ^ The actual value encountered.
431+ -> Parser a
432+typeMismatch expected actual =
433+ fail $ "expected " ++ expected ++ ", encountered " ++ name
434+ where
435+ name = case actual of
436+ Object _ -> "Object"
437+ Array _ -> "Array"
438+ String _ -> "String"
439+ Number _ -> "Number"
440+ Bool _ -> "Boolean"
441+ Null -> "Null"
442+
443+-------------------------------------------------------------------------------
444+-- Lifings of FromJSON and ToJSON to unary and binary type constructors
445+-------------------------------------------------------------------------------
446+
447+-- | Lifting of the 'FromJSON' class to unary type constructors.
448+class FromJSON1 f where
449+ liftParseJSON :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
450+ liftParseJSONList :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser [f a]
451+ liftParseJSONList f g v = listParser (liftParseJSON f g) v
452+
453+-- | Lift the standard 'parseJSON' function through the type constructor.
454+parseJSON1 :: (FromJSON1 f, FromJSON a) => Value -> Parser (f a)
455+parseJSON1 = liftParseJSON parseJSON parseJSONList
456+{-# INLINE parseJSON1 #-}
457+
458+-- | Lifting of the 'ToJSON' class to unary type constructors.
459+class ToJSON1 f where
460+ liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
461+ liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value
462+ liftToJSONList f g = listValue (liftToJSON f g)
463+
464+ -- | Unfortunately there cannot be a default implementation of 'liftToEncoding'.
465+ liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
466+ liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
467+ liftToEncodingList f g = listEncoding (liftToEncoding f g)
468+
469+-- | Lift the standard 'toJSON' function through the type constructor.
470+toJSON1 :: (ToJSON1 f, ToJSON a) => f a -> Value
471+toJSON1 = liftToJSON toJSON toJSONList
472+{-# INLINE toJSON1 #-}
473+
474+-- | Lift the standard 'toEncoding' function through the type constructor.
475+toEncoding1 :: (ToJSON1 f, ToJSON a) => f a -> Encoding
476+toEncoding1 = liftToEncoding toEncoding toEncodingList
477+{-# INLINE toEncoding1 #-}
478+
479+
480+-- | Lifting of the 'FromJSON' class to binary type constructors.
481+class FromJSON2 f where
482+ liftParseJSON2
483+ :: (Value -> Parser a)
484+ -> (Value -> Parser [a])
485+ -> (Value -> Parser b)
486+ -> (Value -> Parser [b])
487+ -> Value -> Parser (f a b)
488+ liftParseJSONList2
489+ :: (Value -> Parser a)
490+ -> (Value -> Parser [a])
491+ -> (Value -> Parser b)
492+ -> (Value -> Parser [b])
493+ -> Value -> Parser [f a b]
494+ liftParseJSONList2 fa ga fb gb v = case v of
495+ Array vals -> fmap V.toList (V.mapM (liftParseJSON2 fa ga fb gb) vals)
496+ _ -> typeMismatch "[a]" v
497+
498+-- | Lift the standard 'parseJSON' function through the type constructor.
499+parseJSON2 :: (FromJSON2 f, FromJSON a, FromJSON b) => Value -> Parser (f a b)
500+parseJSON2 = liftParseJSON2 parseJSON parseJSONList parseJSON parseJSONList
501+{-# INLINE parseJSON2 #-}
502+
503+-- | Lifting of the 'ToJSON' class to binary type constructors.
504+class ToJSON2 f where
505+ liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> f a b -> Value
506+ liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [f a b] -> Value
507+ liftToJSONList2 fa ga fb gb = listValue (liftToJSON2 fa ga fb gb)
508+
509+ liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> f a b -> Encoding
510+ liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [f a b] -> Encoding
511+ liftToEncodingList2 fa ga fb gb = listEncoding (liftToEncoding2 fa ga fb gb)
512+
513+-- | Lift the standard 'toJSON' function through the type constructor.
514+toJSON2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Value
515+toJSON2 = liftToJSON2 toJSON toJSONList toJSON toJSONList
516+{-# INLINE toJSON2 #-}
517+
518+-- | Lift the standard 'toEncoding' function through the type constructor.
519+toEncoding2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Encoding
520+toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingList
521+{-# INLINE toEncoding2 #-}
522+
523+-------------------------------------------------------------------------------
524+-- Encoding functions
525+-------------------------------------------------------------------------------
526+
527+listEncoding :: (a -> Encoding) -> [a] -> Encoding
528+listEncoding _ [] = emptyArray_
529+listEncoding to' (x:xs) = Encoding $
530+ B.char7 '[' <> fromEncoding (to' x) <> commas xs <> B.char7 ']'
531+ where commas = foldr (\v vs -> B.char7 ',' <> fromEncoding (to' v) <> vs) mempty
532+{-# INLINE listEncoding #-}
533+
534+listValue :: (a -> Value) -> [a] -> Value
535+listValue f = Array . V.fromList . map f
536+{-# INLINE listValue #-}
537+
538+listParser :: (Value -> Parser a) -> Value -> Parser [a]
539+listParser f (Array xs) = fmap V.toList (V.mapM f xs)
540+listParser _ v = typeMismatch "[a]" v
541+{-# INLINE listParser #-}
542+
543+-------------------------------------------------------------------------------
544+-- [] instances
545+-------------------------------------------------------------------------------
546+
547+-- These are needed for key-class default definitions
548+
549+instance ToJSON1 [] where
550+ liftToJSON _ to' = to'
551+ {-# INLINE liftToJSON #-}
552+
553+ liftToEncoding _ to' = to'
554+ {-# INLINE liftToEncoding #-}
555+
556+instance (ToJSON a) => ToJSON [a] where
557+ toJSON = toJSON1
558+ {-# INLINE toJSON #-}
559+
560+ toEncoding = toEncoding1
561+ {-# INLINE toEncoding #-}
100
562
101−import Data.Aeson.Types.FromJSON
563+instance FromJSON1 [] where
102−import Data.Aeson.Types.Generic (One, Zero)
564+ liftParseJSON _ p' = p'
103−import Data.Aeson.Types.ToJSON hiding (GToJSON)
565+ {-# INLINE liftParseJSON #-}
104−import qualified Data.Aeson.Types.ToJSON as ToJSON
105−import Data.Aeson.Types.Internal (Value)
106−import Data.Aeson.Encoding (Encoding)
107
566
108−type GToJSON = ToJSON.GToJSON Value
567+instance (FromJSON a) => FromJSON [a] where
109−type GToEncoding = ToJSON.GToJSON Encoding
568+ parseJSON = parseJSON1
569+ {-# INLINE parseJSON #-}
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+746−57
@@ -1,14 +1,9 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveFunctor #-}
4−{-# LANGUAGE EmptyDataDecls #-}
5−{-# LANGUAGE FlexibleInstances #-}
1+{-# LANGUAGE CPP, DefaultSignatures, EmptyDataDecls, FlexibleInstances,
6−{-# LANGUAGE FunctionalDependencies #-}
2+ FunctionalDependencies, KindSignatures,
7−{-# LANGUAGE KindSignatures #-}
8−{-# LANGUAGE NoImplicitPrelude #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE TypeOperators #-}
11−{-# LANGUAGE UndecidableInstances #-}
3+ ScopedTypeVariables, TypeOperators, UndecidableInstances,
4+ ViewPatterns, NamedFieldPuns, FlexibleContexts, PatternGuards,
5+ RecordWildCards, DataKinds #-}
6+{-# OPTIONS_GHC -fno-warn-orphans #-}
12
7
13#include "overlapping-compat.h"
8#include "overlapping-compat.h"
14
9
@@ -22,31 +17,748 @@
22-- Stability: experimental
17-- Stability: experimental
23-- Portability: portable
18-- Portability: portable
24--
19--
25−-- Helpers for generic derivations.
20+-- 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
21
22+module Data.Aeson.Types.Generic ( ) where
23+
24+import Control.Applicative ((<|>))
25+import Control.Monad ((<=<))
26+import Control.Monad.ST (ST)
27+import Data.Aeson.Encode.Builder (emptyArray_)
28+import Data.Aeson.Encode.Functions (builder)
29+import Data.Aeson.Types.Instances
30+import Data.Aeson.Types.Internal
31+import Data.Bits (unsafeShiftR)
32+import Data.ByteString.Builder as B
33+import qualified Data.ByteString.Lazy as BSL (null)
34+import Data.DList (DList, toList, empty)
35+import Data.Maybe (fromMaybe)
36+import Data.Monoid ((<>))
37+import Data.List (intersperse)
38+import Data.Text (Text, pack, unpack)
43import GHC.Generics
39import GHC.Generics
40+import qualified Data.HashMap.Strict as H
41+import qualified Data.Vector as V
42+import qualified Data.Vector.Mutable as VM
43+
44+#if !MIN_VERSION_base(4,8,0)
45+import Control.Applicative ((<*>), (<$>), pure)
46+import Data.Monoid (mempty, mconcat)
47+#endif
48+
49+--------------------------------------------------------------------------------
50+-- Generic toJSON
51+
52+instance OVERLAPPABLE_ (GToJSON a) => GToJSON (M1 i c a) where
53+ -- Meta-information, which is not handled elsewhere, is ignored:
54+ gToJSON opts = gToJSON opts . unM1
55+
56+instance (ToJSON a) => GToJSON (K1 i a) where
57+ -- Constant values are encoded using their ToJSON instance:
58+ gToJSON _opts = toJSON . unK1
59+
60+instance GToJSON U1 where
61+ -- Empty constructors are encoded to an empty array:
62+ gToJSON _opts _ = emptyArray
63+
64+instance (ConsToJSON a) => GToJSON (C1 c a) where
65+ -- Constructors need to be encoded differently depending on whether they're
66+ -- a record or not. This distinction is made by 'consToJSON':
67+ gToJSON opts = consToJSON opts . unM1
68+
69+instance ( WriteProduct a, WriteProduct b
70+ , ProductSize a, ProductSize b ) => GToJSON (a :*: b) where
71+ -- Products are encoded to an array. Here we allocate a mutable vector of
72+ -- the same size as the product and write the product's elements to it using
73+ -- 'writeProduct':
74+ gToJSON opts p =
75+ Array $ V.create $ do
76+ mv <- VM.unsafeNew lenProduct
77+ writeProduct opts mv 0 lenProduct p
78+ return mv
79+ where
80+ lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
81+ productSize
82+
83+instance ( AllNullary (a :+: b) allNullary
84+ , SumToJSON (a :+: b) allNullary ) => GToJSON (a :+: b) where
85+ -- If all constructors of a sum datatype are nullary and the
86+ -- 'allNullaryToStringTag' option is set they are encoded to
87+ -- strings. This distinction is made by 'sumToJSON':
88+ gToJSON opts = (unTagged :: Tagged allNullary Value -> Value)
89+ . sumToJSON opts
90+
91+--------------------------------------------------------------------------------
92+-- Generic toEncoding
93+
94+instance OVERLAPPABLE_ (GToEncoding a) => GToEncoding (M1 i c a) where
95+ -- Meta-information, which is not handled elsewhere, is ignored:
96+ gToEncoding opts = gToEncoding opts . unM1
97+
98+instance (ToJSON a) => GToEncoding (K1 i a) where
99+ -- Constant values are encoded using their ToJSON instance:
100+ gToEncoding _opts = toEncoding . unK1
101+
102+instance GToEncoding U1 where
103+ -- Empty constructors are encoded to an empty array:
104+ gToEncoding _opts _ = emptyArray_
105+
106+instance (ConsToEncoding a) => GToEncoding (C1 c a) where
107+ -- Constructors need to be encoded differently depending on whether they're
108+ -- a record or not. This distinction is made by 'consToEncoding':
109+ gToEncoding opts = Encoding . consToEncoding opts . unM1
110+
111+instance ( EncodeProduct a, EncodeProduct b ) => GToEncoding (a :*: b) where
112+ -- Products are encoded to an array. Here we allocate a mutable vector of
113+ -- the same size as the product and write the product's elements to it using
114+ -- 'encodeProduct':
115+ gToEncoding opts p = Encoding $
116+ B.char7 '[' <> encodeProduct opts p <> B.char7 ']'
117+
118+instance ( AllNullary (a :+: b) allNullary
119+ , SumToEncoding (a :+: b) allNullary ) => GToEncoding (a :+: b) where
120+ -- If all constructors of a sum datatype are nullary and the
121+ -- 'allNullaryToStringTag' option is set they are encoded to
122+ -- strings. This distinction is made by 'sumToEncoding':
123+ gToEncoding opts = Encoding .
124+ (unTagged :: Tagged allNullary B.Builder -> B.Builder) .
125+ sumToEncoding opts
126+
127+--------------------------------------------------------------------------------
128+
129+class SumToJSON f allNullary where
130+ sumToJSON :: Options -> f a -> Tagged allNullary Value
131+
132+instance ( GetConName f
133+ , TaggedObjectPairs f
134+ , ObjectWithSingleFieldObj f
135+ , TwoElemArrayObj f ) => SumToJSON f True where
136+ sumToJSON opts
137+ | allNullaryToStringTag opts = Tagged . String . pack
138+ . constructorTagModifier opts . getConName
139+ | otherwise = Tagged . nonAllNullarySumToJSON opts
140+
141+instance ( TwoElemArrayObj f
142+ , TaggedObjectPairs f
143+ , ObjectWithSingleFieldObj f ) => SumToJSON f False where
144+ sumToJSON opts = Tagged . nonAllNullarySumToJSON opts
145+
146+nonAllNullarySumToJSON :: ( TwoElemArrayObj f
147+ , TaggedObjectPairs f
148+ , ObjectWithSingleFieldObj f
149+ ) => Options -> f a -> Value
150+nonAllNullarySumToJSON opts =
151+ case sumEncoding opts of
152+ TaggedObject{..} ->
153+ object . taggedObjectPairs opts tagFieldName contentsFieldName
154+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts
155+ TwoElemArray -> Array . twoElemArrayObj opts
156+
157+--------------------------------------------------------------------------------
158+
159+class SumToEncoding f allNullary where
160+ sumToEncoding :: Options -> f a -> Tagged allNullary B.Builder
161+
162+instance ( GetConName f
163+ , TaggedObjectEnc f
164+ , ObjectWithSingleFieldEnc f
165+ , TwoElemArrayEnc f ) => SumToEncoding f True where
166+ sumToEncoding opts
167+ | allNullaryToStringTag opts = Tagged . builder .
168+ constructorTagModifier opts . getConName
169+ | otherwise = Tagged . nonAllNullarySumToEncoding opts
170+
171+instance ( TwoElemArrayEnc f
172+ , TaggedObjectEnc f
173+ , ObjectWithSingleFieldEnc f ) => SumToEncoding f False where
174+ sumToEncoding opts = Tagged . nonAllNullarySumToEncoding opts
175+
176+nonAllNullarySumToEncoding :: ( TwoElemArrayEnc f
177+ , TaggedObjectEnc f
178+ , ObjectWithSingleFieldEnc f
179+ ) => Options -> f a -> B.Builder
180+nonAllNullarySumToEncoding opts =
181+ case sumEncoding opts of
182+ TaggedObject{..} ->
183+ taggedObjectEnc opts tagFieldName contentsFieldName
184+ ObjectWithSingleField -> objectWithSingleFieldEnc opts
185+ TwoElemArray -> twoElemArrayEnc opts
186+
187+--------------------------------------------------------------------------------
188+
189+class TaggedObjectPairs f where
190+ taggedObjectPairs :: Options -> String -> String -> f a -> [Pair]
191+
192+instance ( TaggedObjectPairs a
193+ , TaggedObjectPairs b ) => TaggedObjectPairs (a :+: b) where
194+ taggedObjectPairs opts tagFieldName contentsFieldName (L1 x) =
195+ taggedObjectPairs opts tagFieldName contentsFieldName x
196+ taggedObjectPairs opts tagFieldName contentsFieldName (R1 x) =
197+ taggedObjectPairs opts tagFieldName contentsFieldName x
198+
199+instance ( IsRecord a isRecord
200+ , TaggedObjectPairs' a isRecord
201+ , Constructor c ) => TaggedObjectPairs (C1 c a) where
202+ taggedObjectPairs opts tagFieldName contentsFieldName =
203+ (pack tagFieldName .= constructorTagModifier opts
204+ (conName (undefined :: t c a p)) :) .
205+ (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
206+ taggedObjectPairs' opts contentsFieldName . unM1
207+
208+class TaggedObjectPairs' f isRecord where
209+ taggedObjectPairs' :: Options -> String -> f a -> Tagged isRecord [Pair]
210+
211+instance OVERLAPPING_ TaggedObjectPairs' U1 False where
212+ taggedObjectPairs' _ _ _ = Tagged []
213+
214+instance (RecordToPairs f) => TaggedObjectPairs' f True where
215+ taggedObjectPairs' opts _ = Tagged . toList . recordToPairs opts
216+
217+instance (GToJSON f) => TaggedObjectPairs' f False where
218+ taggedObjectPairs' opts contentsFieldName =
219+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts
220+
221+--------------------------------------------------------------------------------
222+
223+class TaggedObjectEnc f where
224+ taggedObjectEnc :: Options -> String -> String -> f a -> B.Builder
225+
226+instance ( TaggedObjectEnc a
227+ , TaggedObjectEnc b ) => TaggedObjectEnc (a :+: b) where
228+ taggedObjectEnc opts tagFieldName contentsFieldName (L1 x) =
229+ taggedObjectEnc opts tagFieldName contentsFieldName x
230+ taggedObjectEnc opts tagFieldName contentsFieldName (R1 x) =
231+ taggedObjectEnc opts tagFieldName contentsFieldName x
232+
233+instance ( IsRecord a isRecord
234+ , TaggedObjectEnc' a isRecord
235+ , Constructor c ) => TaggedObjectEnc (C1 c a) where
236+ taggedObjectEnc opts tagFieldName contentsFieldName v =
237+ B.char7 '{' <>
238+ (builder tagFieldName <>
239+ B.char7 ':' <>
240+ builder (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
241+ ((unTagged :: Tagged isRecord B.Builder -> B.Builder) .
242+ taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>
243+ B.char7 '}'
244+
245+class TaggedObjectEnc' f isRecord where
246+ taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord B.Builder
247+
248+instance OVERLAPPING_ TaggedObjectEnc' U1 False where
249+ taggedObjectEnc' _ _ _ = Tagged mempty
250+
251+instance (RecordToEncoding f) => TaggedObjectEnc' f True where
252+ taggedObjectEnc' opts _ = Tagged . (B.char7 ',' <>) . fst . recordToEncoding opts
253+
254+instance (GToEncoding f) => TaggedObjectEnc' f False where
255+ taggedObjectEnc' opts contentsFieldName =
256+ Tagged . (\z -> B.char7 ',' <> builder contentsFieldName <> B.char7 ':' <> z) .
257+ gbuilder opts
258+
259+--------------------------------------------------------------------------------
260+
261+-- | Get the name of the constructor of a sum datatype.
262+class GetConName f where
263+ getConName :: f a -> String
264+
265+instance (GetConName a, GetConName b) => GetConName (a :+: b) where
266+ getConName (L1 x) = getConName x
267+ getConName (R1 x) = getConName x
268+
269+instance (Constructor c) => GetConName (C1 c a) where
270+ getConName = conName
271+
272+--------------------------------------------------------------------------------
273+
274+class TwoElemArrayObj f where
275+ twoElemArrayObj :: Options -> f a -> V.Vector Value
276+
277+instance (TwoElemArrayObj a, TwoElemArrayObj b) => TwoElemArrayObj (a :+: b) where
278+ twoElemArrayObj opts (L1 x) = twoElemArrayObj opts x
279+ twoElemArrayObj opts (R1 x) = twoElemArrayObj opts x
280+
281+instance ( GToJSON a, ConsToJSON a
282+ , Constructor c ) => TwoElemArrayObj (C1 c a) where
283+ twoElemArrayObj opts x = V.create $ do
284+ mv <- VM.unsafeNew 2
285+ VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
286+ $ conName (undefined :: t c a p)
287+ VM.unsafeWrite mv 1 $ gToJSON opts x
288+ return mv
289+
290+--------------------------------------------------------------------------------
291+
292+class TwoElemArrayEnc f where
293+ twoElemArrayEnc :: Options -> f a -> B.Builder
294+
295+instance (TwoElemArrayEnc a, TwoElemArrayEnc b) => TwoElemArrayEnc (a :+: b) where
296+ twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
297+ twoElemArrayEnc opts (R1 x) = twoElemArrayEnc opts x
298+
299+instance ( GToEncoding a, ConsToEncoding a
300+ , Constructor c ) => TwoElemArrayEnc (C1 c a) where
301+ twoElemArrayEnc opts x = fromEncoding . tuple $
302+ builder (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
303+ gbuilder opts x
304+
305+--------------------------------------------------------------------------------
306+
307+class ConsToJSON f where
308+ consToJSON :: Options -> f a -> Value
309+
310+class ConsToJSON' f isRecord where
311+ consToJSON' :: Options -> Bool -- ^ Are we a record with one field?
312+ -> f a -> Tagged isRecord Value
313+
314+instance ( IsRecord f isRecord
315+ , ConsToJSON' f isRecord ) => ConsToJSON f where
316+ consToJSON opts = (unTagged :: Tagged isRecord Value -> Value)
317+ . consToJSON' opts (isUnary (undefined :: f a))
318+
319+instance (RecordToPairs f) => ConsToJSON' f True where
320+ consToJSON' opts isUn f = let
321+ vals = toList $ recordToPairs opts f
322+ in case (unwrapUnaryRecords opts,isUn,vals) of
323+ (True,True,[(_,val)]) -> Tagged val
324+ _ -> Tagged $ object vals
325+
326+instance GToJSON f => ConsToJSON' f False where
327+ consToJSON' opts _ = Tagged . gToJSON opts
328+
329+--------------------------------------------------------------------------------
330+
331+class ConsToEncoding f where
332+ consToEncoding :: Options -> f a -> B.Builder
333+
334+class ConsToEncoding' f isRecord where
335+ consToEncoding' :: Options -> Bool -- ^ Are we a record with one field?
336+ -> f a -> Tagged isRecord B.Builder
337+
338+instance ( IsRecord f isRecord
339+ , ConsToEncoding' f isRecord ) => ConsToEncoding f where
340+ consToEncoding opts = (unTagged :: Tagged isRecord B.Builder -> B.Builder)
341+ . consToEncoding' opts (isUnary (undefined :: f a))
342+
343+instance (RecordToEncoding f) => ConsToEncoding' f True where
344+ consToEncoding' opts isUn x =
345+ let (enc, mbVal) = recordToEncoding opts x
346+ in case (unwrapUnaryRecords opts, isUn, mbVal) of
347+ (True, True, Just val) -> Tagged val
348+ _ -> Tagged $ B.char7 '{' <> enc <> B.char7 '}'
349+
350+instance GToEncoding f => ConsToEncoding' f False where
351+ consToEncoding' opts _ = Tagged . gbuilder opts
352+
353+--------------------------------------------------------------------------------
354+
355+class RecordToPairs f where
356+ recordToPairs :: Options -> f a -> DList Pair
357+
358+instance (RecordToPairs a, RecordToPairs b) => RecordToPairs (a :*: b) where
359+ recordToPairs opts (a :*: b) = recordToPairs opts a <>
360+ recordToPairs opts b
361+
362+instance (Selector s, GToJSON a) => RecordToPairs (S1 s a) where
363+ recordToPairs = fieldToPair
364+
365+instance OVERLAPPING_ (Selector s, ToJSON a) =>
366+ RecordToPairs (S1 s (K1 i (Maybe a))) where
367+ recordToPairs opts (M1 k1) | omitNothingFields opts
368+ , K1 Nothing <- k1 = empty
369+ recordToPairs opts m1 = fieldToPair opts m1
370+
371+fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair
372+fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
373+ , gToJSON opts (unM1 m1)
374+ )
375+
376+--------------------------------------------------------------------------------
377+
378+class RecordToEncoding f where
379+ -- 1st element: whole thing
380+ -- 2nd element: in case the record has only 1 field, just the value
381+ -- of the field (without the key); 'Nothing' otherwise
382+ recordToEncoding :: Options -> f a -> (B.Builder, Maybe B.Builder)
383+
384+instance (RecordToEncoding a, RecordToEncoding b) => RecordToEncoding (a :*: b) where
385+ recordToEncoding opts (a :*: b) | omitNothingFields opts =
386+ (mconcat $ intersperse (B.char7 ',') $
387+ filter (not . BSL.null . B.toLazyByteString)
388+ [fst (recordToEncoding opts a), fst (recordToEncoding opts b)]
389+ , Nothing)
390+ recordToEncoding opts (a :*: b) =
391+ (fst (recordToEncoding opts a) <> B.char7 ',' <>
392+ fst (recordToEncoding opts b),
393+ Nothing)
394+
395+instance (Selector s, GToEncoding a) => RecordToEncoding (S1 s a) where
396+ recordToEncoding = fieldToEncoding
397+
398+instance OVERLAPPING_ (Selector s, ToJSON a) =>
399+ RecordToEncoding (S1 s (K1 i (Maybe a))) where
400+ recordToEncoding opts (M1 k1) | omitNothingFields opts
401+ , K1 Nothing <- k1 = (mempty, Nothing)
402+ recordToEncoding opts m1 = fieldToEncoding opts m1
403+
404+fieldToEncoding :: (Selector s, GToEncoding a) => Options -> S1 s a p -> (B.Builder, Maybe B.Builder)
405+fieldToEncoding opts m1 =
406+ let keyBuilder = builder (fieldLabelModifier opts $ selName m1)
407+ valueBuilder = gbuilder opts (unM1 m1)
408+ in (keyBuilder <> B.char7 ':' <> valueBuilder, Just valueBuilder)
409+
410+--------------------------------------------------------------------------------
411+
412+class WriteProduct f where
413+ writeProduct :: Options
414+ -> VM.MVector s Value
415+ -> Int -- ^ index
416+ -> Int -- ^ length
417+ -> f a
418+ -> ST s ()
419+
420+instance ( WriteProduct a
421+ , WriteProduct b ) => WriteProduct (a :*: b) where
422+ writeProduct opts mv ix len (a :*: b) = do
423+ writeProduct opts mv ix lenL a
424+ writeProduct opts mv ixR lenR b
425+ where
426+ lenL = len `unsafeShiftR` 1
427+ lenR = len - lenL
428+ ixR = ix + lenL
429+
430+instance OVERLAPPABLE_ (GToJSON a) => WriteProduct a where
431+ writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts
432+
433+--------------------------------------------------------------------------------
434+
435+class EncodeProduct f where
436+ encodeProduct :: Options -> f a -> B.Builder
437+
438+instance ( EncodeProduct a
439+ , EncodeProduct b ) => EncodeProduct (a :*: b) where
440+ encodeProduct opts (a :*: b) | omitNothingFields opts =
441+ mconcat $ intersperse (B.char7 ',') $
442+ filter (not . BSL.null . B.toLazyByteString)
443+ [encodeProduct opts a, encodeProduct opts b]
444+ encodeProduct opts (a :*: b) = encodeProduct opts a <>
445+ B.char7 ',' <>
446+ encodeProduct opts b
447+
448+instance OVERLAPPABLE_ (GToEncoding a) => EncodeProduct a where
449+ encodeProduct opts = gbuilder opts
450+
451+--------------------------------------------------------------------------------
452+
453+class ObjectWithSingleFieldObj f where
454+ objectWithSingleFieldObj :: Options -> f a -> Object
455+
456+instance ( ObjectWithSingleFieldObj a
457+ , ObjectWithSingleFieldObj b ) => ObjectWithSingleFieldObj (a :+: b) where
458+ objectWithSingleFieldObj opts (L1 x) = objectWithSingleFieldObj opts x
459+ objectWithSingleFieldObj opts (R1 x) = objectWithSingleFieldObj opts x
460+
461+instance ( GToJSON a, ConsToJSON a
462+ , Constructor c ) => ObjectWithSingleFieldObj (C1 c a) where
463+ objectWithSingleFieldObj opts = H.singleton typ . gToJSON opts
464+ where
465+ typ = pack $ constructorTagModifier opts $
466+ conName (undefined :: t c a p)
467+
468+--------------------------------------------------------------------------------
469+
470+class ObjectWithSingleFieldEnc f where
471+ objectWithSingleFieldEnc :: Options -> f a -> B.Builder
472+
473+instance ( ObjectWithSingleFieldEnc a
474+ , ObjectWithSingleFieldEnc b ) => ObjectWithSingleFieldEnc (a :+: b) where
475+ objectWithSingleFieldEnc opts (L1 x) = objectWithSingleFieldEnc opts x
476+ objectWithSingleFieldEnc opts (R1 x) = objectWithSingleFieldEnc opts x
477+
478+instance ( GToEncoding a, ConsToEncoding a
479+ , Constructor c ) => ObjectWithSingleFieldEnc (C1 c a) where
480+ objectWithSingleFieldEnc opts v =
481+ B.char7 '{' <>
482+ builder (constructorTagModifier opts
483+ (conName (undefined :: t c a p))) <>
484+ B.char7 ':' <>
485+ gbuilder opts v <>
486+ B.char7 '}'
487+
488+gbuilder :: GToEncoding f => Options -> f a -> Builder
489+gbuilder opts = fromEncoding . gToEncoding opts
490+
491+--------------------------------------------------------------------------------
492+-- Generic parseJSON
493+
494+instance OVERLAPPABLE_ (GFromJSON a) => GFromJSON (M1 i c a) where
495+ -- Meta-information, which is not handled elsewhere, is just added to the
496+ -- parsed value:
497+ gParseJSON opts = fmap M1 . gParseJSON opts
498+
499+instance (FromJSON a) => GFromJSON (K1 i a) where
500+ -- Constant values are decoded using their FromJSON instance:
501+ gParseJSON _opts = fmap K1 . parseJSON
502+
503+instance GFromJSON U1 where
504+ -- Empty constructors are expected to be encoded as an empty array:
505+ gParseJSON _opts v
506+ | isEmptyArray v = pure U1
507+ | otherwise = typeMismatch "unit constructor (U1)" v
508+
509+instance (ConsFromJSON a) => GFromJSON (C1 c a) where
510+ -- Constructors need to be decoded differently depending on whether they're
511+ -- a record or not. This distinction is made by consParseJSON:
512+ gParseJSON opts = fmap M1 . consParseJSON opts
513+
514+instance ( FromProduct a, FromProduct b
515+ , ProductSize a, ProductSize b ) => GFromJSON (a :*: b) where
516+ -- Products are expected to be encoded to an array. Here we check whether we
517+ -- got an array of the same size as the product, then parse each of the
518+ -- product's elements using parseProduct:
519+ gParseJSON opts = withArray "product (:*:)" $ \arr ->
520+ let lenArray = V.length arr
521+ lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
522+ productSize in
523+ if lenArray == lenProduct
524+ then parseProduct opts arr 0 lenProduct
525+ else fail $ "When expecting a product of " ++ show lenProduct ++
526+ " values, encountered an Array of " ++ show lenArray ++
527+ " elements instead"
528+
529+instance ( AllNullary (a :+: b) allNullary
530+ , ParseSum (a :+: b) allNullary ) => GFromJSON (a :+: b) where
531+ -- If all constructors of a sum datatype are nullary and the
532+ -- 'allNullaryToStringTag' option is set they are expected to be
533+ -- encoded as strings. This distinction is made by 'parseSum':
534+ gParseJSON opts = (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->
535+ (Parser ((a :+: b) d)))
536+ . parseSum opts
537+
538+--------------------------------------------------------------------------------
539+
540+class ParseSum f allNullary where
541+ parseSum :: Options -> Value -> Tagged allNullary (Parser (f a))
542+
543+instance ( SumFromString (a :+: b)
544+ , FromPair (a :+: b)
545+ , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) True where
546+ parseSum opts
547+ | allNullaryToStringTag opts = Tagged . parseAllNullarySum opts
548+ | otherwise = Tagged . parseNonAllNullarySum opts
549+
550+instance ( FromPair (a :+: b)
551+ , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) False where
552+ parseSum opts = Tagged . parseNonAllNullarySum opts
553+
554+--------------------------------------------------------------------------------
555+
556+parseAllNullarySum :: SumFromString f => Options -> Value -> Parser (f a)
557+parseAllNullarySum opts = withText "Text" $ \key ->
558+ maybe (notFound key) return $
559+ parseSumFromString opts key
560+
561+class SumFromString f where
562+ parseSumFromString :: Options -> Text -> Maybe (f a)
563+
564+instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where
565+ parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>
566+ (R1 <$> parseSumFromString opts key)
567+
568+instance (Constructor c) => SumFromString (C1 c U1) where
569+ parseSumFromString opts key | key == name = Just $ M1 U1
570+ | otherwise = Nothing
571+ where
572+ name = pack $ constructorTagModifier opts $
573+ conName (undefined :: t c U1 p)
574+
575+--------------------------------------------------------------------------------
576+
577+parseNonAllNullarySum :: ( FromPair (a :+: b)
578+ , FromTaggedObject (a :+: b)
579+ ) => Options -> Value -> Parser ((a :+: b) c)
580+parseNonAllNullarySum opts =
581+ case sumEncoding opts of
582+ TaggedObject{..} ->
583+ withObject "Object" $ \obj -> do
584+ tag <- obj .: pack tagFieldName
585+ fromMaybe (notFound tag) $
586+ parseFromTaggedObject opts contentsFieldName obj tag
587+
588+ ObjectWithSingleField ->
589+ withObject "Object" $ \obj ->
590+ case H.toList obj of
591+ [pair@(tag, _)] -> fromMaybe (notFound tag) $
592+ parsePair opts pair
593+ _ -> fail "Object doesn't have a single field"
594+
595+ TwoElemArray ->
596+ withArray "Array" $ \arr ->
597+ if V.length arr == 2
598+ then case V.unsafeIndex arr 0 of
599+ String tag -> fromMaybe (notFound tag) $
600+ parsePair opts (tag, V.unsafeIndex arr 1)
601+ _ -> fail "First element is not a String"
602+ else fail "Array doesn't have 2 elements"
603+
604+--------------------------------------------------------------------------------
605+
606+class FromTaggedObject f where
607+ parseFromTaggedObject :: Options -> String -> Object -> Text
608+ -> Maybe (Parser (f a))
609+
610+instance (FromTaggedObject a, FromTaggedObject b) =>
611+ FromTaggedObject (a :+: b) where
612+ parseFromTaggedObject opts contentsFieldName obj tag =
613+ (fmap L1 <$> parseFromTaggedObject opts contentsFieldName obj tag) <|>
614+ (fmap R1 <$> parseFromTaggedObject opts contentsFieldName obj tag)
615+
616+instance ( FromTaggedObject' f
617+ , Constructor c ) => FromTaggedObject (C1 c f) where
618+ parseFromTaggedObject opts contentsFieldName obj tag
619+ | tag == name = Just $ M1 <$> parseFromTaggedObject'
620+ opts contentsFieldName obj
621+ | otherwise = Nothing
622+ where
623+ name = pack $ constructorTagModifier opts $
624+ conName (undefined :: t c f p)
625+
626+--------------------------------------------------------------------------------
627+
628+class FromTaggedObject' f where
629+ parseFromTaggedObject' :: Options -> String -> Object -> Parser (f a)
630+
631+class FromTaggedObject'' f isRecord where
632+ parseFromTaggedObject'' :: Options -> String -> Object
633+ -> Tagged isRecord (Parser (f a))
634+
635+instance ( IsRecord f isRecord
636+ , FromTaggedObject'' f isRecord
637+ ) => FromTaggedObject' f where
638+ parseFromTaggedObject' opts contentsFieldName =
639+ (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .
640+ parseFromTaggedObject'' opts contentsFieldName
641+
642+instance (FromRecord f) => FromTaggedObject'' f True where
643+ parseFromTaggedObject'' opts _ = Tagged . parseRecord opts Nothing
644+
645+instance (GFromJSON f) => FromTaggedObject'' f False where
646+ parseFromTaggedObject'' opts contentsFieldName = Tagged .
647+ (gParseJSON opts <=< (.: pack contentsFieldName))
648+
649+instance OVERLAPPING_ FromTaggedObject'' U1 False where
650+ parseFromTaggedObject'' _ _ _ = Tagged (pure U1)
651+
652+--------------------------------------------------------------------------------
653+
654+class ConsFromJSON f where
655+ consParseJSON :: Options -> Value -> Parser (f a)
656+
657+class ConsFromJSON' f isRecord where
658+ consParseJSON' :: Options -> (Maybe Text) -- ^ A dummy label
659+ -- (Nothing to use proper label)
660+ -> Value -> Tagged isRecord (Parser (f a))
661+
662+instance ( IsRecord f isRecord
663+ , ConsFromJSON' f isRecord
664+ ) => ConsFromJSON f where
665+ consParseJSON opts v = let
666+ (v2,lab) = case (unwrapUnaryRecords opts,isUnary (undefined :: f a)) of
667+ -- use a dummy object with a dummy label
668+ (True,True) -> ((object [(pack "dummy",v)]),Just $ pack "dummy")
669+ _ ->(v,Nothing)
670+ in (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
671+ $ consParseJSON' opts lab v2
672+
673+
674+instance (FromRecord f) => ConsFromJSON' f True where
675+ consParseJSON' opts mlab = Tagged . (withObject "record (:*:)"
676+ $ parseRecord opts mlab)
677+
678+instance (GFromJSON f) => ConsFromJSON' f False where
679+ consParseJSON' opts _ = Tagged . gParseJSON opts
680+
681+--------------------------------------------------------------------------------
682+
683+class FromRecord f where
684+ parseRecord :: Options -> (Maybe Text) -- ^ A dummy label
685+ -- (Nothing to use proper label)
686+ -> Object -> Parser (f a)
687+
688+instance (FromRecord a, FromRecord b) => FromRecord (a :*: b) where
689+ parseRecord opts _ obj = (:*:) <$> parseRecord opts Nothing obj
690+ <*> parseRecord opts Nothing obj
691+
692+instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where
693+ parseRecord opts lab = (<?> Key label) . gParseJSON opts <=< (.: label)
694+ where
695+ label = fromMaybe defLabel lab
696+ defLabel = pack . fieldLabelModifier opts $
697+ selName (undefined :: t s a p)
698+
699+instance OVERLAPPING_ (Selector s, FromJSON a) =>
700+ FromRecord (S1 s (K1 i (Maybe a))) where
701+ parseRecord _ (Just lab) obj = (M1 . K1) <$> obj .:? lab
702+ parseRecord opts Nothing obj = (M1 . K1) <$> obj .:? pack label
703+ where
704+ label = fieldLabelModifier opts $
705+ selName (undefined :: t s (K1 i (Maybe a)) p)
706+
707+--------------------------------------------------------------------------------
708+
709+class ProductSize f where
710+ productSize :: Tagged2 f Int
711+
712+instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where
713+ productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) +
714+ unTagged2 (productSize :: Tagged2 b Int)
715+
716+instance ProductSize (S1 s a) where
717+ productSize = Tagged2 1
718+
719+--------------------------------------------------------------------------------
720+
721+class FromProduct f where
722+ parseProduct :: Options -> Array -> Int -> Int -> Parser (f a)
723+
724+instance (FromProduct a, FromProduct b) => FromProduct (a :*: b) where
725+ parseProduct opts arr ix len =
726+ (:*:) <$> parseProduct opts arr ix lenL
727+ <*> parseProduct opts arr ixR lenR
728+ where
729+ lenL = len `unsafeShiftR` 1
730+ ixR = ix + lenL
731+ lenR = len - lenL
732+
733+instance (GFromJSON a) => FromProduct (S1 s a) where
734+ parseProduct opts arr ix _ = gParseJSON opts $ V.unsafeIndex arr ix
735+
736+--------------------------------------------------------------------------------
737+
738+class FromPair f where
739+ parsePair :: Options -> Pair -> Maybe (Parser (f a))
740+
741+instance (FromPair a, FromPair b) => FromPair (a :+: b) where
742+ parsePair opts pair = (fmap L1 <$> parsePair opts pair) <|>
743+ (fmap R1 <$> parsePair opts pair)
744+
745+instance (Constructor c, GFromJSON a, ConsFromJSON a) => FromPair (C1 c a) where
746+ parsePair opts (tag, value)
747+ | tag == tag' = Just $ gParseJSON opts value
748+ | otherwise = Nothing
749+ where
750+ tag' = pack $ constructorTagModifier opts $
751+ conName (undefined :: t c a p)
44
752
45--------------------------------------------------------------------------------
753--------------------------------------------------------------------------------
46
754
47class IsRecord (f :: * -> *) isRecord | f -> isRecord
755class IsRecord (f :: * -> *) isRecord | f -> isRecord
756+ where
757+ isUnary :: f a -> Bool
758+ isUnary = const True
48
759
49instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
760instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
761+ where isUnary = const False
50#if MIN_VERSION_base(4,9,0)
762#if MIN_VERSION_base(4,9,0)
51instance OVERLAPPING_ IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False
763instance OVERLAPPING_ IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False
52#else
764#else
@@ -54,10 +766,8 @@ instance OVERLAPPING_ IsRecord (M1 S NoSelector f) False
54#endif
766#endif
55instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
767instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
56instance IsRecord (K1 i c) True
768instance 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
769instance IsRecord U1 False
770+ where isUnary = const False
61
771
62--------------------------------------------------------------------------------
772--------------------------------------------------------------------------------
63
773
@@ -69,15 +779,9 @@ instance ( AllNullary a allNullaryL
69 ) => AllNullary (a :+: b) allNullary
779 ) => AllNullary (a :+: b) allNullary
70instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
780instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
71instance AllNullary (a :*: b) False
781instance AllNullary (a :*: b) False
72−instance AllNullary (a :.: b) False
73instance AllNullary (K1 i c) False
782instance AllNullary (K1 i c) False
74−instance AllNullary Par1 False
75−instance AllNullary (Rec1 f) False
76instance AllNullary U1 True
783instance AllNullary U1 True
77
784
78−newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}
79− deriving Functor
80−
81--------------------------------------------------------------------------------
785--------------------------------------------------------------------------------
82
786
83data True
787data True
@@ -92,27 +796,12 @@ instance And True False False
92
796
93--------------------------------------------------------------------------------
797--------------------------------------------------------------------------------
94
798
95−-- | A type-level indicator that 'ToJSON' or 'FromJSON' is being derived generically.
799+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
800
101−--------------------------------------------------------------------------------
801+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
802
113--------------------------------------------------------------------------------
803--------------------------------------------------------------------------------
114
804
115−-- | Simple extensible tuple type to simplify passing around many parameters.
805+notFound :: Text -> Parser a
116−data a :* b = a :* b
806+notFound key = fail $ "The key \"" ++ unpack key ++ "\" was not found"
117−
807+{-# INLINE notFound #-}
118−infixr 1 :*
Data/Aeson/Types/Instances.hsnew file+1439
@@ -0,0 +1,1439 @@
1+{-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable, FlexibleContexts,
2+ FlexibleInstances, GeneralizedNewtypeDeriving,
3+ OverloadedStrings, UndecidableInstances, ScopedTypeVariables,
4+ ViewPatterns #-}
5+{-# LANGUAGE DefaultSignatures #-}
6+
7+-- Needed for Tagged, Const and Proxy instances
8+#if __GLASGOW_HASKELL__ >= 706
9+{-# LANGUAGE PolyKinds #-}
10+#endif
11+
12+{-# OPTIONS_GHC -fno-warn-orphans #-}
13+
14+-- TODO: Drop this when we remove support for Data.Attoparsec.Number
15+{-# OPTIONS_GHC -fno-warn-deprecations #-}
16+
17+-- |
18+-- Module: Data.Aeson.Types.Instances
19+-- Copyright: (c) 2011-2016 Bryan O'Sullivan
20+-- (c) 2011 MailRank, Inc.
21+-- License: BSD3
22+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
23+-- Stability: experimental
24+-- Portability: portable
25+--
26+-- Types for working with JSON data.
27+
28+module Data.Aeson.Types.Instances
29+ (
30+ -- * Type classes
31+ -- ** Core JSON classes
32+ FromJSON(..)
33+ , ToJSON(..)
34+ , KeyValue(..)
35+ -- ** Keys for maps
36+ , ToJSONKey(..)
37+ , ToJSONKeyFunction(..)
38+ , contramapToJSONKeyFunction
39+ , FromJSONKey(..)
40+ , FromJSONKeyFunction(..)
41+ , fromJSONKeyCoerce
42+ , coerceFromJSONKeyFunction
43+ , mapFromJSONKeyFunction
44+ -- ** Liftings to unary and binary type constructors
45+ , FromJSON1(..)
46+ , parseJSON1
47+ , FromJSON2(..)
48+ , parseJSON2
49+ , ToJSON1(..)
50+ , toJSON1
51+ , toEncoding1
52+ , ToJSON2(..)
53+ , toJSON2
54+ , toEncoding2
55+ -- ** Generic JSON classes
56+ , GFromJSON(..)
57+ , GToJSON(..)
58+ , GToEncoding(..)
59+ , genericToJSON
60+ , genericToEncoding
61+ , genericParseJSON
62+
63+ -- * Types
64+ , DotNetTime(..)
65+
66+ -- * Inspecting @'Value's@
67+ , withObject
68+ , withText
69+ , withArray
70+ , withNumber
71+ , withScientific
72+ , withBool
73+
74+ -- * Functions
75+ , fromJSON
76+ , ifromJSON
77+ , (.:)
78+ , (.:?)
79+ , (.:!)
80+ , (.!=)
81+ , tuple
82+ , (>*<)
83+ , typeMismatch
84+
85+ , listEncoding
86+ , listValue
87+ , listParser
88+ ) where
89+
90+import Data.Aeson.Types.Instances.Tuple (tuple, (>*<))
91+
92+import Control.Applicative (Const(..))
93+import Data.Aeson.Encode.Functions (builder, builder', encode, list, encodeWithKey, encodeMap)
94+import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)
95+import Data.Aeson.Types.Class
96+import Data.Aeson.Types.Internal
97+import Data.Attoparsec.Number (Number(..))
98+import Data.Fixed (Fixed, HasResolution)
99+import Data.Foldable (toList)
100+import Data.Functor.Identity (Identity(..))
101+import Data.Hashable (Hashable(..))
102+import Data.Int (Int8, Int16, Int32, Int64)
103+import Data.List.NonEmpty (NonEmpty(..))
104+import Data.Maybe (fromMaybe)
105+import Data.Monoid ((<>))
106+import Data.Monoid (Dual(..), First(..), Last(..))
107+import Data.Proxy (Proxy(..))
108+import Data.Ratio (Ratio, (%), numerator, denominator)
109+import Data.Scientific (Scientific)
110+import Data.Tagged (Tagged(..))
111+import Data.Text (Text, unpack)
112+import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,
113+ ZonedTime)
114+import Data.Time.Format (FormatTime, formatTime, parseTime)
115+import Data.Traversable as Tr (sequence)
116+import Data.Vector (Vector)
117+import Data.Word (Word8, Word16, Word32, Word64)
118+import Data.Version (Version, showVersion, parseVersion)
119+import Text.ParserCombinators.ReadP (readP_to_S)
120+import Foreign.Storable (Storable)
121+import Numeric.Natural (Natural)
122+import Prelude hiding (foldr)
123+import qualified Data.Aeson.Encode.Builder as E
124+import qualified Data.Aeson.Parser.Time as Time
125+import qualified Data.ByteString.Builder as B
126+import qualified Data.ByteString.Lazy as L
127+import qualified Data.HashMap.Strict as H
128+import qualified Data.HashSet as HashSet
129+import qualified Data.IntMap as IntMap
130+import qualified Data.IntSet as IntSet
131+import qualified Data.List.NonEmpty as NE
132+import qualified Data.Map as M
133+import qualified Data.Scientific as Scientific
134+import qualified Data.Sequence as Seq
135+import qualified Data.Set as Set
136+import qualified Data.Text as T
137+import qualified Data.Text.Encoding as T
138+import qualified Data.Text.Read as TR
139+import qualified Data.Text.Lazy as LT
140+import qualified Data.Text.Lazy.Builder as LTB
141+import qualified Data.Text.Lazy.Builder.Int as LTBI
142+import qualified Data.Tree as Tree
143+import qualified Data.Vector as V
144+import qualified Data.Vector.Generic as VG
145+import qualified Data.Vector.Primitive as VP
146+import qualified Data.Vector.Storable as VS
147+import qualified Data.Vector.Unboxed as VU
148+import qualified Data.Vector.Mutable as VM
149+
150+import Unsafe.Coerce (unsafeCoerce)
151+
152+#if MIN_VERSION_base(4,8,0)
153+#else
154+import Control.Applicative ((<$>), (<*>), pure)
155+import Data.Monoid (mempty)
156+import Data.Word (Word)
157+#endif
158+
159+#if MIN_VERSION_time(1,5,0)
160+import Data.Time.Format (defaultTimeLocale)
161+#else
162+import System.Locale (defaultTimeLocale)
163+#endif
164+
165+-------------------------------------------------------------------------------
166+-- Helpers
167+-------------------------------------------------------------------------------
168+
169+parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
170+parseIndexedJSON p idx value = p value <?> Index idx
171+{-# INLINE parseIndexedJSON #-}
172+
173+parseIndexedJSONPair :: (Value -> Parser a) -> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
174+parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx
175+ where
176+ p = withArray "(k,v)" $ \ab ->
177+ let n = V.length ab
178+ in if n == 2
179+ then (,) <$> parseJSONElemAtIndex keyParser 0 ab
180+ <*> parseJSONElemAtIndex valParser 1 ab
181+ else fail $ "cannot unpack array of length " ++
182+ show n ++ " into a pair"
183+
184+ parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> Vector Value -> Parser a
185+ parseJSONElemAtIndex p' idx' ary = p' (V.unsafeIndex ary idx') <?> Index idx'
186+{-# INLINE parseIndexedJSONPair #-}
187+
188+toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
189+toJSONPair keySerialiser valSerializer (a, b) = Array $ V.create $ do
190+ mv <- VM.unsafeNew 2
191+ VM.unsafeWrite mv 0 (keySerialiser a)
192+ VM.unsafeWrite mv 1 (valSerializer b)
193+ return mv
194+{-# INLINE toJSONPair #-}
195+
196+realFloatToJSON :: RealFloat a => a -> Value
197+realFloatToJSON d
198+ | isNaN d || isInfinite d = Null
199+ | otherwise = Number $ Scientific.fromFloatDigits d
200+{-# INLINE realFloatToJSON #-}
201+
202+realFloatToEncoding :: RealFloat a => a -> Encoding
203+realFloatToEncoding d
204+ | isNaN d || isInfinite d = Encoding E.null_
205+ | otherwise = toEncoding (Scientific.fromFloatDigits d)
206+{-# INLINE realFloatToEncoding #-}
207+
208+scientificToNumber :: Scientific -> Number
209+scientificToNumber s
210+ | e < 0 = D $ Scientific.toRealFloat s
211+ | otherwise = I $ c * 10 ^ e
212+ where
213+ e = Scientific.base10Exponent s
214+ c = Scientific.coefficient s
215+{-# INLINE scientificToNumber #-}
216+
217+parseRealFloat :: RealFloat a => String -> Value -> Parser a
218+parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
219+parseRealFloat _ Null = pure (0/0)
220+parseRealFloat expected v = typeMismatch expected v
221+{-# INLINE parseRealFloat #-}
222+
223+parseIntegral :: Integral a => String -> Value -> Parser a
224+parseIntegral expected = withScientific expected $ pure . truncate
225+{-# INLINE parseIntegral #-}
226+
227+-------------------------------------------------------------------------------
228+-- base
229+-------------------------------------------------------------------------------
230+
231+instance ToJSON1 Identity where
232+ liftToJSON to _ (Identity a) = to a
233+ {-# INLINE liftToJSON #-}
234+
235+ liftToEncoding to _ (Identity a) = to a
236+ {-# INLINE liftToEncoding #-}
237+
238+instance (ToJSON a) => ToJSON (Identity a) where
239+ toJSON = toJSON1
240+ {-# INLINE toJSON #-}
241+
242+ toEncoding = toEncoding1
243+ {-# INLINE toEncoding #-}
244+
245+instance FromJSON1 Identity where
246+ liftParseJSON p _ a = Identity <$> p a
247+ {-# INLINE liftParseJSON #-}
248+
249+instance (FromJSON a) => FromJSON (Identity a) where
250+ parseJSON = parseJSON1
251+ {-# INLINE parseJSON #-}
252+
253+
254+instance ToJSON2 Const where
255+ liftToJSON2 to _ _ _ (Const x) = to x
256+ {-# INLINE liftToJSON2 #-}
257+
258+ liftToEncoding2 to _ _ _ (Const x) = to x
259+ {-# INLINE liftToEncoding2 #-}
260+
261+instance FromJSON2 Const where
262+ liftParseJSON2 p _ _ _ = fmap Const . p
263+ {-# INLINE liftParseJSON2 #-}
264+
265+instance ToJSON a => ToJSON1 (Const a) where
266+ liftToJSON _ _ (Const x) = toJSON x
267+ {-# INLINE liftToJSON #-}
268+
269+ liftToEncoding _ _ (Const x) = toEncoding x
270+ {-# INLINE liftToEncoding #-}
271+
272+instance FromJSON a => FromJSON1 (Const a) where
273+ liftParseJSON _ _ = fmap Const . parseJSON
274+ {-# INLINE liftParseJSON #-}
275+
276+instance ToJSON a => ToJSON (Const a b) where
277+ toJSON (Const x) = toJSON x
278+ {-# INLINE toJSON #-}
279+
280+ toEncoding (Const x) = toEncoding x
281+ {-# INLINE toEncoding #-}
282+
283+instance FromJSON a => FromJSON (Const a b) where
284+ {-# INLINE parseJSON #-}
285+ parseJSON = fmap Const . parseJSON
286+
287+
288+instance ToJSON1 Maybe where
289+ liftToJSON to _ (Just a) = to a
290+ liftToJSON _ _ Nothing = Null
291+ {-# INLINE liftToJSON #-}
292+
293+ liftToEncoding to _ (Just a) = to a
294+ liftToEncoding _ _ Nothing = Encoding E.null_
295+ {-# INLINE liftToEncoding #-}
296+
297+instance (ToJSON a) => ToJSON (Maybe a) where
298+ toJSON = toJSON1
299+ {-# INLINE toJSON #-}
300+
301+ toEncoding = toEncoding1
302+ {-# INLINE toEncoding #-}
303+
304+instance FromJSON1 Maybe where
305+ liftParseJSON _ _ Null = pure Nothing
306+ liftParseJSON p _ a = Just <$> p a
307+ {-# INLINE liftParseJSON #-}
308+
309+instance (FromJSON a) => FromJSON (Maybe a) where
310+ parseJSON = parseJSON1
311+ {-# INLINE parseJSON #-}
312+
313+
314+instance ToJSON2 Either where
315+ liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton left (toA a)
316+ liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton right (toB b)
317+ {-# INLINE liftToJSON2 #-}
318+
319+ liftToEncoding2 toA _ _toB _ (Left a) =
320+ Encoding (B.shortByteString "{\"Left\":")
321+ <> toA a
322+ <> Encoding (B.char7 '}')
323+
324+ liftToEncoding2 _toA _ toB _ (Right b) =
325+ Encoding (B.shortByteString "{\"Right\":")
326+ <> toB b
327+ <> Encoding (B.char7 '}')
328+ {-# INLINE liftToEncoding2 #-}
329+
330+instance (ToJSON a) => ToJSON1 (Either a) where
331+ liftToJSON = liftToJSON2 toJSON toJSONList
332+ {-# INLINE liftToJSON #-}
333+
334+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
335+ {-# INLINE liftToEncoding #-}
336+
337+instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
338+ toJSON = toJSON2
339+ {-# INLINE toJSON #-}
340+
341+ toEncoding = toEncoding2
342+ {-# INLINE toEncoding #-}
343+
344+instance FromJSON2 Either where
345+ liftParseJSON2 pA _ pB _ (Object (H.toList -> [(key, value)]))
346+ | key == left = Left <$> pA value <?> Key left
347+ | key == right = Right <$> pB value <?> Key right
348+
349+ liftParseJSON2 _ _ _ _ _ = fail $
350+ "expected an object with a single property " ++
351+ "where the property key should be either " ++
352+ "\"Left\" or \"Right\""
353+ {-# INLINE liftParseJSON2 #-}
354+
355+instance (FromJSON a) => FromJSON1 (Either a) where
356+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
357+ {-# INLINE liftParseJSON #-}
358+
359+instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where
360+ parseJSON = parseJSON2
361+ {-# INLINE parseJSON #-}
362+
363+left, right :: Text
364+left = "Left"
365+right = "Right"
366+
367+
368+instance ToJSON Bool where
369+ toJSON = Bool
370+ {-# INLINE toJSON #-}
371+
372+ toEncoding = Encoding . E.bool
373+ {-# INLINE toEncoding #-}
374+
375+instance FromJSON Bool where
376+ parseJSON = withBool "Bool" pure
377+ {-# INLINE parseJSON #-}
378+
379+instance ToJSON Ordering where
380+ toJSON = toJSON . orderingToText
381+ toEncoding = toEncoding . orderingToText
382+
383+orderingToText :: Ordering -> T.Text
384+orderingToText o = case o of
385+ LT -> "LT"
386+ EQ -> "EQ"
387+ GT -> "GT"
388+
389+instance FromJSON Ordering where
390+ parseJSON = withText "Ordering" $ \s ->
391+ case s of
392+ "LT" -> return LT
393+ "EQ" -> return EQ
394+ "GT" -> return GT
395+ _ -> fail "Parsing Ordering value failed: expected \"LT\", \"EQ\", or \"GT\""
396+
397+instance ToJSON () where
398+ toJSON _ = emptyArray
399+ {-# INLINE toJSON #-}
400+
401+ toEncoding _ = E.emptyArray_
402+ {-# INLINE toEncoding #-}
403+
404+instance FromJSON () where
405+ parseJSON = withArray "()" $ \v ->
406+ if V.null v
407+ then pure ()
408+ else fail "Expected an empty array"
409+ {-# INLINE parseJSON #-}
410+
411+instance ToJSON Char where
412+ toJSON = String . T.singleton
413+ {-# INLINE toJSON #-}
414+
415+ toJSONList = String . T.pack
416+ {-# INLINE toJSONList #-}
417+
418+ toEncoding = Encoding . E.string . (:[])
419+ {-# INLINE toEncoding #-}
420+
421+ toEncodingList = Encoding . E.string
422+ {-# INLINE toEncodingList #-}
423+
424+instance FromJSON Char where
425+ parseJSON = withText "Char" $ \t ->
426+ if T.compareLength t 1 == EQ
427+ then pure $ T.head t
428+ else fail "Expected a string of length 1"
429+ {-# INLINE parseJSON #-}
430+
431+ parseJSONList = withText "String" $ pure . T.unpack
432+ {-# INLINE parseJSONList #-}
433+
434+instance ToJSON Double where
435+ toJSON = realFloatToJSON
436+ {-# INLINE toJSON #-}
437+
438+ toEncoding = realFloatToEncoding
439+ {-# INLINE toEncoding #-}
440+
441+instance FromJSON Double where
442+ parseJSON = parseRealFloat "Double"
443+ {-# INLINE parseJSON #-}
444+
445+instance ToJSON Number where
446+ toJSON (D d) = toJSON d
447+ toJSON (I i) = toJSON i
448+ {-# INLINE toJSON #-}
449+
450+ toEncoding (D d) = toEncoding d
451+ toEncoding (I i) = toEncoding i
452+ {-# INLINE toEncoding #-}
453+
454+instance FromJSON Number where
455+ parseJSON (Number s) = pure $ scientificToNumber s
456+ parseJSON Null = pure (D (0/0))
457+ parseJSON v = typeMismatch "Number" v
458+ {-# INLINE parseJSON #-}
459+
460+instance ToJSON Float where
461+ toJSON = realFloatToJSON
462+ {-# INLINE toJSON #-}
463+
464+ toEncoding = realFloatToEncoding
465+ {-# INLINE toEncoding #-}
466+
467+instance FromJSON Float where
468+ parseJSON = parseRealFloat "Float"
469+ {-# INLINE parseJSON #-}
470+
471+instance ToJSON (Ratio Integer) where
472+ toJSON r = object [ "numerator" .= numerator r
473+ , "denominator" .= denominator r
474+ ]
475+ {-# INLINE toJSON #-}
476+
477+ toEncoding r = Encoding $
478+ B.shortByteString "{\"numerator\":" <> builder (numerator r) <>
479+ B.shortByteString ",\"denominator\":" <> builder (denominator r) <>
480+ B.char7 '}'
481+ {-# INLINE toEncoding #-}
482+
483+instance FromJSON (Ratio Integer) where
484+ parseJSON = withObject "Rational" $ \obj ->
485+ (%) <$> obj .: "numerator"
486+ <*> obj .: "denominator"
487+ {-# INLINE parseJSON #-}
488+
489+instance HasResolution a => ToJSON (Fixed a) where
490+ toJSON = Number . realToFrac
491+ {-# INLINE toJSON #-}
492+
493+ toEncoding = Encoding . E.number . realToFrac
494+ {-# INLINE toEncoding #-}
495+
496+-- | /WARNING:/ Only parse fixed-precision numbers from trusted input
497+-- since an attacker could easily fill up the memory of the target
498+-- system by specifying a scientific number with a big exponent like
499+-- @1e1000000000@.
500+instance HasResolution a => FromJSON (Fixed a) where
501+ parseJSON = withScientific "Fixed" $ pure . realToFrac
502+ {-# INLINE parseJSON #-}
503+
504+instance ToJSON Int where
505+ toJSON = Number . fromIntegral
506+ {-# INLINE toJSON #-}
507+
508+ toEncoding = Encoding . B.intDec
509+ {-# INLINE toEncoding #-}
510+
511+instance FromJSON Int where
512+ parseJSON = parseIntegral "Int"
513+ {-# INLINE parseJSON #-}
514+
515+instance ToJSON Integer where
516+ toJSON = Number . fromInteger
517+ {-# INLINE toJSON #-}
518+
519+ toEncoding = Encoding . B.integerDec
520+ {-# INLINE toEncoding #-}
521+
522+-- | /WARNING:/ Only parse Integers from trusted input since an
523+-- attacker could easily fill up the memory of the target system by
524+-- specifying a scientific number with a big exponent like
525+-- @1e1000000000@.
526+instance FromJSON Integer where
527+ parseJSON = withScientific "Integral" $ pure . truncate
528+ {-# INLINE parseJSON #-}
529+
530+instance ToJSON Natural where
531+ toJSON = toJSON . toInteger
532+ {-# INLINE toJSON #-}
533+
534+ toEncoding = toEncoding . toInteger
535+ {-# INLINE toEncoding #-}
536+
537+instance FromJSON Natural where
538+ parseJSON = withScientific "Natural" $ \s ->
539+ if Scientific.coefficient s < 0
540+ then fail $ "Expected a Natural number but got the negative number: " <> show s
541+ else pure $ truncate s
542+
543+instance ToJSON Int8 where
544+ toJSON = Number . fromIntegral
545+ {-# INLINE toJSON #-}
546+
547+ toEncoding = Encoding . B.int8Dec
548+ {-# INLINE toEncoding #-}
549+
550+instance FromJSON Int8 where
551+ parseJSON = parseIntegral "Int8"
552+ {-# INLINE parseJSON #-}
553+
554+instance ToJSON Int16 where
555+ toJSON = Number . fromIntegral
556+ {-# INLINE toJSON #-}
557+
558+ toEncoding = Encoding . B.int16Dec
559+ {-# INLINE toEncoding #-}
560+
561+instance FromJSON Int16 where
562+ parseJSON = parseIntegral "Int16"
563+ {-# INLINE parseJSON #-}
564+
565+instance ToJSON Int32 where
566+ toJSON = Number . fromIntegral
567+ {-# INLINE toJSON #-}
568+
569+ toEncoding = Encoding . B.int32Dec
570+ {-# INLINE toEncoding #-}
571+
572+instance FromJSON Int32 where
573+ parseJSON = parseIntegral "Int32"
574+ {-# INLINE parseJSON #-}
575+
576+instance ToJSON Int64 where
577+ toJSON = Number . fromIntegral
578+ {-# INLINE toJSON #-}
579+
580+ toEncoding = Encoding . B.int64Dec
581+ {-# INLINE toEncoding #-}
582+
583+instance FromJSON Int64 where
584+ parseJSON = parseIntegral "Int64"
585+ {-# INLINE parseJSON #-}
586+
587+instance ToJSON Word where
588+ toJSON = Number . fromIntegral
589+ {-# INLINE toJSON #-}
590+
591+ toEncoding = Encoding . B.wordDec
592+ {-# INLINE toEncoding #-}
593+
594+instance FromJSON Word where
595+ parseJSON = parseIntegral "Word"
596+ {-# INLINE parseJSON #-}
597+
598+instance ToJSON Word8 where
599+ toJSON = Number . fromIntegral
600+ {-# INLINE toJSON #-}
601+
602+ toEncoding = Encoding . B.word8Dec
603+ {-# INLINE toEncoding #-}
604+
605+instance FromJSON Word8 where
606+ parseJSON = parseIntegral "Word8"
607+ {-# INLINE parseJSON #-}
608+
609+instance ToJSON Word16 where
610+ toJSON = Number . fromIntegral
611+ {-# INLINE toJSON #-}
612+
613+ toEncoding = Encoding . B.word16Dec
614+ {-# INLINE toEncoding #-}
615+
616+instance FromJSON Word16 where
617+ parseJSON = parseIntegral "Word16"
618+ {-# INLINE parseJSON #-}
619+
620+instance ToJSON Word32 where
621+ toJSON = Number . fromIntegral
622+ {-# INLINE toJSON #-}
623+
624+ toEncoding = Encoding . B.word32Dec
625+ {-# INLINE toEncoding #-}
626+
627+instance FromJSON Word32 where
628+ parseJSON = parseIntegral "Word32"
629+ {-# INLINE parseJSON #-}
630+
631+instance ToJSON Word64 where
632+ toJSON = Number . fromIntegral
633+ {-# INLINE toJSON #-}
634+
635+ toEncoding = Encoding . B.word64Dec
636+ {-# INLINE toEncoding #-}
637+
638+instance FromJSON Word64 where
639+ parseJSON = parseIntegral "Word64"
640+ {-# INLINE parseJSON #-}
641+
642+instance ToJSON Text where
643+ toJSON = String
644+ {-# INLINE toJSON #-}
645+
646+ toEncoding = Encoding . E.text
647+ {-# INLINE toEncoding #-}
648+
649+instance FromJSON Text where
650+ parseJSON = withText "Text" pure
651+ {-# INLINE parseJSON #-}
652+
653+instance ToJSON LT.Text where
654+ toJSON = String . LT.toStrict
655+ {-# INLINE toJSON #-}
656+
657+ toEncoding t = Encoding $
658+ B.char7 '"' <>
659+ LT.foldrChunks (\x xs -> E.unquoted x <> xs) (B.char7 '"') t
660+ {-# INLINE toEncoding #-}
661+
662+instance FromJSON LT.Text where
663+ parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
664+ {-# INLINE parseJSON #-}
665+
666+instance ToJSON Version where
667+ toJSON = toJSON . showVersion
668+ {-# INLINE toJSON #-}
669+
670+ toEncoding = toEncoding . showVersion
671+ {-# INLINE toEncoding #-}
672+
673+instance FromJSON Version where
674+ {-# INLINE parseJSON #-}
675+ parseJSON = withText "Version" $ go . readP_to_S parseVersion . unpack
676+ where
677+ go [(v,[])] = return v
678+ go (_ : xs) = go xs
679+ go _ = fail $ "could not parse Version"
680+
681+-------------------------------------------------------------------------------
682+-- semigroups NonEmpty
683+-------------------------------------------------------------------------------
684+
685+instance ToJSON1 NonEmpty where
686+ liftToJSON to _ = listValue to . NE.toList
687+ {-# INLINE liftToJSON #-}
688+
689+ liftToEncoding to _ = listEncoding to . NE.toList
690+ {-# INLINE liftToEncoding #-}
691+
692+instance (ToJSON a) => ToJSON (NonEmpty a) where
693+ toJSON = toJSON1
694+ {-# INLINE toJSON #-}
695+
696+ toEncoding = toEncoding1
697+ {-# INLINE toEncoding #-}
698+
699+instance FromJSON1 NonEmpty where
700+ liftParseJSON p _ = withArray "NonEmpty a" $
701+ (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
702+ where
703+ ne [] = fail "Expected a NonEmpty but got an empty list"
704+ ne (x:xs) = pure (x :| xs)
705+ {-# INLINE liftParseJSON #-}
706+
707+instance (FromJSON a) => FromJSON (NonEmpty a) where
708+ parseJSON = parseJSON1
709+ {-# INLINE parseJSON #-}
710+
711+-------------------------------------------------------------------------------
712+-- scientific
713+-------------------------------------------------------------------------------
714+
715+instance ToJSON Scientific where
716+ toJSON = Number
717+ {-# INLINE toJSON #-}
718+
719+ toEncoding = Encoding . E.number
720+ {-# INLINE toEncoding #-}
721+
722+instance FromJSON Scientific where
723+ parseJSON = withScientific "Scientific" pure
724+ {-# INLINE parseJSON #-}
725+
726+-------------------------------------------------------------------------------
727+-- containers
728+-------------------------------------------------------------------------------
729+
730+instance ToJSON1 Seq.Seq where
731+ liftToJSON to _ = listValue to . toList
732+ {-# INLINE liftToJSON #-}
733+
734+ liftToEncoding to _ = listEncoding to . toList
735+ {-# INLINE liftToEncoding #-}
736+
737+instance (ToJSON a) => ToJSON (Seq.Seq a) where
738+ toJSON = toJSON1
739+ {-# INLINE toJSON #-}
740+
741+ toEncoding = toEncoding1
742+ {-# INLINE toEncoding #-}
743+
744+instance FromJSON1 Seq.Seq where
745+ liftParseJSON p _ = withArray "Seq a" $
746+ fmap Seq.fromList .
747+ Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
748+ {-# INLINE liftParseJSON #-}
749+
750+instance (FromJSON a) => FromJSON (Seq.Seq a) where
751+ parseJSON = parseJSON1
752+ {-# INLINE parseJSON #-}
753+
754+
755+instance ToJSON1 Set.Set where
756+ liftToJSON to _ = listValue to . Set.toList
757+ {-# INLINE liftToJSON #-}
758+
759+ liftToEncoding to _ = listEncoding to . Set.toList
760+ {-# INLINE liftToEncoding #-}
761+
762+instance (ToJSON a) => ToJSON (Set.Set a) where
763+ toJSON = toJSON1
764+ {-# INLINE toJSON #-}
765+
766+ toEncoding = toEncoding1
767+ {-# INLINE toEncoding #-}
768+
769+instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where
770+ parseJSON = fmap Set.fromList . parseJSON
771+ {-# INLINE parseJSON #-}
772+
773+
774+instance FromJSON IntSet.IntSet where
775+ parseJSON = fmap IntSet.fromList . parseJSON
776+ {-# INLINE parseJSON #-}
777+
778+instance ToJSON IntSet.IntSet where
779+ toJSON = toJSON . IntSet.toList
780+ {-# INLINE toJSON #-}
781+
782+ toEncoding = toEncoding . IntSet.toList
783+ {-# INLINE toEncoding #-}
784+
785+
786+instance ToJSON1 IntMap.IntMap where
787+ liftToJSON to tol = liftToJSON to' tol' . IntMap.toList
788+ where
789+ to' = liftToJSON2 toJSON toJSONList to tol
790+ tol' = liftToJSONList2 toJSON toJSONList to tol
791+ {-# INLINE liftToJSON #-}
792+
793+ liftToEncoding to tol = liftToEncoding to' tol' . IntMap.toList
794+ where
795+ to' = liftToEncoding2 toEncoding toEncodingList to tol
796+ tol' = liftToEncodingList2 toEncoding toEncodingList to tol
797+ {-# INLINE liftToEncoding #-}
798+
799+instance ToJSON a => ToJSON (IntMap.IntMap a) where
800+ toJSON = toJSON1
801+ {-# INLINE toJSON #-}
802+
803+ toEncoding = toEncoding1
804+ {-# INLINE toEncoding #-}
805+
806+instance FromJSON1 IntMap.IntMap where
807+ liftParseJSON p pl = fmap IntMap.fromList . liftParseJSON p' pl'
808+ where
809+ p' = liftParseJSON2 parseJSON parseJSONList p pl
810+ pl' = liftParseJSONList2 parseJSON parseJSONList p pl
811+ {-# INLINE liftParseJSON #-}
812+
813+instance FromJSON a => FromJSON (IntMap.IntMap a) where
814+ parseJSON = fmap IntMap.fromList . parseJSON
815+ {-# INLINE parseJSON #-}
816+
817+
818+instance ToJSONKey k => ToJSON1 (M.Map k) where
819+ liftToJSON g _ = case toJSONKey of
820+ ToJSONKeyText (f,_) -> Object . mapHashKeyVal f g
821+ ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . M.toList
822+ {-# INLINE liftToJSON #-}
823+
824+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
825+ liftToEncoding g _ = case toJSONKey of
826+ ToJSONKeyText (_,f) -> encodeMap f g M.minViewWithKey M.foldrWithKey
827+ ToJSONKeyValue (_,f) -> list (pairEncoding f) . M.toList
828+ where
829+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
830+ pairEncoding f (a, b) = tuple $ fromEncoding (f a) >*< builder' g b
831+ {-# INLINE liftToEncoding #-}
832+
833+instance (FromJSONKey k, Ord k) => FromJSON1 (M.Map k) where
834+ liftParseJSON p _ = case fromJSONKey of
835+ FromJSONKeyCoerce _-> withObject "Map k v" $
836+ fmap (H.foldrWithKey (M.insert . unsafeCoerce) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)
837+ FromJSONKeyText f -> withObject "Map k v" $
838+ fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)
839+ FromJSONKeyTextParser f -> withObject "Map k v" $
840+ H.foldrWithKey (\k v m -> M.insert <$> f k <*> (p v <?> Key k) <*> m) (pure M.empty)
841+ FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
842+ M.fromList <$> (Tr.sequence .
843+ zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr)
844+ {-# INLINE liftParseJSON #-}
845+
846+instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where
847+ toJSON = toJSON1
848+ {-# INLINE toJSON #-}
849+
850+ toEncoding = toEncoding1
851+ {-# INLINE toEncoding #-}
852+
853+instance (FromJSON v, FromJSONKey k, Ord k) => FromJSON (M.Map k v) where
854+ parseJSON = parseJSON1
855+ {-# INLINE parseJSON #-}
856+
857+
858+instance ToJSON1 Tree.Tree where
859+ liftToJSON to tol = go
860+ where
861+ go (Tree.Node root branches) =
862+ liftToJSON2 to tol to' tol' (root, branches)
863+
864+ to' = liftToJSON go (listValue go)
865+ tol' = liftToJSONList go (listValue go)
866+ {-# INLINE liftToJSON #-}
867+
868+ liftToEncoding to tol = go
869+ where
870+ go (Tree.Node root branches) =
871+ liftToEncoding2 to tol to' tol' (root, branches)
872+
873+ to' = liftToEncoding go (listEncoding go)
874+ tol' = liftToEncodingList go (listEncoding go)
875+ {-# INLINE liftToEncoding #-}
876+
877+instance (ToJSON v) => ToJSON (Tree.Tree v) where
878+ toJSON = toJSON1
879+ {-# INLINE toJSON #-}
880+
881+ toEncoding = toEncoding1
882+ {-# INLINE toEncoding #-}
883+
884+instance FromJSON1 Tree.Tree where
885+ liftParseJSON p pl = go
886+ where
887+ go v = uncurry Tree.Node <$> liftParseJSON2 p pl p' pl' v
888+
889+ p' = liftParseJSON go (listParser go)
890+ pl'= liftParseJSONList go (listParser go)
891+
892+instance (FromJSON v) => FromJSON (Tree.Tree v) where
893+ parseJSON = parseJSON1
894+ {-# INLINE parseJSON #-}
895+
896+-------------------------------------------------------------------------------
897+-- vector
898+-------------------------------------------------------------------------------
899+
900+instance ToJSON1 Vector where
901+ liftToJSON to _ = Array . V.map to
902+ {-# INLINE liftToJSON #-}
903+
904+ liftToEncoding to _ xs
905+ | V.null xs = E.emptyArray_
906+ | otherwise = Encoding $
907+ B.char7 '[' <> fromEncoding (to (V.unsafeHead xs)) <>
908+ V.foldr go (B.char7 ']') (V.unsafeTail xs)
909+ where
910+ go v b = B.char7 ',' <> fromEncoding (to v) <> b
911+ {-# INLINE liftToEncoding #-}
912+
913+instance (ToJSON a) => ToJSON (Vector a) where
914+ toJSON = Array . V.map toJSON
915+ {-# INLINE toJSON #-}
916+
917+ toEncoding = encodeVector
918+ {-# INLINE toEncoding #-}
919+
920+encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
921+encodeVector xs
922+ | VG.null xs = E.emptyArray_
923+ | otherwise = Encoding $
924+ B.char7 '[' <> builder (VG.unsafeHead xs) <>
925+ VG.foldr go (B.char7 ']') (VG.unsafeTail xs)
926+ where go v b = B.char7 ',' <> builder v <> b
927+{-# INLINE encodeVector #-}
928+
929+instance FromJSON1 Vector where
930+ liftParseJSON p _ = withArray "Vector a" $
931+ V.mapM (uncurry $ parseIndexedJSON p) . V.indexed
932+ {-# INLINE liftParseJSON #-}
933+
934+instance (FromJSON a) => FromJSON (Vector a) where
935+ parseJSON = parseJSON1
936+ {-# INLINE parseJSON #-}
937+
938+vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
939+vectorToJSON = Array . V.map toJSON . V.convert
940+{-# INLINE vectorToJSON #-}
941+
942+vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
943+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry $ parseIndexedJSON parseJSON) . V.indexed
944+{-# INLINE vectorParseJSON #-}
945+
946+instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
947+ toJSON = vectorToJSON
948+ {-# INLINE toJSON #-}
949+
950+ toEncoding = encodeVector
951+ {-# INLINE toEncoding #-}
952+
953+instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where
954+ parseJSON = vectorParseJSON "Data.Vector.Storable.Vector a"
955+
956+instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where
957+ toJSON = vectorToJSON
958+ {-# INLINE toJSON #-}
959+
960+ toEncoding = encodeVector
961+ {-# INLINE toEncoding #-}
962+
963+instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where
964+ parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector a"
965+ {-# INLINE parseJSON #-}
966+
967+instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where
968+ toJSON = vectorToJSON
969+ {-# INLINE toJSON #-}
970+
971+ toEncoding = encodeVector
972+ {-# INLINE toEncoding #-}
973+
974+instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where
975+ parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"
976+ {-# INLINE parseJSON #-}
977+
978+-------------------------------------------------------------------------------
979+-- unordered-containers
980+-------------------------------------------------------------------------------
981+
982+instance ToJSON1 HashSet.HashSet where
983+ liftToJSON to _ = listValue to . HashSet.toList
984+ {-# INLINE liftToJSON #-}
985+
986+ liftToEncoding to _ = listEncoding to . HashSet.toList
987+ {-# INLINE liftToEncoding #-}
988+
989+instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
990+ toJSON = toJSON1
991+ {-# INLINE toJSON #-}
992+
993+ toEncoding = toEncoding1
994+ {-# INLINE toEncoding #-}
995+
996+instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where
997+ parseJSON = fmap HashSet.fromList . parseJSON
998+ {-# INLINE parseJSON #-}
999+
1000+
1001+instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1002+ liftToJSON g _ = case toJSONKey of
1003+ ToJSONKeyText (f,_) -> Object . mapKeyVal f g
1004+ ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList
1005+ {-# INLINE liftToJSON #-}
1006+
1007+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1008+ liftToEncoding g _ = case toJSONKey of
1009+ ToJSONKeyText (_,f) -> encodeWithKey f g H.foldrWithKey
1010+ ToJSONKeyValue (_,f) -> list (pairEncoding f) . H.toList
1011+ where
1012+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1013+ pairEncoding f (a, b) = tuple $ fromEncoding (f a) >*< builder' g b
1014+ {-# INLINE liftToEncoding #-}
1015+
1016+instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1017+ toJSON = toJSON1
1018+ {-# INLINE toJSON #-}
1019+
1020+ toEncoding = toEncoding1
1021+ {-# INLINE toEncoding #-}
1022+
1023+instance (FromJSONKey k, Eq k, Hashable k) => FromJSON1 (H.HashMap k) where
1024+ liftParseJSON p _ = case fromJSONKey of
1025+ FromJSONKeyCoerce _ -> withObject "HashMap ~Text v" $
1026+ uc . H.traverseWithKey (\k v -> p v <?> Key k)
1027+ FromJSONKeyText f -> withObject "HashMap k v" $
1028+ fmap (mapKey f) . H.traverseWithKey (\k v -> p v <?> Key k)
1029+ FromJSONKeyTextParser f -> withObject "HashMap k v" $
1030+ H.foldrWithKey (\k v m -> H.insert <$> f k <*> (p v <?> Key k) <*> m) (pure H.empty)
1031+ FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
1032+ H.fromList <$> (Tr.sequence .
1033+ zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr)
1034+ where
1035+ uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)
1036+ uc = unsafeCoerce
1037+
1038+instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where
1039+ parseJSON = parseJSON1
1040+ {-# INLINE parseJSON #-}
1041+
1042+-------------------------------------------------------------------------------
1043+-- aeson
1044+-------------------------------------------------------------------------------
1045+
1046+instance ToJSON Value where
1047+ toJSON a = a
1048+ {-# INLINE toJSON #-}
1049+
1050+ toEncoding = Encoding . E.encodeToBuilder
1051+ {-# INLINE toEncoding #-}
1052+
1053+instance FromJSON Value where
1054+ parseJSON = pure
1055+ {-# INLINE parseJSON #-}
1056+
1057+instance ToJSON DotNetTime where
1058+ toJSON = toJSON . dotNetTime
1059+
1060+ toEncoding = toEncoding . dotNetTime
1061+
1062+dotNetTime :: DotNetTime -> String
1063+dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1064+ where secs = formatTime defaultTimeLocale "/Date(%s" t
1065+
1066+instance FromJSON DotNetTime where
1067+ parseJSON = withText "DotNetTime" $ \t ->
1068+ let (s,m) = T.splitAt (T.length t - 5) t
1069+ t' = T.concat [s,".",m]
1070+ in case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of
1071+ Just d -> pure (DotNetTime d)
1072+ _ -> fail "could not parse .NET time"
1073+ {-# INLINE parseJSON #-}
1074+
1075+-------------------------------------------------------------------------------
1076+-- time
1077+-------------------------------------------------------------------------------
1078+
1079+instance ToJSON Day where
1080+ toJSON = stringEncoding
1081+ toEncoding z = Encoding (E.quote $ E.day z)
1082+
1083+instance FromJSON Day where
1084+ parseJSON = withText "Day" (Time.run Time.day)
1085+
1086+instance ToJSON TimeOfDay where
1087+ toJSON = stringEncoding
1088+ toEncoding z = Encoding (E.quote $ E.timeOfDay z)
1089+
1090+instance FromJSON TimeOfDay where
1091+ parseJSON = withText "TimeOfDay" (Time.run Time.timeOfDay)
1092+
1093+instance ToJSON LocalTime where
1094+ toJSON = stringEncoding
1095+ toEncoding z = Encoding (E.quote $ E.localTime z)
1096+
1097+instance FromJSON LocalTime where
1098+ parseJSON = withText "LocalTime" (Time.run Time.localTime)
1099+
1100+instance ToJSON ZonedTime where
1101+ toJSON = stringEncoding
1102+
1103+ toEncoding z = Encoding (E.quote $ E.zonedTime z)
1104+
1105+formatMillis :: (FormatTime t) => t -> String
1106+formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1107+
1108+instance FromJSON ZonedTime where
1109+ parseJSON = withText "ZonedTime" (Time.run Time.zonedTime)
1110+
1111+instance ToJSON UTCTime where
1112+ toJSON = stringEncoding
1113+
1114+ toEncoding t = Encoding (E.quote $ E.utcTime t)
1115+
1116+-- | Encode something to a JSON string.
1117+stringEncoding :: (ToJSON a) => a -> Value
1118+stringEncoding = String . T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . encode
1119+{-# INLINE stringEncoding #-}
1120+
1121+instance FromJSON UTCTime where
1122+ parseJSON = withText "UTCTime" (Time.run Time.utcTime)
1123+
1124+instance ToJSON NominalDiffTime where
1125+ toJSON = Number . realToFrac
1126+ {-# INLINE toJSON #-}
1127+
1128+ toEncoding = Encoding . E.number . realToFrac
1129+ {-# INLINE toEncoding #-}
1130+
1131+-- | /WARNING:/ Only parse lengths of time from trusted input
1132+-- since an attacker could easily fill up the memory of the target
1133+-- system by specifying a scientific number with a big exponent like
1134+-- @1e1000000000@.
1135+instance FromJSON NominalDiffTime where
1136+ parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac
1137+ {-# INLINE parseJSON #-}
1138+
1139+-------------------------------------------------------------------------------
1140+-- base Monoid/Semigroup
1141+-------------------------------------------------------------------------------
1142+
1143+instance ToJSON1 Dual where
1144+ liftToJSON to _ = to . getDual
1145+ {-# INLINE liftToJSON #-}
1146+
1147+ liftToEncoding to _ = to . getDual
1148+ {-# INLINE liftToEncoding #-}
1149+
1150+instance ToJSON a => ToJSON (Dual a) where
1151+ toJSON = toJSON1
1152+ {-# INLINE toJSON #-}
1153+
1154+ toEncoding = toEncoding1
1155+ {-# INLINE toEncoding #-}
1156+
1157+instance FromJSON1 Dual where
1158+ liftParseJSON p _ = fmap Dual . p
1159+ {-# INLINE liftParseJSON #-}
1160+
1161+instance FromJSON a => FromJSON (Dual a) where
1162+ parseJSON = parseJSON1
1163+ {-# INLINE parseJSON #-}
1164+
1165+
1166+instance ToJSON1 First where
1167+ liftToJSON to to' = liftToJSON to to' . getFirst
1168+ {-# INLINE liftToJSON #-}
1169+
1170+ liftToEncoding to to' = liftToEncoding to to' . getFirst
1171+ {-# INLINE liftToEncoding #-}
1172+
1173+instance ToJSON a => ToJSON (First a) where
1174+ toJSON = toJSON1
1175+ {-# INLINE toJSON #-}
1176+
1177+ toEncoding = toEncoding1
1178+ {-# INLINE toEncoding #-}
1179+
1180+instance FromJSON1 First where
1181+ liftParseJSON p p' = fmap First . liftParseJSON p p'
1182+ {-# INLINE liftParseJSON #-}
1183+
1184+instance FromJSON a => FromJSON (First a) where
1185+ parseJSON = parseJSON1
1186+ {-# INLINE parseJSON #-}
1187+
1188+
1189+instance ToJSON1 Last where
1190+ liftToJSON to to' = liftToJSON to to' . getLast
1191+ {-# INLINE liftToJSON #-}
1192+
1193+ liftToEncoding to to' = liftToEncoding to to' . getLast
1194+ {-# INLINE liftToEncoding #-}
1195+
1196+instance ToJSON a => ToJSON (Last a) where
1197+ toJSON = toJSON1
1198+ {-# INLINE toJSON #-}
1199+
1200+ toEncoding = toEncoding1
1201+ {-# INLINE toEncoding #-}
1202+
1203+instance FromJSON1 Last where
1204+ liftParseJSON p p' = fmap Last . liftParseJSON p p'
1205+ {-# INLINE liftParseJSON #-}
1206+
1207+instance FromJSON a => FromJSON (Last a) where
1208+ parseJSON = parseJSON1
1209+ {-# INLINE parseJSON #-}
1210+
1211+-------------------------------------------------------------------------------
1212+-- tagged
1213+-------------------------------------------------------------------------------
1214+
1215+instance ToJSON (Proxy a) where
1216+ toJSON _ = Null
1217+ {-# INLINE toJSON #-}
1218+
1219+ toEncoding _ = Encoding E.null_
1220+ {-# INLINE toEncoding #-}
1221+
1222+instance FromJSON (Proxy a) where
1223+ {-# INLINE parseJSON #-}
1224+ parseJSON Null = pure Proxy
1225+ parseJSON v = typeMismatch "Proxy" v
1226+
1227+
1228+instance ToJSON1 (Tagged a) where
1229+ liftToJSON to _ (Tagged x) = to x
1230+ {-# INLINE liftToJSON #-}
1231+
1232+ liftToEncoding to _ (Tagged x) = to x
1233+ {-# INLINE liftToEncoding #-}
1234+
1235+instance ToJSON b => ToJSON (Tagged a b) where
1236+ toJSON = toJSON1
1237+ {-# INLINE toJSON #-}
1238+
1239+ toEncoding = toEncoding1
1240+ {-# INLINE toEncoding #-}
1241+
1242+instance FromJSON1 (Tagged a) where
1243+ liftParseJSON p _ = fmap Tagged . p
1244+ {-# INLINE liftParseJSON #-}
1245+
1246+instance FromJSON b => FromJSON (Tagged a b) where
1247+ parseJSON = parseJSON1
1248+ {-# INLINE parseJSON #-}
1249+
1250+instance FromJSONKey b => FromJSONKey (Tagged a b) where
1251+ fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)
1252+ fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList
1253+
1254+instance ToJSONKey b => ToJSONKey (Tagged a b) where
1255+ toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
1256+ toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
1257+
1258+-------------------------------------------------------------------------------
1259+-- Instances for converting to/from map keys
1260+-------------------------------------------------------------------------------
1261+
1262+
1263+
1264+instance ToJSONKey Text where
1265+ toJSONKey = ToJSONKeyText (id,toEncoding)
1266+
1267+instance FromJSONKey Text where
1268+ fromJSONKey = fromJSONKeyCoerce
1269+
1270+
1271+
1272+instance ToJSONKey Bool where
1273+ toJSONKey = ToJSONKeyText
1274+ ( (\x -> if x then "true" else "false")
1275+ , (\x -> Encoding $ if x then "\"true\"" else "\"false\"")
1276+ )
1277+
1278+instance ToJSONKey Int where
1279+ toJSONKey = ToJSONKeyText
1280+ ( LT.toStrict . LTB.toLazyText . LTBI.decimal
1281+ , \x -> Encoding $ B.char7 '"' <> fromEncoding (toEncoding x) <> B.char7 '"'
1282+ )
1283+
1284+instance FromJSONKey Int where
1285+ -- not sure if there if there is already a helper in
1286+ -- aeson for doing this.
1287+ fromJSONKey = FromJSONKeyTextParser $ \t -> case TR.decimal t of
1288+ Left err -> fail err
1289+ Right (v,t2) -> if T.null t2
1290+ then return v
1291+ else fail "Was not an integer, had extra stuff."
1292+
1293+instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
1294+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
1295+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
1296+
1297+instance (FromJSON a, FromJSON b) => FromJSONKey (a,b)
1298+instance (FromJSON a, FromJSON b, FromJSON c) => FromJSONKey (a,b,c)
1299+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSONKey (a,b,c,d)
1300+
1301+instance ToJSONKey Char where
1302+ toJSONKey = ToJSONKeyText (T.singleton, toEncoding)
1303+ toJSONKeyList = ToJSONKeyText (T.pack, toEncoding . T.pack)
1304+
1305+instance FromJSONKey Char where
1306+ fromJSONKey = FromJSONKeyTextParser $ \t ->
1307+ if T.length t == 1
1308+ then return (T.index t 0)
1309+ else typeMismatch "Expected Char but String didn't contain exactly one character" (String t)
1310+ fromJSONKeyList = FromJSONKeyText T.unpack
1311+
1312+instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
1313+ toJSONKey = toJSONKeyList
1314+
1315+instance (FromJSONKey a, FromJSON a) => FromJSONKey [a] where
1316+ fromJSONKey = fromJSONKeyList
1317+
1318+instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1319+ toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1320+
1321+instance (FromJSONKey a, FromJSON a) => FromJSONKey (Identity a) where
1322+ fromJSONKey = mapFromJSONKeyFunction Identity fromJSONKey
1323+
1324+-------------------------------------------------------------------------------
1325+-- Functions
1326+-------------------------------------------------------------------------------
1327+
1328+-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@
1329+-- and fails using @'typeMismatch' expected@ otherwise.
1330+withObject :: String -> (Object -> Parser a) -> Value -> Parser a
1331+withObject _ f (Object obj) = f obj
1332+withObject expected _ v = typeMismatch expected v
1333+{-# INLINE withObject #-}
1334+
1335+-- | @withText expected f value@ applies @f@ to the 'Text' when @value@ is a @String@
1336+-- and fails using @'typeMismatch' expected@ otherwise.
1337+withText :: String -> (Text -> Parser a) -> Value -> Parser a
1338+withText _ f (String txt) = f txt
1339+withText expected _ v = typeMismatch expected v
1340+{-# INLINE withText #-}
1341+
1342+-- | @withArray expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@
1343+-- and fails using @'typeMismatch' expected@ otherwise.
1344+withArray :: String -> (Array -> Parser a) -> Value -> Parser a
1345+withArray _ f (Array arr) = f arr
1346+withArray expected _ v = typeMismatch expected v
1347+{-# INLINE withArray #-}
1348+
1349+-- | @withNumber expected f value@ applies @f@ to the 'Number' when @value@ is a 'Number'.
1350+-- and fails using @'typeMismatch' expected@ otherwise.
1351+withNumber :: String -> (Number -> Parser a) -> Value -> Parser a
1352+withNumber expected f = withScientific expected (f . scientificToNumber)
1353+{-# INLINE withNumber #-}
1354+{-# DEPRECATED withNumber "Use withScientific instead" #-}
1355+
1356+-- | @withScientific expected f value@ applies @f@ to the 'Scientific' number when @value@ is a 'Number'.
1357+-- and fails using @'typeMismatch' expected@ otherwise.
1358+withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
1359+withScientific _ f (Number scientific) = f scientific
1360+withScientific expected _ v = typeMismatch expected v
1361+{-# INLINE withScientific #-}
1362+
1363+-- | @withBool expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@
1364+-- and fails using @'typeMismatch' expected@ otherwise.
1365+withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
1366+withBool _ f (Bool arr) = f arr
1367+withBool expected _ v = typeMismatch expected v
1368+{-# INLINE withBool #-}
1369+
1370+instance KeyValue Pair where
1371+ name .= value = (name, toJSON value)
1372+ {-# INLINE (.=) #-}
1373+
1374+instance KeyValue Series where
1375+ name .= value = Value . Encoding $
1376+ E.text name <> B.char7 ':' <> builder value
1377+ {-# INLINE (.=) #-}
1378+
1379+-- | Convert a value from JSON, failing if the types do not match.
1380+fromJSON :: (FromJSON a) => Value -> Result a
1381+fromJSON = parse parseJSON
1382+{-# INLINE fromJSON #-}
1383+
1384+-- | Convert a value from JSON, failing if the types do not match.
1385+ifromJSON :: (FromJSON a) => Value -> IResult a
1386+ifromJSON = iparse parseJSON
1387+{-# INLINE ifromJSON #-}
1388+
1389+-- | Retrieve the value associated with the given key of an 'Object'.
1390+-- The result is 'empty' if the key is not present or the value cannot
1391+-- be converted to the desired type.
1392+--
1393+-- This accessor is appropriate if the key and value /must/ be present
1394+-- in an object for it to be valid. If the key and value are
1395+-- optional, use '.:?' instead.
1396+(.:) :: (FromJSON a) => Object -> Text -> Parser a
1397+obj .: key = case H.lookup key obj of
1398+ Nothing -> fail $ "key " ++ show key ++ " not present"
1399+ Just v -> parseJSON v <?> Key key
1400+{-# INLINE (.:) #-}
1401+
1402+-- | Retrieve the value associated with the given key of an 'Object'.
1403+-- The result is 'Nothing' if the key is not present, or 'empty' if
1404+-- the value cannot be converted to the desired type.
1405+--
1406+-- This accessor is most useful if the key and value can be absent
1407+-- from an object without affecting its validity. If the key and
1408+-- value are mandatory, use '.:' instead.
1409+(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
1410+obj .:? key = case H.lookup key obj of
1411+ Nothing -> pure Nothing
1412+ Just v -> parseJSON v <?> Key key
1413+{-# INLINE (.:?) #-}
1414+
1415+-- | Like '.:?', but the resulting parser will fail,
1416+-- if the key is present but is 'Null'.
1417+(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
1418+obj .:! key = case H.lookup key obj of
1419+ Nothing -> pure Nothing
1420+ Just v -> Just <$> parseJSON v <?> Key key
1421+{-# INLINE (.:!) #-}
1422+
1423+-- | Helper for use in combination with '.:?' to provide default
1424+-- values for optional JSON object fields.
1425+--
1426+-- This combinator is most useful if the key and value can be absent
1427+-- from an object without affecting its validity and we know a default
1428+-- value to assign in that case. If the key and value are mandatory,
1429+-- use '.:' instead.
1430+--
1431+-- Example usage:
1432+--
1433+-- @ v1 <- o '.:?' \"opt_field_with_dfl\" .!= \"default_val\"
1434+-- v2 <- o '.:' \"mandatory_field\"
1435+-- v3 <- o '.:?' \"opt_field2\"
1436+-- @
1437+(.!=) :: Parser (Maybe a) -> a -> Parser a
1438+pmval .!= val = fromMaybe val <$> pmval
1439+{-# INLINE (.!=) #-}
Data/Aeson/Types/Instances/Tuple.hsnew file+939
@@ -0,0 +1,939 @@
1+{-# LANGUAGE CPP #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+-- |
4+-- Module: Data.Aeson.Types.Instances
5+-- Copyright: (c) 2011-2016 Bryan O'Sullivan
6+-- (c) 2011 MailRank, Inc.
7+-- License: BSD3
8+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
9+-- Stability: experimental
10+-- Portability: portable
11+--
12+-- Tuple instances
13+module Data.Aeson.Types.Instances.Tuple (tuple, (>*<)) where
14+
15+import Data.Aeson.Encode.Functions (builder)
16+import Data.Aeson.Types.Class
17+import Data.Aeson.Types.Internal
18+import Data.Monoid ((<>))
19+
20+import qualified Data.Vector as V
21+import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)
22+import qualified Data.ByteString.Builder as B
23+
24+#if MIN_VERSION_base(4,8,0)
25+#else
26+import Control.Applicative ((<$>), (<*>))
27+#endif
28+
29+parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
30+parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx
31+
32+(>*<) :: B.Builder -> B.Builder -> B.Builder
33+a >*< b = a <> B.char7 ',' <> b
34+{-# INLINE (>*<) #-}
35+infixr 6 >*<
36+
37+tuple :: B.Builder -> Encoding
38+tuple b = Encoding (B.char7 '[' <> b <> B.char7 ']')
39+{-# INLINE tuple #-}
40+
41+-- Local copy of withArray
42+withArray :: String -> (Array -> Parser a) -> Value -> Parser a
43+withArray _ f (Array arr) = f arr
44+withArray expected _ v = typeMismatch expected v
45+{-# INLINE withArray #-}
46+
47+-------------------------------------------------------------------------------
48+-- Generated, see tuple-instances.hs
49+-------------------------------------------------------------------------------
50+
51+instance ToJSON2 ((,) ) where
52+ liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
53+ mv <- VM.unsafeNew 2
54+ VM.unsafeWrite mv 0 (toA a)
55+ VM.unsafeWrite mv 1 (toB b)
56+ return mv
57+ {-# INLINE liftToJSON2 #-}
58+
59+ liftToEncoding2 toA _ toB _ (a, b) = tuple $
60+ fromEncoding (toA a) >*<
61+ fromEncoding (toB b)
62+ {-# INLINE liftToEncoding2 #-}
63+
64+instance (ToJSON a) => ToJSON1 ((,) a) where
65+ liftToJSON = liftToJSON2 toJSON toJSONList
66+ {-# INLINE liftToJSON #-}
67+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
68+ {-# INLINE liftToEncoding #-}
69+
70+instance (ToJSON a, ToJSON b) => ToJSON (a, b) where
71+ toJSON = toJSON2
72+ {-# INLINE toJSON #-}
73+ toEncoding = toEncoding2
74+ {-# INLINE toEncoding #-}
75+
76+instance FromJSON2 ((,) ) where
77+ liftParseJSON2 pA _ pB _ = withArray "(a, b)" $ \t ->
78+ let n = V.length t
79+ in if n == 2
80+ then (,)
81+ <$> parseJSONElemAtIndex pA 0 t
82+ <*> parseJSONElemAtIndex pB 1 t
83+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 2"
84+ {-# INLINE liftParseJSON2 #-}
85+
86+instance (FromJSON a) => FromJSON1 ((,) a) where
87+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
88+ {-# INLINE liftParseJSON #-}
89+
90+instance (FromJSON a, FromJSON b) => FromJSON (a, b) where
91+ parseJSON = parseJSON2
92+ {-# INLINE parseJSON #-}
93+
94+
95+instance (ToJSON a) => ToJSON2 ((,,) a) where
96+ liftToJSON2 toB _ toC _ (a, b, c) = Array $ V.create $ do
97+ mv <- VM.unsafeNew 3
98+ VM.unsafeWrite mv 0 (toJSON a)
99+ VM.unsafeWrite mv 1 (toB b)
100+ VM.unsafeWrite mv 2 (toC c)
101+ return mv
102+ {-# INLINE liftToJSON2 #-}
103+
104+ liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
105+ builder a >*<
106+ fromEncoding (toB b) >*<
107+ fromEncoding (toC c)
108+ {-# INLINE liftToEncoding2 #-}
109+
110+instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
111+ liftToJSON = liftToJSON2 toJSON toJSONList
112+ {-# INLINE liftToJSON #-}
113+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
114+ {-# INLINE liftToEncoding #-}
115+
116+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a, b, c) where
117+ toJSON = toJSON2
118+ {-# INLINE toJSON #-}
119+ toEncoding = toEncoding2
120+ {-# INLINE toEncoding #-}
121+
122+instance (FromJSON a) => FromJSON2 ((,,) a) where
123+ liftParseJSON2 pB _ pC _ = withArray "(a, b, c)" $ \t ->
124+ let n = V.length t
125+ in if n == 3
126+ then (,,)
127+ <$> parseJSONElemAtIndex parseJSON 0 t
128+ <*> parseJSONElemAtIndex pB 1 t
129+ <*> parseJSONElemAtIndex pC 2 t
130+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 3"
131+ {-# INLINE liftParseJSON2 #-}
132+
133+instance (FromJSON a, FromJSON b) => FromJSON1 ((,,) a b) where
134+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
135+ {-# INLINE liftParseJSON #-}
136+
137+instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a, b, c) where
138+ parseJSON = parseJSON2
139+ {-# INLINE parseJSON #-}
140+
141+
142+instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
143+ liftToJSON2 toC _ toD _ (a, b, c, d) = Array $ V.create $ do
144+ mv <- VM.unsafeNew 4
145+ VM.unsafeWrite mv 0 (toJSON a)
146+ VM.unsafeWrite mv 1 (toJSON b)
147+ VM.unsafeWrite mv 2 (toC c)
148+ VM.unsafeWrite mv 3 (toD d)
149+ return mv
150+ {-# INLINE liftToJSON2 #-}
151+
152+ liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
153+ builder a >*<
154+ builder b >*<
155+ fromEncoding (toC c) >*<
156+ fromEncoding (toD d)
157+ {-# INLINE liftToEncoding2 #-}
158+
159+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
160+ liftToJSON = liftToJSON2 toJSON toJSONList
161+ {-# INLINE liftToJSON #-}
162+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
163+ {-# INLINE liftToEncoding #-}
164+
165+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a, b, c, d) where
166+ toJSON = toJSON2
167+ {-# INLINE toJSON #-}
168+ toEncoding = toEncoding2
169+ {-# INLINE toEncoding #-}
170+
171+instance (FromJSON a, FromJSON b) => FromJSON2 ((,,,) a b) where
172+ liftParseJSON2 pC _ pD _ = withArray "(a, b, c, d)" $ \t ->
173+ let n = V.length t
174+ in if n == 4
175+ then (,,,)
176+ <$> parseJSONElemAtIndex parseJSON 0 t
177+ <*> parseJSONElemAtIndex parseJSON 1 t
178+ <*> parseJSONElemAtIndex pC 2 t
179+ <*> parseJSONElemAtIndex pD 3 t
180+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 4"
181+ {-# INLINE liftParseJSON2 #-}
182+
183+instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON1 ((,,,) a b c) where
184+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
185+ {-# INLINE liftParseJSON #-}
186+
187+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a, b, c, d) where
188+ parseJSON = parseJSON2
189+ {-# INLINE parseJSON #-}
190+
191+
192+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
193+ liftToJSON2 toD _ toE _ (a, b, c, d, e) = Array $ V.create $ do
194+ mv <- VM.unsafeNew 5
195+ VM.unsafeWrite mv 0 (toJSON a)
196+ VM.unsafeWrite mv 1 (toJSON b)
197+ VM.unsafeWrite mv 2 (toJSON c)
198+ VM.unsafeWrite mv 3 (toD d)
199+ VM.unsafeWrite mv 4 (toE e)
200+ return mv
201+ {-# INLINE liftToJSON2 #-}
202+
203+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
204+ builder a >*<
205+ builder b >*<
206+ builder c >*<
207+ fromEncoding (toD d) >*<
208+ fromEncoding (toE e)
209+ {-# INLINE liftToEncoding2 #-}
210+
211+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
212+ liftToJSON = liftToJSON2 toJSON toJSONList
213+ {-# INLINE liftToJSON #-}
214+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
215+ {-# INLINE liftToEncoding #-}
216+
217+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON (a, b, c, d, e) where
218+ toJSON = toJSON2
219+ {-# INLINE toJSON #-}
220+ toEncoding = toEncoding2
221+ {-# INLINE toEncoding #-}
222+
223+instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON2 ((,,,,) a b c) where
224+ liftParseJSON2 pD _ pE _ = withArray "(a, b, c, d, e)" $ \t ->
225+ let n = V.length t
226+ in if n == 5
227+ then (,,,,)
228+ <$> parseJSONElemAtIndex parseJSON 0 t
229+ <*> parseJSONElemAtIndex parseJSON 1 t
230+ <*> parseJSONElemAtIndex parseJSON 2 t
231+ <*> parseJSONElemAtIndex pD 3 t
232+ <*> parseJSONElemAtIndex pE 4 t
233+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 5"
234+ {-# INLINE liftParseJSON2 #-}
235+
236+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON1 ((,,,,) a b c d) where
237+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
238+ {-# INLINE liftParseJSON #-}
239+
240+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON (a, b, c, d, e) where
241+ parseJSON = parseJSON2
242+ {-# INLINE parseJSON #-}
243+
244+
245+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) where
246+ liftToJSON2 toE _ toF _ (a, b, c, d, e, f) = Array $ V.create $ do
247+ mv <- VM.unsafeNew 6
248+ VM.unsafeWrite mv 0 (toJSON a)
249+ VM.unsafeWrite mv 1 (toJSON b)
250+ VM.unsafeWrite mv 2 (toJSON c)
251+ VM.unsafeWrite mv 3 (toJSON d)
252+ VM.unsafeWrite mv 4 (toE e)
253+ VM.unsafeWrite mv 5 (toF f)
254+ return mv
255+ {-# INLINE liftToJSON2 #-}
256+
257+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
258+ builder a >*<
259+ builder b >*<
260+ builder c >*<
261+ builder d >*<
262+ fromEncoding (toE e) >*<
263+ fromEncoding (toF f)
264+ {-# INLINE liftToEncoding2 #-}
265+
266+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
267+ liftToJSON = liftToJSON2 toJSON toJSONList
268+ {-# INLINE liftToJSON #-}
269+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
270+ {-# INLINE liftToEncoding #-}
271+
272+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON (a, b, c, d, e, f) where
273+ toJSON = toJSON2
274+ {-# INLINE toJSON #-}
275+ toEncoding = toEncoding2
276+ {-# INLINE toEncoding #-}
277+
278+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON2 ((,,,,,) a b c d) where
279+ liftParseJSON2 pE _ pF _ = withArray "(a, b, c, d, e, f)" $ \t ->
280+ let n = V.length t
281+ in if n == 6
282+ then (,,,,,)
283+ <$> parseJSONElemAtIndex parseJSON 0 t
284+ <*> parseJSONElemAtIndex parseJSON 1 t
285+ <*> parseJSONElemAtIndex parseJSON 2 t
286+ <*> parseJSONElemAtIndex parseJSON 3 t
287+ <*> parseJSONElemAtIndex pE 4 t
288+ <*> parseJSONElemAtIndex pF 5 t
289+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 6"
290+ {-# INLINE liftParseJSON2 #-}
291+
292+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON1 ((,,,,,) a b c d e) where
293+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
294+ {-# INLINE liftParseJSON #-}
295+
296+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON (a, b, c, d, e, f) where
297+ parseJSON = parseJSON2
298+ {-# INLINE parseJSON #-}
299+
300+
301+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,) a b c d e) where
302+ liftToJSON2 toF _ toG _ (a, b, c, d, e, f, g) = Array $ V.create $ do
303+ mv <- VM.unsafeNew 7
304+ VM.unsafeWrite mv 0 (toJSON a)
305+ VM.unsafeWrite mv 1 (toJSON b)
306+ VM.unsafeWrite mv 2 (toJSON c)
307+ VM.unsafeWrite mv 3 (toJSON d)
308+ VM.unsafeWrite mv 4 (toJSON e)
309+ VM.unsafeWrite mv 5 (toF f)
310+ VM.unsafeWrite mv 6 (toG g)
311+ return mv
312+ {-# INLINE liftToJSON2 #-}
313+
314+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
315+ builder a >*<
316+ builder b >*<
317+ builder c >*<
318+ builder d >*<
319+ builder e >*<
320+ fromEncoding (toF f) >*<
321+ fromEncoding (toG g)
322+ {-# INLINE liftToEncoding2 #-}
323+
324+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
325+ liftToJSON = liftToJSON2 toJSON toJSONList
326+ {-# INLINE liftToJSON #-}
327+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
328+ {-# INLINE liftToEncoding #-}
329+
330+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON (a, b, c, d, e, f, g) where
331+ toJSON = toJSON2
332+ {-# INLINE toJSON #-}
333+ toEncoding = toEncoding2
334+ {-# INLINE toEncoding #-}
335+
336+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON2 ((,,,,,,) a b c d e) where
337+ liftParseJSON2 pF _ pG _ = withArray "(a, b, c, d, e, f, g)" $ \t ->
338+ let n = V.length t
339+ in if n == 7
340+ then (,,,,,,)
341+ <$> parseJSONElemAtIndex parseJSON 0 t
342+ <*> parseJSONElemAtIndex parseJSON 1 t
343+ <*> parseJSONElemAtIndex parseJSON 2 t
344+ <*> parseJSONElemAtIndex parseJSON 3 t
345+ <*> parseJSONElemAtIndex parseJSON 4 t
346+ <*> parseJSONElemAtIndex pF 5 t
347+ <*> parseJSONElemAtIndex pG 6 t
348+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 7"
349+ {-# INLINE liftParseJSON2 #-}
350+
351+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON1 ((,,,,,,) a b c d e f) where
352+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
353+ {-# INLINE liftParseJSON #-}
354+
355+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON (a, b, c, d, e, f, g) where
356+ parseJSON = parseJSON2
357+ {-# INLINE parseJSON #-}
358+
359+
360+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2 ((,,,,,,,) a b c d e f) where
361+ liftToJSON2 toG _ toH _ (a, b, c, d, e, f, g, h) = Array $ V.create $ do
362+ mv <- VM.unsafeNew 8
363+ VM.unsafeWrite mv 0 (toJSON a)
364+ VM.unsafeWrite mv 1 (toJSON b)
365+ VM.unsafeWrite mv 2 (toJSON c)
366+ VM.unsafeWrite mv 3 (toJSON d)
367+ VM.unsafeWrite mv 4 (toJSON e)
368+ VM.unsafeWrite mv 5 (toJSON f)
369+ VM.unsafeWrite mv 6 (toG g)
370+ VM.unsafeWrite mv 7 (toH h)
371+ return mv
372+ {-# INLINE liftToJSON2 #-}
373+
374+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
375+ builder a >*<
376+ builder b >*<
377+ builder c >*<
378+ builder d >*<
379+ builder e >*<
380+ builder f >*<
381+ fromEncoding (toG g) >*<
382+ fromEncoding (toH h)
383+ {-# INLINE liftToEncoding2 #-}
384+
385+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
386+ liftToJSON = liftToJSON2 toJSON toJSONList
387+ {-# INLINE liftToJSON #-}
388+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
389+ {-# INLINE liftToEncoding #-}
390+
391+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
392+ toJSON = toJSON2
393+ {-# INLINE toJSON #-}
394+ toEncoding = toEncoding2
395+ {-# INLINE toEncoding #-}
396+
397+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON2 ((,,,,,,,) a b c d e f) where
398+ liftParseJSON2 pG _ pH _ = withArray "(a, b, c, d, e, f, g, h)" $ \t ->
399+ let n = V.length t
400+ in if n == 8
401+ then (,,,,,,,)
402+ <$> parseJSONElemAtIndex parseJSON 0 t
403+ <*> parseJSONElemAtIndex parseJSON 1 t
404+ <*> parseJSONElemAtIndex parseJSON 2 t
405+ <*> parseJSONElemAtIndex parseJSON 3 t
406+ <*> parseJSONElemAtIndex parseJSON 4 t
407+ <*> parseJSONElemAtIndex parseJSON 5 t
408+ <*> parseJSONElemAtIndex pG 6 t
409+ <*> parseJSONElemAtIndex pH 7 t
410+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 8"
411+ {-# INLINE liftParseJSON2 #-}
412+
413+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON1 ((,,,,,,,) a b c d e f g) where
414+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
415+ {-# INLINE liftParseJSON #-}
416+
417+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
418+ parseJSON = parseJSON2
419+ {-# INLINE parseJSON #-}
420+
421+
422+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON2 ((,,,,,,,,) a b c d e f g) where
423+ liftToJSON2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = Array $ V.create $ do
424+ mv <- VM.unsafeNew 9
425+ VM.unsafeWrite mv 0 (toJSON a)
426+ VM.unsafeWrite mv 1 (toJSON b)
427+ VM.unsafeWrite mv 2 (toJSON c)
428+ VM.unsafeWrite mv 3 (toJSON d)
429+ VM.unsafeWrite mv 4 (toJSON e)
430+ VM.unsafeWrite mv 5 (toJSON f)
431+ VM.unsafeWrite mv 6 (toJSON g)
432+ VM.unsafeWrite mv 7 (toH h)
433+ VM.unsafeWrite mv 8 (toI i)
434+ return mv
435+ {-# INLINE liftToJSON2 #-}
436+
437+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
438+ builder a >*<
439+ builder b >*<
440+ builder c >*<
441+ builder d >*<
442+ builder e >*<
443+ builder f >*<
444+ builder g >*<
445+ fromEncoding (toH h) >*<
446+ fromEncoding (toI i)
447+ {-# INLINE liftToEncoding2 #-}
448+
449+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
450+ liftToJSON = liftToJSON2 toJSON toJSONList
451+ {-# INLINE liftToJSON #-}
452+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
453+ {-# INLINE liftToEncoding #-}
454+
455+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
456+ toJSON = toJSON2
457+ {-# INLINE toJSON #-}
458+ toEncoding = toEncoding2
459+ {-# INLINE toEncoding #-}
460+
461+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON2 ((,,,,,,,,) a b c d e f g) where
462+ liftParseJSON2 pH _ pI _ = withArray "(a, b, c, d, e, f, g, h, i)" $ \t ->
463+ let n = V.length t
464+ in if n == 9
465+ then (,,,,,,,,)
466+ <$> parseJSONElemAtIndex parseJSON 0 t
467+ <*> parseJSONElemAtIndex parseJSON 1 t
468+ <*> parseJSONElemAtIndex parseJSON 2 t
469+ <*> parseJSONElemAtIndex parseJSON 3 t
470+ <*> parseJSONElemAtIndex parseJSON 4 t
471+ <*> parseJSONElemAtIndex parseJSON 5 t
472+ <*> parseJSONElemAtIndex parseJSON 6 t
473+ <*> parseJSONElemAtIndex pH 7 t
474+ <*> parseJSONElemAtIndex pI 8 t
475+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 9"
476+ {-# INLINE liftParseJSON2 #-}
477+
478+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
479+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
480+ {-# INLINE liftParseJSON #-}
481+
482+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
483+ parseJSON = parseJSON2
484+ {-# INLINE parseJSON #-}
485+
486+
487+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
488+ liftToJSON2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = Array $ V.create $ do
489+ mv <- VM.unsafeNew 10
490+ VM.unsafeWrite mv 0 (toJSON a)
491+ VM.unsafeWrite mv 1 (toJSON b)
492+ VM.unsafeWrite mv 2 (toJSON c)
493+ VM.unsafeWrite mv 3 (toJSON d)
494+ VM.unsafeWrite mv 4 (toJSON e)
495+ VM.unsafeWrite mv 5 (toJSON f)
496+ VM.unsafeWrite mv 6 (toJSON g)
497+ VM.unsafeWrite mv 7 (toJSON h)
498+ VM.unsafeWrite mv 8 (toI i)
499+ VM.unsafeWrite mv 9 (toJ j)
500+ return mv
501+ {-# INLINE liftToJSON2 #-}
502+
503+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
504+ builder a >*<
505+ builder b >*<
506+ builder c >*<
507+ builder d >*<
508+ builder e >*<
509+ builder f >*<
510+ builder g >*<
511+ builder h >*<
512+ fromEncoding (toI i) >*<
513+ fromEncoding (toJ j)
514+ {-# INLINE liftToEncoding2 #-}
515+
516+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
517+ liftToJSON = liftToJSON2 toJSON toJSONList
518+ {-# INLINE liftToJSON #-}
519+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
520+ {-# INLINE liftToEncoding #-}
521+
522+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
523+ toJSON = toJSON2
524+ {-# INLINE toJSON #-}
525+ toEncoding = toEncoding2
526+ {-# INLINE toEncoding #-}
527+
528+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
529+ liftParseJSON2 pI _ pJ _ = withArray "(a, b, c, d, e, f, g, h, i, j)" $ \t ->
530+ let n = V.length t
531+ in if n == 10
532+ then (,,,,,,,,,)
533+ <$> parseJSONElemAtIndex parseJSON 0 t
534+ <*> parseJSONElemAtIndex parseJSON 1 t
535+ <*> parseJSONElemAtIndex parseJSON 2 t
536+ <*> parseJSONElemAtIndex parseJSON 3 t
537+ <*> parseJSONElemAtIndex parseJSON 4 t
538+ <*> parseJSONElemAtIndex parseJSON 5 t
539+ <*> parseJSONElemAtIndex parseJSON 6 t
540+ <*> parseJSONElemAtIndex parseJSON 7 t
541+ <*> parseJSONElemAtIndex pI 8 t
542+ <*> parseJSONElemAtIndex pJ 9 t
543+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 10"
544+ {-# INLINE liftParseJSON2 #-}
545+
546+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
547+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
548+ {-# INLINE liftParseJSON #-}
549+
550+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
551+ parseJSON = parseJSON2
552+ {-# INLINE parseJSON #-}
553+
554+
555+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
556+ liftToJSON2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = Array $ V.create $ do
557+ mv <- VM.unsafeNew 11
558+ VM.unsafeWrite mv 0 (toJSON a)
559+ VM.unsafeWrite mv 1 (toJSON b)
560+ VM.unsafeWrite mv 2 (toJSON c)
561+ VM.unsafeWrite mv 3 (toJSON d)
562+ VM.unsafeWrite mv 4 (toJSON e)
563+ VM.unsafeWrite mv 5 (toJSON f)
564+ VM.unsafeWrite mv 6 (toJSON g)
565+ VM.unsafeWrite mv 7 (toJSON h)
566+ VM.unsafeWrite mv 8 (toJSON i)
567+ VM.unsafeWrite mv 9 (toJ j)
568+ VM.unsafeWrite mv 10 (toK k)
569+ return mv
570+ {-# INLINE liftToJSON2 #-}
571+
572+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
573+ builder a >*<
574+ builder b >*<
575+ builder c >*<
576+ builder d >*<
577+ builder e >*<
578+ builder f >*<
579+ builder g >*<
580+ builder h >*<
581+ builder i >*<
582+ fromEncoding (toJ j) >*<
583+ fromEncoding (toK k)
584+ {-# INLINE liftToEncoding2 #-}
585+
586+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
587+ liftToJSON = liftToJSON2 toJSON toJSONList
588+ {-# INLINE liftToJSON #-}
589+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
590+ {-# INLINE liftToEncoding #-}
591+
592+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
593+ toJSON = toJSON2
594+ {-# INLINE toJSON #-}
595+ toEncoding = toEncoding2
596+ {-# INLINE toEncoding #-}
597+
598+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
599+ liftParseJSON2 pJ _ pK _ = withArray "(a, b, c, d, e, f, g, h, i, j, k)" $ \t ->
600+ let n = V.length t
601+ in if n == 11
602+ then (,,,,,,,,,,)
603+ <$> parseJSONElemAtIndex parseJSON 0 t
604+ <*> parseJSONElemAtIndex parseJSON 1 t
605+ <*> parseJSONElemAtIndex parseJSON 2 t
606+ <*> parseJSONElemAtIndex parseJSON 3 t
607+ <*> parseJSONElemAtIndex parseJSON 4 t
608+ <*> parseJSONElemAtIndex parseJSON 5 t
609+ <*> parseJSONElemAtIndex parseJSON 6 t
610+ <*> parseJSONElemAtIndex parseJSON 7 t
611+ <*> parseJSONElemAtIndex parseJSON 8 t
612+ <*> parseJSONElemAtIndex pJ 9 t
613+ <*> parseJSONElemAtIndex pK 10 t
614+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 11"
615+ {-# INLINE liftParseJSON2 #-}
616+
617+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
618+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
619+ {-# INLINE liftParseJSON #-}
620+
621+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
622+ parseJSON = parseJSON2
623+ {-# INLINE parseJSON #-}
624+
625+
626+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
627+ liftToJSON2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = Array $ V.create $ do
628+ mv <- VM.unsafeNew 12
629+ VM.unsafeWrite mv 0 (toJSON a)
630+ VM.unsafeWrite mv 1 (toJSON b)
631+ VM.unsafeWrite mv 2 (toJSON c)
632+ VM.unsafeWrite mv 3 (toJSON d)
633+ VM.unsafeWrite mv 4 (toJSON e)
634+ VM.unsafeWrite mv 5 (toJSON f)
635+ VM.unsafeWrite mv 6 (toJSON g)
636+ VM.unsafeWrite mv 7 (toJSON h)
637+ VM.unsafeWrite mv 8 (toJSON i)
638+ VM.unsafeWrite mv 9 (toJSON j)
639+ VM.unsafeWrite mv 10 (toK k)
640+ VM.unsafeWrite mv 11 (toL l)
641+ return mv
642+ {-# INLINE liftToJSON2 #-}
643+
644+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
645+ builder a >*<
646+ builder b >*<
647+ builder c >*<
648+ builder d >*<
649+ builder e >*<
650+ builder f >*<
651+ builder g >*<
652+ builder h >*<
653+ builder i >*<
654+ builder j >*<
655+ fromEncoding (toK k) >*<
656+ fromEncoding (toL l)
657+ {-# INLINE liftToEncoding2 #-}
658+
659+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
660+ liftToJSON = liftToJSON2 toJSON toJSONList
661+ {-# INLINE liftToJSON #-}
662+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
663+ {-# INLINE liftToEncoding #-}
664+
665+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
666+ toJSON = toJSON2
667+ {-# INLINE toJSON #-}
668+ toEncoding = toEncoding2
669+ {-# INLINE toEncoding #-}
670+
671+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
672+ liftParseJSON2 pK _ pL _ = withArray "(a, b, c, d, e, f, g, h, i, j, k, l)" $ \t ->
673+ let n = V.length t
674+ in if n == 12
675+ then (,,,,,,,,,,,)
676+ <$> parseJSONElemAtIndex parseJSON 0 t
677+ <*> parseJSONElemAtIndex parseJSON 1 t
678+ <*> parseJSONElemAtIndex parseJSON 2 t
679+ <*> parseJSONElemAtIndex parseJSON 3 t
680+ <*> parseJSONElemAtIndex parseJSON 4 t
681+ <*> parseJSONElemAtIndex parseJSON 5 t
682+ <*> parseJSONElemAtIndex parseJSON 6 t
683+ <*> parseJSONElemAtIndex parseJSON 7 t
684+ <*> parseJSONElemAtIndex parseJSON 8 t
685+ <*> parseJSONElemAtIndex parseJSON 9 t
686+ <*> parseJSONElemAtIndex pK 10 t
687+ <*> parseJSONElemAtIndex pL 11 t
688+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 12"
689+ {-# INLINE liftParseJSON2 #-}
690+
691+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
692+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
693+ {-# INLINE liftParseJSON #-}
694+
695+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
696+ parseJSON = parseJSON2
697+ {-# INLINE parseJSON #-}
698+
699+
700+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
701+ liftToJSON2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = Array $ V.create $ do
702+ mv <- VM.unsafeNew 13
703+ VM.unsafeWrite mv 0 (toJSON a)
704+ VM.unsafeWrite mv 1 (toJSON b)
705+ VM.unsafeWrite mv 2 (toJSON c)
706+ VM.unsafeWrite mv 3 (toJSON d)
707+ VM.unsafeWrite mv 4 (toJSON e)
708+ VM.unsafeWrite mv 5 (toJSON f)
709+ VM.unsafeWrite mv 6 (toJSON g)
710+ VM.unsafeWrite mv 7 (toJSON h)
711+ VM.unsafeWrite mv 8 (toJSON i)
712+ VM.unsafeWrite mv 9 (toJSON j)
713+ VM.unsafeWrite mv 10 (toJSON k)
714+ VM.unsafeWrite mv 11 (toL l)
715+ VM.unsafeWrite mv 12 (toM m)
716+ return mv
717+ {-# INLINE liftToJSON2 #-}
718+
719+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
720+ builder a >*<
721+ builder b >*<
722+ builder c >*<
723+ builder d >*<
724+ builder e >*<
725+ builder f >*<
726+ builder g >*<
727+ builder h >*<
728+ builder i >*<
729+ builder j >*<
730+ builder k >*<
731+ fromEncoding (toL l) >*<
732+ fromEncoding (toM m)
733+ {-# INLINE liftToEncoding2 #-}
734+
735+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
736+ liftToJSON = liftToJSON2 toJSON toJSONList
737+ {-# INLINE liftToJSON #-}
738+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
739+ {-# INLINE liftToEncoding #-}
740+
741+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
742+ toJSON = toJSON2
743+ {-# INLINE toJSON #-}
744+ toEncoding = toEncoding2
745+ {-# INLINE toEncoding #-}
746+
747+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
748+ liftParseJSON2 pL _ pM _ = withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m)" $ \t ->
749+ let n = V.length t
750+ in if n == 13
751+ then (,,,,,,,,,,,,)
752+ <$> parseJSONElemAtIndex parseJSON 0 t
753+ <*> parseJSONElemAtIndex parseJSON 1 t
754+ <*> parseJSONElemAtIndex parseJSON 2 t
755+ <*> parseJSONElemAtIndex parseJSON 3 t
756+ <*> parseJSONElemAtIndex parseJSON 4 t
757+ <*> parseJSONElemAtIndex parseJSON 5 t
758+ <*> parseJSONElemAtIndex parseJSON 6 t
759+ <*> parseJSONElemAtIndex parseJSON 7 t
760+ <*> parseJSONElemAtIndex parseJSON 8 t
761+ <*> parseJSONElemAtIndex parseJSON 9 t
762+ <*> parseJSONElemAtIndex parseJSON 10 t
763+ <*> parseJSONElemAtIndex pL 11 t
764+ <*> parseJSONElemAtIndex pM 12 t
765+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 13"
766+ {-# INLINE liftParseJSON2 #-}
767+
768+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
769+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
770+ {-# INLINE liftParseJSON #-}
771+
772+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
773+ parseJSON = parseJSON2
774+ {-# INLINE parseJSON #-}
775+
776+
777+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
778+ liftToJSON2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = Array $ V.create $ do
779+ mv <- VM.unsafeNew 14
780+ VM.unsafeWrite mv 0 (toJSON a)
781+ VM.unsafeWrite mv 1 (toJSON b)
782+ VM.unsafeWrite mv 2 (toJSON c)
783+ VM.unsafeWrite mv 3 (toJSON d)
784+ VM.unsafeWrite mv 4 (toJSON e)
785+ VM.unsafeWrite mv 5 (toJSON f)
786+ VM.unsafeWrite mv 6 (toJSON g)
787+ VM.unsafeWrite mv 7 (toJSON h)
788+ VM.unsafeWrite mv 8 (toJSON i)
789+ VM.unsafeWrite mv 9 (toJSON j)
790+ VM.unsafeWrite mv 10 (toJSON k)
791+ VM.unsafeWrite mv 11 (toJSON l)
792+ VM.unsafeWrite mv 12 (toM m)
793+ VM.unsafeWrite mv 13 (toN n)
794+ return mv
795+ {-# INLINE liftToJSON2 #-}
796+
797+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
798+ builder a >*<
799+ builder b >*<
800+ builder c >*<
801+ builder d >*<
802+ builder e >*<
803+ builder f >*<
804+ builder g >*<
805+ builder h >*<
806+ builder i >*<
807+ builder j >*<
808+ builder k >*<
809+ builder l >*<
810+ fromEncoding (toM m) >*<
811+ fromEncoding (toN n)
812+ {-# INLINE liftToEncoding2 #-}
813+
814+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
815+ liftToJSON = liftToJSON2 toJSON toJSONList
816+ {-# INLINE liftToJSON #-}
817+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
818+ {-# INLINE liftToEncoding #-}
819+
820+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
821+ toJSON = toJSON2
822+ {-# INLINE toJSON #-}
823+ toEncoding = toEncoding2
824+ {-# INLINE toEncoding #-}
825+
826+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
827+ liftParseJSON2 pM _ pN _ = withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m, n)" $ \t ->
828+ let n = V.length t
829+ in if n == 14
830+ then (,,,,,,,,,,,,,)
831+ <$> parseJSONElemAtIndex parseJSON 0 t
832+ <*> parseJSONElemAtIndex parseJSON 1 t
833+ <*> parseJSONElemAtIndex parseJSON 2 t
834+ <*> parseJSONElemAtIndex parseJSON 3 t
835+ <*> parseJSONElemAtIndex parseJSON 4 t
836+ <*> parseJSONElemAtIndex parseJSON 5 t
837+ <*> parseJSONElemAtIndex parseJSON 6 t
838+ <*> parseJSONElemAtIndex parseJSON 7 t
839+ <*> parseJSONElemAtIndex parseJSON 8 t
840+ <*> parseJSONElemAtIndex parseJSON 9 t
841+ <*> parseJSONElemAtIndex parseJSON 10 t
842+ <*> parseJSONElemAtIndex parseJSON 11 t
843+ <*> parseJSONElemAtIndex pM 12 t
844+ <*> parseJSONElemAtIndex pN 13 t
845+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 14"
846+ {-# INLINE liftParseJSON2 #-}
847+
848+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
849+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
850+ {-# INLINE liftParseJSON #-}
851+
852+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
853+ parseJSON = parseJSON2
854+ {-# INLINE parseJSON #-}
855+
856+
857+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
858+ liftToJSON2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = Array $ V.create $ do
859+ mv <- VM.unsafeNew 15
860+ VM.unsafeWrite mv 0 (toJSON a)
861+ VM.unsafeWrite mv 1 (toJSON b)
862+ VM.unsafeWrite mv 2 (toJSON c)
863+ VM.unsafeWrite mv 3 (toJSON d)
864+ VM.unsafeWrite mv 4 (toJSON e)
865+ VM.unsafeWrite mv 5 (toJSON f)
866+ VM.unsafeWrite mv 6 (toJSON g)
867+ VM.unsafeWrite mv 7 (toJSON h)
868+ VM.unsafeWrite mv 8 (toJSON i)
869+ VM.unsafeWrite mv 9 (toJSON j)
870+ VM.unsafeWrite mv 10 (toJSON k)
871+ VM.unsafeWrite mv 11 (toJSON l)
872+ VM.unsafeWrite mv 12 (toJSON m)
873+ VM.unsafeWrite mv 13 (toN n)
874+ VM.unsafeWrite mv 14 (toO o)
875+ return mv
876+ {-# INLINE liftToJSON2 #-}
877+
878+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
879+ builder a >*<
880+ builder b >*<
881+ builder c >*<
882+ builder d >*<
883+ builder e >*<
884+ builder f >*<
885+ builder g >*<
886+ builder h >*<
887+ builder i >*<
888+ builder j >*<
889+ builder k >*<
890+ builder l >*<
891+ builder m >*<
892+ fromEncoding (toN n) >*<
893+ fromEncoding (toO o)
894+ {-# INLINE liftToEncoding2 #-}
895+
896+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
897+ liftToJSON = liftToJSON2 toJSON toJSONList
898+ {-# INLINE liftToJSON #-}
899+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
900+ {-# INLINE liftToEncoding #-}
901+
902+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
903+ toJSON = toJSON2
904+ {-# INLINE toJSON #-}
905+ toEncoding = toEncoding2
906+ {-# INLINE toEncoding #-}
907+
908+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
909+ liftParseJSON2 pN _ pO _ = withArray "(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)" $ \t ->
910+ let n = V.length t
911+ in if n == 15
912+ then (,,,,,,,,,,,,,,)
913+ <$> parseJSONElemAtIndex parseJSON 0 t
914+ <*> parseJSONElemAtIndex parseJSON 1 t
915+ <*> parseJSONElemAtIndex parseJSON 2 t
916+ <*> parseJSONElemAtIndex parseJSON 3 t
917+ <*> parseJSONElemAtIndex parseJSON 4 t
918+ <*> parseJSONElemAtIndex parseJSON 5 t
919+ <*> parseJSONElemAtIndex parseJSON 6 t
920+ <*> parseJSONElemAtIndex parseJSON 7 t
921+ <*> parseJSONElemAtIndex parseJSON 8 t
922+ <*> parseJSONElemAtIndex parseJSON 9 t
923+ <*> parseJSONElemAtIndex parseJSON 10 t
924+ <*> parseJSONElemAtIndex parseJSON 11 t
925+ <*> parseJSONElemAtIndex parseJSON 12 t
926+ <*> parseJSONElemAtIndex pN 13 t
927+ <*> parseJSONElemAtIndex pO 14 t
928+ else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 15"
929+ {-# INLINE liftParseJSON2 #-}
930+
931+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
932+ liftParseJSON = liftParseJSON2 parseJSON parseJSONList
933+ {-# INLINE liftParseJSON #-}
934+
935+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
936+ parseJSON = parseJSON2
937+ {-# INLINE parseJSON #-}
938+
939+
Data/Aeson/Types/Internal.hs+82−196
@@ -1,9 +1,5 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving, Rank2Types,
5−{-# LANGUAGE NoImplicitPrelude #-}
2+ RecordWildCards #-}
6−{-# LANGUAGE Rank2Types #-}
7#if __GLASGOW_HASKELL__ >= 800
3#if __GLASGOW_HASKELL__ >= 800
8-- a) THQ works on cross-compilers and unregisterised GHCs
4-- 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)
5-- b) may make compilation faster as no dynamic loading is ever needed (not sure about this)
@@ -28,12 +24,14 @@ module Data.Aeson.Types.Internal
28 (
24 (
29 -- * Core JSON types
25 -- * Core JSON types
30 Value(..)
26 Value(..)
27+ , Encoding(..)
28+ , unsafeToEncoding
29+ , Series(..)
31 , Array
30 , Array
32 , emptyArray, isEmptyArray
31 , emptyArray, isEmptyArray
33 , Pair
32 , Pair
34 , Object
33 , Object
35 , emptyObject
34 , emptyObject
36−
37 -- * Type conversion
35 -- * Type conversion
38 , Parser
36 , Parser
39 , Result(..)
37 , Result(..)
@@ -45,33 +43,16 @@ module Data.Aeson.Types.Internal
45 , parseEither
43 , parseEither
46 , parseMaybe
44 , parseMaybe
47 , modifyFailure
45 , modifyFailure
48− , prependFailure
49− , parserThrowError
50− , parserCatchError
51 , formatError
46 , formatError
52− , formatPath
53− , formatRelativePath
54 , (<?>)
47 , (<?>)
55 -- * Constructors and accessors
48 -- * Constructors and accessors
56 , object
49 , object
57
50
58 -- * Generic and TH encoding configuration
51 -- * Generic and TH encoding configuration
59− , Options(
52+ , Options(..)
60− fieldLabelModifier
61− , constructorTagModifier
62− , allNullaryToStringTag
63− , omitNothingFields
64− , sumEncoding
65− , unwrapUnaryRecords
66− , tagSingleConstructors
67− , rejectUnknownFields
68− )
69−
70 , SumEncoding(..)
53 , SumEncoding(..)
71− , JSONKeyOptions(keyModifier)
72 , defaultOptions
54 , defaultOptions
73 , defaultTaggedObject
55 , defaultTaggedObject
74− , defaultJSONKeyOptions
75
56
76 -- * Used for changing CamelCase names into something else.
57 -- * Used for changing CamelCase names into something else.
77 , camelTo
58 , camelTo
@@ -81,34 +62,36 @@ module Data.Aeson.Types.Internal
81 , DotNetTime(..)
62 , DotNetTime(..)
82 ) where
63 ) where
83
64
84−import Prelude.Compat
85−
86−import Control.Applicative (Alternative(..))
87import Control.Arrow (first)
65import Control.Arrow (first)
66+import Control.Applicative
88import Control.DeepSeq (NFData(..))
67import Control.DeepSeq (NFData(..))
89import Control.Monad (MonadPlus(..), ap)
68import Control.Monad (MonadPlus(..), ap)
69+import qualified Control.Monad.Fail as Fail
70+import Data.ByteString.Builder (Builder, char7, toLazyByteString)
90import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
71import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
91import Data.Data (Data)
72import Data.Data (Data)
92import Data.Foldable (foldl')
73import Data.Foldable (foldl')
93import Data.HashMap.Strict (HashMap)
74import Data.HashMap.Strict (HashMap)
94import Data.Hashable (Hashable(..))
75import Data.Hashable (Hashable(..))
95−import Data.List (intercalate)
96−import Data.Scientific (Scientific)
97import Data.Semigroup (Semigroup((<>)))
76import Data.Semigroup (Semigroup((<>)))
77+import Data.Scientific (Scientific)
98import Data.String (IsString(..))
78import Data.String (IsString(..))
99import Data.Text (Text, pack, unpack)
79import Data.Text (Text, pack, unpack)
100import Data.Time (UTCTime)
80import Data.Time (UTCTime)
101import Data.Time.Format (FormatTime)
81import Data.Time.Format (FormatTime)
102import Data.Typeable (Typeable)
82import Data.Typeable (Typeable)
103import Data.Vector (Vector)
83import 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
84import qualified Data.HashMap.Strict as H
108import qualified Data.Scientific as S
85import qualified Data.Scientific as S
109import qualified Data.Vector as V
86import qualified Data.Vector as V
110import qualified Language.Haskell.TH.Syntax as TH
87import qualified Language.Haskell.TH.Syntax as TH
111
88
89+#if !MIN_VERSION_base(4,8,0)
90+import Data.Foldable (Foldable(..))
91+import Data.Monoid (Monoid(..))
92+import Data.Traversable (Traversable(..))
93+#endif
94+
112#if !MIN_VERSION_unordered_containers(0,2,6)
95#if !MIN_VERSION_unordered_containers(0,2,6)
113import Data.List (sort)
96import Data.List (sort)
114#endif
97#endif
@@ -121,7 +104,7 @@ data JSONPathElement = Key Text
121 | Index {-# UNPACK #-} !Int
104 | Index {-# UNPACK #-} !Int
122 -- ^ JSON path element of an index into an
105 -- ^ JSON path element of an index into an
123 -- array, \"array[index]\".
106 -- array, \"array[index]\".
124− deriving (Eq, Show, Typeable, Ord)
107+ deriving (Eq, Show, Typeable)
125type JSONPath = [JSONPathElement]
108type JSONPath = [JSONPathElement]
126
109
127-- | The internal result of running a 'Parser'.
110-- | The internal result of running a 'Parser'.
@@ -156,7 +139,7 @@ instance Functor Result where
156 fmap _ (Error err) = Error err
139 fmap _ (Error err) = Error err
157 {-# INLINE fmap #-}
140 {-# INLINE fmap #-}
158
141
159−instance Monad.Monad IResult where
142+instance Monad IResult where
160 return = pure
143 return = pure
161 {-# INLINE return #-}
144 {-# INLINE return #-}
162
145
@@ -164,16 +147,14 @@ instance Monad.Monad IResult where
164 IError path err >>= _ = IError path err
147 IError path err >>= _ = IError path err
165 {-# INLINE (>>=) #-}
148 {-# INLINE (>>=) #-}
166
149
167−#if !(MIN_VERSION_base(4,13,0))
168 fail = Fail.fail
150 fail = Fail.fail
169 {-# INLINE fail #-}
151 {-# INLINE fail #-}
170−#endif
171
152
172instance Fail.MonadFail IResult where
153instance Fail.MonadFail IResult where
173 fail err = IError [] err
154 fail err = IError [] err
174 {-# INLINE fail #-}
155 {-# INLINE fail #-}
175
156
176−instance Monad.Monad Result where
157+instance Monad Result where
177 return = pure
158 return = pure
178 {-# INLINE return #-}
159 {-# INLINE return #-}
179
160
@@ -181,10 +162,8 @@ instance Monad.Monad Result where
181 Error err >>= _ = Error err
162 Error err >>= _ = Error err
182 {-# INLINE (>>=) #-}
163 {-# INLINE (>>=) #-}
183
164
184−#if !(MIN_VERSION_base(4,13,0))
185 fail = Fail.fail
165 fail = Fail.fail
186 {-# INLINE fail #-}
166 {-# INLINE fail #-}
187−#endif
188
167
189instance Fail.MonadFail Result where
168instance Fail.MonadFail Result where
190 fail err = Error err
169 fail err = Error err
@@ -281,9 +260,7 @@ type Failure f r = JSONPath -> String -> f r
281-- | Success continuation.
260-- | Success continuation.
282type Success a f r = a -> f r
261type Success a f r = a -> f r
283
262
284−-- | A JSON parser. N.B. This might not fit your usual understanding of
263+-- | A JSON parser.
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 {
264newtype Parser a = Parser {
288 runParser :: forall f r.
265 runParser :: forall f r.
289 JSONPath
266 JSONPath
@@ -292,17 +269,14 @@ newtype Parser a = Parser {
292 -> f r
269 -> f r
293 }
270 }
294
271
295−instance Monad.Monad Parser where
272+instance Monad Parser where
296 m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks
273 m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks
297 in runParser m path kf ks'
274 in runParser m path kf ks'
298 {-# INLINE (>>=) #-}
275 {-# INLINE (>>=) #-}
299 return = pure
276 return = pure
300 {-# INLINE return #-}
277 {-# INLINE return #-}
301−
302−#if !(MIN_VERSION_base(4,13,0))
303 fail = Fail.fail
278 fail = Fail.fail
304 {-# INLINE fail #-}
279 {-# INLINE fail #-}
305−#endif
306
280
307instance Fail.MonadFail Parser where
281instance Fail.MonadFail Parser where
308 fail msg = Parser $ \path kf _ks -> kf (reverse path) msg
282 fail msg = Parser $ \path kf _ks -> kf (reverse path) msg
@@ -345,7 +319,8 @@ instance Monoid (Parser a) where
345apP :: Parser (a -> b) -> Parser a -> Parser b
319apP :: Parser (a -> b) -> Parser a -> Parser b
346apP d e = do
320apP d e = do
347 b <- d
321 b <- d
348− b <$> e
322+ a <- e
323+ return (b a)
349{-# INLINE apP #-}
324{-# INLINE apP #-}
350
325
351-- | A JSON \"object\" (key\/value map).
326-- | A JSON \"object\" (key\/value map).
@@ -361,7 +336,53 @@ data Value = Object !Object
361 | Number !Scientific
336 | Number !Scientific
362 | Bool !Bool
337 | Bool !Bool
363 | Null
338 | Null
364− deriving (Eq, Read, Show, Typeable, Data, Generic)
339+ deriving (Eq, Read, Show, Typeable, Data)
340+
341+-- | An encoding of a JSON value.
342+newtype Encoding = Encoding {
343+ fromEncoding :: Builder
344+ -- ^ Acquire the underlying bytestring builder.
345+ } deriving (Semigroup,Monoid)
346+
347+-- | Make Encoding from Builder.
348+--
349+-- Use with care! You have to make sure that the passed Builder
350+-- is a valid JSON Encoding!
351+unsafeToEncoding :: Builder -> Encoding
352+unsafeToEncoding = Encoding
353+
354+instance Show Encoding where
355+ show (Encoding e) = show (toLazyByteString e)
356+
357+instance Eq Encoding where
358+ Encoding a == Encoding b = toLazyByteString a == toLazyByteString b
359+
360+instance Ord Encoding where
361+ compare (Encoding a) (Encoding b) =
362+ compare (toLazyByteString a) (toLazyByteString b)
363+
364+-- | A series of values that, when encoded, should be separated by
365+-- commas. Since 0.11.0.0, the '.=' operator is overloaded to create
366+-- either @(Text, Value)@ or 'Series'. You can use Series when
367+-- encoding directly to a bytestring builder as in the following
368+-- example:
369+--
370+-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
371+data Series = Empty
372+ | Value Encoding
373+ deriving (Typeable)
374+
375+instance Semigroup Series where
376+ Empty <> a = a
377+ Value a <> b =
378+ Value $
379+ a <> case b of
380+ Empty -> mempty
381+ Value c -> Encoding (char7 ',') <> c
382+
383+instance Monoid Series where
384+ mempty = Empty
385+ mappend = (<>)
365
386
366-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
387-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
367-- serialization format as Microsoft .NET, whose
388-- serialization format as Microsoft .NET, whose
@@ -461,17 +482,7 @@ parseEither m v = runParser (m v) [] onError Right
461-- | Annotate an error message with a
482-- | Annotate an error message with a
462-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.
483-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.
463formatError :: JSONPath -> String -> String
484formatError :: JSONPath -> String -> String
464−formatError path msg = "Error in " ++ formatPath path ++ ": " ++ msg
485+formatError path msg = "Error in " ++ (format "$" path) ++ ": " ++ msg
465−
466−-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String',
467−-- representing the root object as @$@.
468−formatPath :: JSONPath -> String
469−formatPath path = "$" ++ formatRelativePath path
470−
471−-- | Format a <http://goessner.net/articles/JsonPath/ JSONPath> as a 'String'
472−-- which represents the path relative to some root object.
473−formatRelativePath :: JSONPath -> String
474−formatRelativePath path = format "" path
475 where
486 where
476 format :: String -> JSONPath -> String
487 format :: String -> JSONPath -> String
477 format pfx [] = pfx
488 format pfx [] = pfx
@@ -534,40 +545,13 @@ p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks
534--
545--
535-- Since 0.6.2.0
546-- Since 0.6.2.0
536modifyFailure :: (String -> String) -> Parser a -> Parser a
547modifyFailure :: (String -> String) -> Parser a -> Parser a
537−modifyFailure f (Parser p) = Parser $ \path kf ks ->
548+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
549
563--------------------------------------------------------------------------------
550--------------------------------------------------------------------------------
564-- Generic and TH encoding configuration
551-- Generic and TH encoding configuration
565--------------------------------------------------------------------------------
552--------------------------------------------------------------------------------
566
553
567-- | Options that specify how to encode\/decode your datatype to\/from JSON.
554-- | 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
555data Options = Options
572 { fieldLabelModifier :: String -> String
556 { fieldLabelModifier :: String -> String
573 -- ^ Function applied to field labels.
557 -- ^ Function applied to field labels.
@@ -584,67 +568,24 @@ data Options = Options
584 -- ^ If 'True' record fields with a 'Nothing' value will be
568 -- ^ If 'True' record fields with a 'Nothing' value will be
585 -- omitted from the resulting object. If 'False' the resulting
569 -- omitted from the resulting object. If 'False' the resulting
586 -- object will include those fields mapping to @null@.
570 -- 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
571 , sumEncoding :: SumEncoding
621 -- ^ Specifies how to encode constructors of a sum datatype.
572 -- ^ Specifies how to encode constructors of a sum datatype.
622 , unwrapUnaryRecords :: Bool
573 , unwrapUnaryRecords :: Bool
623 -- ^ Hide the field name when a record constructor has only one
574 -- ^ Hide the field name when a record constructor has only one
624 -- field, like a newtype.
575 -- 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 }
576 }
633
577
634instance Show Options where
578instance Show Options where
635− show (Options f c a o s u t r) =
579+ show Options{..} = "Options {" ++
636− "Options {"
637− ++ intercalate ", "
638− [ "fieldLabelModifier =~ " ++ show (f "exampleField")
580+ "fieldLabelModifier =~ " ++
581+ show (fieldLabelModifier "exampleField") ++ ", " ++
639− , "constructorTagModifier =~ " ++ show (c "ExampleConstructor")
582+ "constructorTagModifier =~ " ++
583+ show (constructorTagModifier "ExampleConstructor") ++ ", " ++
640− , "allNullaryToStringTag = " ++ show a
584+ "allNullaryToStringTag = " ++ show allNullaryToStringTag ++ ", " ++
641− , "omitNothingFields = " ++ show o
585+ "omitNothingFields = " ++ show omitNothingFields ++ ", " ++
642− , "sumEncoding = " ++ show s
586+ "sumEncoding = " ++ show sumEncoding ++ ", " ++
643− , "unwrapUnaryRecords = " ++ show u
587+ "unwrapUnaryRecords = " ++ show unwrapUnaryRecords ++
644− , "tagSingleConstructors = " ++ show t
645− , "rejectUnknownFields = " ++ show r
646− ]
647− ++ "}"
588+ "}"
648
589
649-- | Specifies how to encode constructors of a sum datatype.
590-- | Specifies how to encode constructors of a sum datatype.
650data SumEncoding =
591data SumEncoding =
@@ -660,20 +601,6 @@ data SumEncoding =
660 -- by the encoded value of that field! If the constructor is not a
601 -- by the encoded value of that field! If the constructor is not a
661 -- record the encoded constructor contents will be stored under
602 -- record the encoded constructor contents will be stored under
662 -- the 'contentsFieldName' field.
603 -- 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
604 | ObjectWithSingleField
678 -- ^ A constructor will be encoded to an object with a single
605 -- ^ A constructor will be encoded to an object with a single
679 -- field named after the constructor tag (modified by the
606 -- field named after the constructor tag (modified by the
@@ -686,33 +613,6 @@ data SumEncoding =
686 -- contents of the constructor.
613 -- contents of the constructor.
687 deriving (Eq, Show)
614 deriving (Eq, Show)
688
615
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−
716-- | Default encoding 'Options':
616-- | Default encoding 'Options':
717--
617--
718-- @
618-- @
@@ -723,8 +623,6 @@ data JSONKeyOptions = JSONKeyOptions
723-- , 'omitNothingFields' = False
623-- , 'omitNothingFields' = False
724-- , 'sumEncoding' = 'defaultTaggedObject'
624-- , 'sumEncoding' = 'defaultTaggedObject'
725-- , 'unwrapUnaryRecords' = False
625-- , 'unwrapUnaryRecords' = False
726−-- , 'tagSingleConstructors' = False
727−-- , 'rejectUnknownFields' = False
728-- }
626-- }
729-- @
627-- @
730defaultOptions :: Options
628defaultOptions :: Options
@@ -735,8 +633,6 @@ defaultOptions = Options
735 , omitNothingFields = False
633 , omitNothingFields = False
736 , sumEncoding = defaultTaggedObject
634 , sumEncoding = defaultTaggedObject
737 , unwrapUnaryRecords = False
635 , unwrapUnaryRecords = False
738− , tagSingleConstructors = False
739− , rejectUnknownFields = False
740 }
636 }
741
637
742-- | Default 'TaggedObject' 'SumEncoding' options:
638-- | Default 'TaggedObject' 'SumEncoding' options:
@@ -753,16 +649,6 @@ defaultTaggedObject = TaggedObject
753 , contentsFieldName = "contents"
649 , contentsFieldName = "contents"
754 }
650 }
755
651
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
652-- | Converts from CamelCase to another lower case, interspersing
767-- the character between all capital letters and their previous
653-- the character between all capital letters and their previous
768-- entries, except those capital letters that appear together,
654-- entries, except those capital letters that appear together,
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+4−3
@@ -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+79−153
@@ -1,12 +1,12 @@
1name: aeson
1name: aeson
2−version: 1.4.6.0
2+version: 0.12.0.0
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5category: Text, Web, JSON
5category: Text, Web, JSON
6copyright: (c) 2011-2016 Bryan O'Sullivan
6copyright: (c) 2011-2016 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
11tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1
11tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1
12synopsis: Fast JSON parsing and encoding
12synopsis: Fast JSON parsing and encoding
@@ -21,10 +21,23 @@ 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 a late 2013 MacBook Pro (2.6GHz Core i7),
25+ running 64-bit GHC 7.10.1, for mostly-English tweets from Twitter's
26+ JSON search API:
27+ .
28+ * 6.4 KB payloads, English: 7570 msg\/sec (47.6 MB\/sec)
29+ .
30+ * 14.6 KB payloads, Japanese: 3261 msg\/sec (46.6 MB\/sec)
31+ .
32+ Encoding performance on the same machine and data:
33+ .
34+ * 6.4 KB payloads, English: 22738 msg\/sec (142.9 MB\/sec)
35+ .
36+ * 14.6 KB payloads, Japanese: 15911 msg\/sec (227.4 MB\/sec)
37+ .
24 (A note on naming: in Greek mythology, Aeson was the father of Jason.)
38 (A note on naming: in Greek mythology, Aeson was the father of Jason.)
25
39
26extra-source-files:
40extra-source-files:
27− *.yaml
28 README.markdown
41 README.markdown
29 benchmarks/*.cabal
42 benchmarks/*.cabal
30 benchmarks/*.hs
43 benchmarks/*.hs
@@ -33,234 +46,147 @@ extra-source-files:
33 benchmarks/Makefile
46 benchmarks/Makefile
34 benchmarks/Typed/*.hs
47 benchmarks/Typed/*.hs
35 benchmarks/json-data/*.json
48 benchmarks/json-data/*.json
36− cbits/*.c
49+ include/overlapping-compat.h
37 changelog.md
50 changelog.md
38 examples/*.cabal
51 examples/*.cabal
39 examples/*.hs
52 examples/*.hs
40 examples/Twitter/*.hs
53 examples/Twitter/*.hs
41− ffi/Data/Aeson/Parser/*.hs
42 include/*.h
54 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
55
48flag developer
56flag developer
49 description: operate in developer mode
57 description: operate in developer mode
50 default: False
58 default: False
51 manual: True
59 manual: True
52
60
53−flag fast
61+flag old-locale
54− description: compile without optimizations
62+ description: If false then depend on time >= 1.5.
55− default: False
63+ .
56− manual: True
64+ 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
65 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
66
68library
67library
69 default-language: Haskell2010
68 default-language: Haskell2010
70− hs-source-dirs: . attoparsec-iso8601/
71
69
72 exposed-modules:
70 exposed-modules:
73 Data.Aeson
71 Data.Aeson
74− Data.Aeson.Encoding
72+ Data.Aeson.Encode
73+ Data.Aeson.Internal
74+ Data.Aeson.Internal.Time
75 Data.Aeson.Parser
75 Data.Aeson.Parser
76− Data.Aeson.Text
77 Data.Aeson.Types
76 Data.Aeson.Types
78 Data.Aeson.TH
77 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
78
90 other-modules:
79 other-modules:
91− Data.Aeson.Encoding.Builder
80+ Data.Aeson.Encode.Builder
81+ Data.Aeson.Encode.Functions
92− Data.Aeson.Internal.Functions
82+ Data.Aeson.Functions
93− Data.Aeson.Parser.Unescape
83+ Data.Aeson.Parser.Internal
94 Data.Aeson.Parser.Time
84 Data.Aeson.Parser.Time
95− Data.Aeson.Types.FromJSON
96− Data.Aeson.Types.Generic
97− Data.Aeson.Types.ToJSON
98 Data.Aeson.Types.Class
85 Data.Aeson.Types.Class
86+ Data.Aeson.Types.Generic
87+ Data.Aeson.Types.Instances
88+ Data.Aeson.Types.Instances.Tuple
99 Data.Aeson.Types.Internal
89 Data.Aeson.Types.Internal
100− Data.Attoparsec.Time
101− Data.Attoparsec.Time.Internal
102
90
103− -- GHC bundled libs
104 build-depends:
91 build-depends:
105− base >= 4.7.0.0 && < 5,
92+ attoparsec >= 0.13.0.1,
93+ base >= 4.5 && < 5,
106− bytestring >= 0.10.4.0 && < 0.11,
94+ bytestring >= 0.10.4.0,
107− containers >= 0.5.5.1 && < 0.7,
95+ containers,
108− deepseq >= 1.3.0.0 && < 1.5,
96+ deepseq,
97+ dlist >= 0.2,
109− ghc-prim >= 0.2 && < 0.6,
98+ ghc-prim >= 0.2,
99+ hashable >= 1.1.2.0,
100+ scientific >= 0.3.1 && < 0.4,
101+ tagged >=0.8.3 && <0.9,
110− template-haskell >= 2.9.0.0 && < 2.16,
102+ template-haskell >= 2.7,
111− text >= 1.2.3.0 && < 1.3,
103+ text >= 1.1.1.0,
112− time >= 1.4 && < 1.10
104+ unordered-containers >= 0.2.5.0,
113−
105+ vector >= 0.8
114− if impl(ghc >= 8.0)
115− build-depends: bytestring >= 0.10.8.1
116−
117− -- Compat
118− 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
106
126 if !impl(ghc >= 8.0)
107 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
108 -- `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:
109 build-depends:
129− semigroups >= 0.18.5 && < 0.20,
110+ semigroups >= 0.16.1 && < 0.19,
130− transformers >= 0.3.0.0 && < 0.6,
131− transformers-compat >= 0.6.2 && < 0.7,
111+ transformers,
132 fail == 4.9.*
112 fail == 4.9.*
133
113
134 if !impl(ghc >= 7.10)
114 if !impl(ghc >= 7.10)
135 -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8
115 -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8
136− build-depends: nats >= 1.1.1 && < 1.2,
116+ build-depends: nats >=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
117
143− -- not in LTS-12.10
118+ if flag(old-locale)
144− tagged >= 0.8.5 && < 0.9,
145− primitive >= 0.6.3.0 && < 0.8
146−
147− -- Other dependencies
148− build-depends:
119+ build-depends: time < 1.5, old-locale
149− attoparsec >= 0.13.2.2 && < 0.14,
120+ else
150− dlist >= 0.8.0.4 && < 0.9,
121+ build-depends: time >= 1.5
151− hashable >= 1.2.7.0 && < 1.4,
152− scientific >= 0.3.6.2 && < 0.4,
153− th-abstraction >= 0.2.8.0 && < 0.4,
154− uuid-types >= 1.0.3 && < 1.1,
155− vector >= 0.12.0.1 && < 0.13
156−
157− ghc-options: -Wall
158
122
159 if flag(developer)
123 if flag(developer)
160 ghc-options: -Werror
124 ghc-options: -Werror
161 ghc-prof-options: -auto-all
125 ghc-prof-options: -auto-all
162
126
163− if flag(fast)
164− ghc-options: -O0
165− else
166− ghc-options: -O2
127+ ghc-options: -O2 -Wall
167
128
168 include-dirs: include
129 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
130
178test-suite tests
131test-suite tests
179 default-language: Haskell2010
132 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: Tests.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
137 DataFamilies.Properties
190 DataFamilies.Instances
138 DataFamilies.Instances
191 DataFamilies.Encoders
139 DataFamilies.Encoders
192 DataFamilies.Types
140 DataFamilies.Types
193 Encoders
141 Encoders
194− ErrorMessages
195 Functions
142 Functions
196 Instances
143 Instances
197 Options
144 Options
198− PropUtils
199 Properties
145 Properties
200− PropertyGeneric
201− PropertyKeys
202− PropertyRoundTrip
203− PropertyRTFunctors
204− PropertyTH
205− SerializationFormatSpec
206 Types
146 Types
207 UnitTests
147 UnitTests
208 UnitTests.NullaryConstructors
148 UnitTests.NullaryConstructors
209
149
150+ ghc-options: -Wall -threaded -rtsopts
151+
210 build-depends:
152 build-depends:
153+ HUnit,
211− QuickCheck >= 2.10.0.1 && < 2.14,
154+ QuickCheck >= 2.7 && <2.8.3,
212 aeson,
155 aeson,
213− integer-logarithms >= 1 && <1.1,
214 attoparsec,
156 attoparsec,
215 base,
157 base,
216− base-compat,
217− base-orphans >= 0.5.3 && <0.9,
158+ base-orphans >= 0.5.3 && <0.6,
218− base16-bytestring,
159+ bytestring,
219 containers,
160 containers,
220− directory,
221− dlist,
222− Diff >= 0.4 && < 0.5,
223− filepath,
224− generic-deriving >= 1.10 && < 1.14,
161+ generic-deriving >= 1.10 && < 1.11,
225 ghc-prim >= 0.2,
162 ghc-prim >= 0.2,
226− hashable >= 1.2.4.0,
163+ hashable >= 1.1.2.0,
227− scientific,
228 tagged,
164 tagged,
229 template-haskell,
165 template-haskell,
230− tasty,
166+ test-framework,
231− tasty-golden,
167+ test-framework-hunit,
232− tasty-hunit,
168+ test-framework-quickcheck2,
233− tasty-quickcheck,
234 text,
169 text,
235 time,
170 time,
236− time-compat,
237 unordered-containers,
171 unordered-containers,
238− uuid-types,
239 vector,
172 vector,
240− quickcheck-instances >= 0.3.21 && <0.4
173+ quickcheck-instances >=0.3.12
241−
242− if flag(bytestring-builder)
243− build-depends: bytestring >= 0.9 && < 0.10.4,
244− bytestring-builder >= 0.10.4 && < 1
245− else
246− build-depends: bytestring >= 0.10.4
247
174
248 if !impl(ghc >= 8.0)
175 if !impl(ghc >= 8.0)
249− build-depends:
176+ build-depends: semigroups >= 0.16.1 && < 0.19
250− semigroups >= 0.18.2 && < 0.20,
251− transformers >= 0.2.2.0,
252− transformers-compat >= 0.3
253
177
254− if !impl(ghc >= 7.10)
178+ if flag(old-locale)
255− build-depends: nats >=1 && <1.2,
179+ build-depends: time < 1.5, old-locale
256− void >=0.7.2 && <0.8
180+ else
257−
258− if impl(ghc >= 7.8)
259− build-depends: hashable-time >= 0.2 && <0.3
181+ build-depends: time >= 1.5
260
182
261− if flag(fast)
183+ if !impl(ghc >= 7.10)
262− ghc-options: -fno-enable-rewrite-rules
184+ build-depends: nats >=1 && <1.2
263
185
264source-repository head
186source-repository head
265 type: git
187 type: git
266 location: git://github.com/bos/aeson.git
188 location: git://github.com/bos/aeson.git
189+
190+source-repository head
191+ type: mercurial
192+ 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.hs+17−28
@@ -1,24 +1,16 @@
1−{-# LANGUAGE FlexibleContexts #-}
1+{-# LANGUAGE OverloadedStrings, RankNTypes #-}
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
2
11import Control.DeepSeq
3import Control.DeepSeq
12import Criterion.Main
4import Criterion.Main
5+import Data.Aeson
6+import Data.Aeson.Types (fromJSONKeyCoerce)
13import Data.Hashable
7import Data.Hashable
14import Data.Proxy (Proxy (..))
8import Data.Proxy (Proxy (..))
15import Data.Tagged (Tagged (..))
9import Data.Tagged (Tagged (..))
16−import Data.Aeson
17−import Data.Aeson.Types (fromJSONKeyCoerce)
18import qualified Data.ByteString.Lazy as LBS
10import qualified Data.ByteString.Lazy as LBS
19−import qualified Data.HashMap.Strict as HM
20−import qualified Data.Map as M
21import qualified Data.Text as T
11import qualified Data.Text as T
12+import qualified Data.Map as M
13+import qualified Data.HashMap.Strict as HM
22
14
23value :: Int -> HM.HashMap T.Text T.Text
15value :: Int -> HM.HashMap T.Text T.Text
24value n = HM.fromList $ map f [1..n]
16value n = HM.fromList $ map f [1..n]
@@ -43,7 +35,6 @@ instance NFData T1 where
43 rnf (T1 t) = rnf t
35 rnf (T1 t) = rnf t
44instance Hashable T1 where
36instance Hashable T1 where
45 hashWithSalt salt (T1 t) = hashWithSalt salt t
37 hashWithSalt salt (T1 t) = hashWithSalt salt t
46−
47instance FromJSON T1 where
38instance FromJSON T1 where
48 parseJSON = withText "T1" $ pure . T1
39 parseJSON = withText "T1" $ pure . T1
49instance FromJSONKey T1 where
40instance FromJSONKey T1 where
@@ -60,7 +51,6 @@ instance NFData T2 where
60 rnf (T2 t) = rnf t
51 rnf (T2 t) = rnf t
61instance Hashable T2 where
52instance Hashable T2 where
62 hashWithSalt salt (T2 t) = hashWithSalt salt t
53 hashWithSalt salt (T2 t) = hashWithSalt salt t
63−
64instance FromJSON T2 where
54instance FromJSON T2 where
65 parseJSON = withText "T2" $ pure . T2
55 parseJSON = withText "T2" $ pure . T2
66instance FromJSONKey T2 where
56instance FromJSONKey T2 where
@@ -77,7 +67,6 @@ instance NFData T3 where
77 rnf (T3 t) = rnf t
67 rnf (T3 t) = rnf t
78instance Hashable T3 where
68instance Hashable T3 where
79 hashWithSalt salt (T3 t) = hashWithSalt salt t
69 hashWithSalt salt (T3 t) = hashWithSalt salt t
80−
81instance FromJSON T3 where
70instance FromJSON T3 where
82 parseJSON = withText "T3" $ pure . T3
71 parseJSON = withText "T3" $ pure . T3
83instance FromJSONKey T3 where
72instance FromJSONKey T3 where
@@ -94,28 +83,28 @@ value1000 = value 1000
94value10000 = value 10000
83value10000 = value 10000
95
84
96encodedValue10 :: LBS.ByteString
85encodedValue10 :: LBS.ByteString
97−encodedValue10 = encode value10
86+encodedValue10 = encode $ value10
98
87
99encodedValue100 :: LBS.ByteString
88encodedValue100 :: LBS.ByteString
100−encodedValue100 = encode value100
89+encodedValue100 = encode $ value100
101
90
102encodedValue1000 :: LBS.ByteString
91encodedValue1000 :: LBS.ByteString
103−encodedValue1000 = encode value1000
92+encodedValue1000 = encode $ value1000
104
93
105encodedValue10000 :: LBS.ByteString
94encodedValue10000 :: LBS.ByteString
106−encodedValue10000 = encode value10000
95+encodedValue10000 = encode $ value10000
107
96
108-------------------------------------------------------------------------------
97-------------------------------------------------------------------------------
109-- Helpers
98-- Helpers
110-------------------------------------------------------------------------------
99-------------------------------------------------------------------------------
111
100
112decodeHM
101decodeHM
113− :: (FromJSON (HM.HashMap k T.Text), Eq k, Hashable k)
102+ :: (FromJSONKey k, Eq k, Hashable k)
114 => Proxy k -> LBS.ByteString -> Maybe (HM.HashMap k T.Text)
103 => Proxy k -> LBS.ByteString -> Maybe (HM.HashMap k T.Text)
115decodeHM _ = decode
104decodeHM _ = decode
116
105
117decodeMap
106decodeMap
118− :: (FromJSON (M.Map k T.Text), Ord k)
107+ :: (FromJSONKey k, Ord k)
119 => Proxy k -> LBS.ByteString -> Maybe (M.Map k T.Text)
108 => Proxy k -> LBS.ByteString -> Maybe (M.Map k T.Text)
120decodeMap _ = decode
109decodeMap _ = decode
121
110
@@ -158,10 +147,10 @@ benchDecodeMap
158 -> LBS.ByteString
147 -> LBS.ByteString
159 -> Benchmark
148 -> Benchmark
160benchDecodeMap name val = bgroup name
149benchDecodeMap name val = bgroup name
161− [ bench "Text" $ nf (decodeMap proxyText) val
150+ [ bench "Text" $ nf (decodeMap proxyText) val
162− , bench "Identity" $ nf (decodeMap proxyT1) val
151+ , bench "Identity" $ nf (decodeMap proxyT1) val
163− , bench "Coerce" $ nf (decodeMap proxyT2) val
152+ , bench "Coerce" $ nf (decodeMap proxyT2) val
164− , bench "Parser" $ nf (decodeMap proxyT3) val
153+ , bench "Parser" $ nf (decodeMap proxyT3) val
165 ]
154 ]
166
155
167benchEncodeHM
156benchEncodeHM
@@ -169,7 +158,7 @@ benchEncodeHM
169 -> HM.HashMap T.Text T.Text
158 -> HM.HashMap T.Text T.Text
170 -> Benchmark
159 -> Benchmark
171benchEncodeHM name val = bgroup name
160benchEncodeHM name val = bgroup name
172− [ bench "Text" $ nf encode val
161+ [ bench "Text" $ nf encode val
173 ]
162 ]
174
163
175benchEncodeMap
164benchEncodeMap
@@ -177,7 +166,7 @@ benchEncodeMap
177 -> HM.HashMap T.Text T.Text
166 -> HM.HashMap T.Text T.Text
178 -> Benchmark
167 -> Benchmark
179benchEncodeMap name val = bgroup name
168benchEncodeMap name val = bgroup name
180− [ bench "Text" $ nf encode val'
169+ [ bench "Text" $ nf encode val'
181 ]
170 ]
182 where
171 where
183 val' :: M.Map T.Text T.Text
172 val' :: M.Map T.Text T.Text
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.hs+3−12
@@ -1,24 +1,17 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE ScopedTypeVariables #-}
1{-# LANGUAGE ScopedTypeVariables #-}
4
2
5module Main (main) where
3module Main (main) where
6
4
7−import Prelude.Compat
8−
9import Compare.BufferBuilder ()
5import Compare.BufferBuilder ()
6+import Compare.JsonBuilder ()
10import Criterion.Main
7import Criterion.Main
11import Data.BufferBuilder.Json
8import Data.BufferBuilder.Json
9+import Data.Json.Builder
12import Twitter
10import Twitter
13import Twitter.Manual ()
11import Twitter.Manual ()
14import Typed.Common
12import Typed.Common
15−import qualified Data.Aeson as Aeson
16import qualified Compare.JsonBench as JsonBench
13import qualified Compare.JsonBench as JsonBench
17−
14+import qualified Data.Aeson as Aeson
18−#ifdef MIN_VERSION_json_builder
19−import Data.Json.Builder
20−import Compare.JsonBuilder ()
21−#endif
22
15
23main :: IO ()
16main :: IO ()
24main =
17main =
@@ -27,9 +20,7 @@ main =
27 bgroup "twitter" [
20 bgroup "twitter" [
28 bench "aeson" $ nf Aeson.encode twtr
21 bench "aeson" $ nf Aeson.encode twtr
29 , bench "buffer-builder" $ nf encodeJson twtr
22 , bench "buffer-builder" $ nf encodeJson twtr
30−#ifdef MIN_VERSION_json_builder
31 , bench "json-builder" $ nf toJsonLBS twtr
23 , bench "json-builder" $ nf toJsonLBS twtr
32−#endif
33 ]
24 ]
34 , JsonBench.benchmarks
25 , JsonBench.benchmarks
35 ]
26 ]
benchmarks/Compare/BufferBuilder.hs+4−9
@@ -1,17 +1,12 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
3−{-# LANGUAGE RecordWildCards #-}
4−
5−{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
7
3
8module Compare.BufferBuilder () where
4module Compare.BufferBuilder () where
9
5
10−import Prelude.Compat hiding ((<>))
11−
12import Data.BufferBuilder.Json
6import Data.BufferBuilder.Json
13−import Data.Int (Int64)
14import Data.Monoid ((<>))
7import Data.Monoid ((<>))
8+import Data.Int (Int64)
9+import Prelude hiding (id)
15import Twitter
10import Twitter
16import qualified Data.BufferBuilder.Utf8 as UB
11import qualified Data.BufferBuilder.Utf8 as UB
17
12
@@ -42,7 +37,7 @@ instance ToJson Story where
42 <> "metadata" .= metadata
37 <> "metadata" .= metadata
43 <> "to_user_id" .= to_user_id
38 <> "to_user_id" .= to_user_id
44 <> "text" .= text
39 <> "text" .= text
45− <> "id" .= id_
40+ <> "id" .= id
46 <> "from_user_id" .= from_user_id
41 <> "from_user_id" .= from_user_id
47 <> "geo" .= geo
42 <> "geo" .= geo
48 <> "iso_language_code" .= iso_language_code
43 <> "iso_language_code" .= iso_language_code
benchmarks/Compare/JsonBench.hs+7−21
@@ -1,18 +1,12 @@
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:
1-- Adapted from a buffer-builder benchmark:
10--
2--
11-- https://github.com/chadaustin/buffer-builder/blob/master/test.json
3-- https://github.com/chadaustin/buffer-builder/blob/master/test.json
12
4
13−module Compare.JsonBench (benchmarks) where
5+{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards #-}
6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+{-# LANGUAGE MagicHash, ScopedTypeVariables #-}
14
8
15−import Prelude.Compat hiding ((<>))
9+module Compare.JsonBench (benchmarks) where
16
10
17import Control.DeepSeq (NFData(..))
11import Control.DeepSeq (NFData(..))
18import Criterion
12import Criterion
@@ -20,13 +14,9 @@ import Data.Aeson ((.:))
20import Data.Monoid ((<>))
14import Data.Monoid ((<>))
21import Data.Text (Text)
15import Data.Text (Text)
22import Typed.Common (load)
16import Typed.Common (load)
23−import qualified Control.Monad.Fail as Fail
24import qualified Data.Aeson as Aeson
17import qualified Data.Aeson as Aeson
25import qualified Data.BufferBuilder.Json as Json
18import qualified Data.BufferBuilder.Json as Json
26−
27−#ifdef MIN_VERSION_json_builder
28import qualified Data.Json.Builder as JB
19import qualified Data.Json.Builder as JB
29−#endif
30
20
31data EyeColor = Green | Blue | Brown
21data EyeColor = Green | Blue | Brown
32 deriving (Eq, Show)
22 deriving (Eq, Show)
@@ -69,10 +59,10 @@ instance NFData Gender where rnf !_ = ()
69instance NFData Fruit where rnf !_ = ()
59instance NFData Fruit where rnf !_ = ()
70
60
71instance NFData Friend where
61instance NFData Friend where
72− rnf Friend {..} = rnf fId `seq` rnf fName
62+ rnf Friend {..} = (rnf fId) `seq` (rnf fName) `seq` ()
73
63
74instance NFData User where
64instance 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
65+ rnf User {..} = (rnf uId) `seq` (rnf uIndex) `seq` (rnf uGuid) `seq` (rnf uIsActive) `seq` (rnf uBalance) `seq` (rnf uPicture) `seq` (rnf uAge) `seq` (rnf uEyeColor) `seq` (rnf uName) `seq` (rnf uGender) `seq` (rnf uCompany) `seq` (rnf uEmail) `seq` (rnf uPhone) `seq` (rnf uAddress) `seq` (rnf uAbout) `seq` (rnf uRegistered) `seq` (rnf uLatitude) `seq` (rnf uLongitude) `seq` (rnf uTags) `seq` (rnf uFriends) `seq` (rnf uGreeting) `seq` (rnf uFavouriteFruit) `seq` ()
76
66
77eyeColorTable :: [(Text, EyeColor)]
67eyeColorTable :: [(Text, EyeColor)]
78eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]
68eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]
@@ -83,7 +73,7 @@ genderTable = [("male", Male), ("female", Female)]
83fruitTable :: [(Text, Fruit)]
73fruitTable :: [(Text, Fruit)]
84fruitTable = [("apple", Apple), ("strawberry", Strawberry), ("banana", Banana)]
74fruitTable = [("apple", Apple), ("strawberry", Strawberry), ("banana", Banana)]
85
75
86−enumFromJson :: Fail.MonadFail m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum
76+enumFromJson :: Monad m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum
87enumFromJson enumName table extract v = do
77enumFromJson enumName table extract v = do
88 s <- extract v
78 s <- extract v
89 case lookup s table of
79 case lookup s table of
@@ -273,7 +263,6 @@ instance Json.ToJson User where
273 <> "greeting"# Json..=# uGreeting
263 <> "greeting"# Json..=# uGreeting
274 <> "favoriteFruit"# Json..=# uFavouriteFruit
264 <> "favoriteFruit"# Json..=# uFavouriteFruit
275
265
276−#ifdef MIN_VERSION_json_builder
277---- json-builder instances ----
266---- json-builder instances ----
278
267
279instance JB.Value EyeColor where
268instance JB.Value EyeColor where
@@ -325,7 +314,6 @@ instance JB.Value User where
325 <> t "friends" `JB.row` uFriends
314 <> t "friends" `JB.row` uFriends
326 <> t "greeting" `JB.row` uGreeting
315 <> t "greeting" `JB.row` uGreeting
327 <> t "favoriteFruit" `JB.row` uFavouriteFruit
316 <> t "favoriteFruit" `JB.row` uFavouriteFruit
328−#endif
329
317
330benchmarks :: Benchmark
318benchmarks :: Benchmark
331benchmarks = env (load "json-data/buffer-builder.json") $
319benchmarks = env (load "json-data/buffer-builder.json") $
@@ -333,7 +321,5 @@ benchmarks = env (load "json-data/buffer-builder.json") $
333 bgroup "json-bench" [
321 bgroup "json-bench" [
334 bench "aeson" $ nf Aeson.encode parsedUserList
322 bench "aeson" $ nf Aeson.encode parsedUserList
335 , bench "buffer-builder" $ nf Json.encodeJson parsedUserList
323 , bench "buffer-builder" $ nf Json.encodeJson parsedUserList
336−#ifdef MIN_VERSION_json_builder
337 , bench "json-builder" $ nf JB.toJsonLBS parsedUserList
324 , bench "json-builder" $ nf JB.toJsonLBS parsedUserList
338−#endif
339 ]
325 ]
benchmarks/Compare/JsonBuilder.hs+2−6
@@ -1,15 +1,11 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
3−
4−{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
6
3
7module Compare.JsonBuilder () where
4module Compare.JsonBuilder () where
8
5
9−import Prelude.Compat hiding ((<>))
10−
11import Data.Json.Builder
6import Data.Json.Builder
12import Data.Monoid ((<>))
7import Data.Monoid ((<>))
8+import Prelude hiding (id)
13import Twitter
9import Twitter
14
10
15instance JsObject Metadata where
11instance JsObject Metadata where
@@ -40,7 +36,7 @@ instance JsObject Story where
40 row "metadata" metadata <>
36 row "metadata" metadata <>
41 row "to_user_id" to_user_id <>
37 row "to_user_id" to_user_id <>
42 row "text" text <>
38 row "text" text <>
43− row "id" id_ <>
39+ row "id" id <>
44 row "from_user_id" from_user_id <>
40 row "from_user_id" from_user_id <>
45 row "geo" geo <>
41 row "geo" geo <>
46 row "iso_language_code" iso_language_code <>
42 row "iso_language_code" iso_language_code <>
benchmarks/CompareWithJSON.hs+22−39
@@ -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,15 @@ 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
36
50−decodeIP :: BL.ByteString -> A.Value
37+decodeA' :: BL.ByteString -> A.Value
38+decodeA' s = case A.decode' s of
39+ Just v -> v
51−decodeIP s = fromMaybe (error "fail to parse via Parser.decodeWith") $
40+ Nothing -> error "fail to parse via Aeson"
52− I.decodeWith I.jsonEOF A.fromJSON s
53
41
54encodeJ :: J.JSValue -> BL.ByteString
42encodeJ :: J.JSValue -> BL.ByteString
55encodeJ = toLazyByteString . fromString . J.encode
43encodeJ = toLazyByteString . fromString . J.encode
@@ -65,37 +53,32 @@ main = do
65 let enFile = "json-data/twitter100.json"
53 let enFile = "json-data/twitter100.json"
66 jpFile = "json-data/jp100.json"
54 jpFile = "json-data/jp100.json"
67 enA <- BL.readFile enFile
55 enA <- BL.readFile enFile
68− enS <- BS.readFile enFile
69 enJ <- readFile enFile
56 enJ <- readFile enFile
70 jpA <- BL.readFile jpFile
57 jpA <- BL.readFile jpFile
71− jpS <- BS.readFile jpFile
72 jpJ <- readFile jpFile
58 jpJ <- readFile jpFile
73 defaultMain [
59 defaultMain [
74 bgroup "decode" [
60 bgroup "decode" [
75 bgroup "en" [
61 bgroup "en" [
76− bench "aeson/lazy" $ nf decode enA
62+ bench "aeson/lazy" $ nf decodeA enA
77− , bench "aeson/strict" $ nf decode' enA
63+ , bench "aeson/strict" $ nf decodeA' enA
78− , bench "aeson/stricter" $ nf decodeS enS
79− , bench "aeson/parser" $ nf decodeIP enA
80− , bench "json" $ nf decodeJ enJ
64+ , bench "json" $ nf decodeJ enJ
81 ]
65 ]
82 , bgroup "jp" [
66 , bgroup "jp" [
83− bench "aeson" $ nf decode jpA
67+ bench "aeson" $ nf decodeA jpA
84− , bench "aeson/stricter" $ nf decodeS jpS
85− , bench "json" $ nf decodeJ jpJ
68+ , bench "json" $ nf decodeJ jpJ
86 ]
69 ]
87 ]
70 ]
88 , bgroup "encode" [
71 , bgroup "encode" [
89 bgroup "en" [
72 bgroup "en" [
90− bench "aeson-to-bytestring" $ nf A.encode (decode enA)
73+ bench "aeson-to-bytestring" $ nf A.encode (decodeA enA)
91− , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decode enA)
74+ , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decodeA enA)
92− , bench "aeson-to-text" $ nf encodeToText (decode enA)
75+ , bench "aeson-to-text" $ nf encodeToText (decodeA enA)
93 , bench "json" $ nf encodeJ (decodeJ enJ)
76 , bench "json" $ nf encodeJ (decodeJ enJ)
94 ]
77 ]
95 , bgroup "jp" [
78 , bgroup "jp" [
96− bench "aeson-to-bytestring" $ nf A.encode (decode jpA)
79+ bench "aeson-to-bytestring" $ nf A.encode (decodeA jpA)
97− , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decode jpA)
80+ , bench "aeson-via-text-to-bytestring" $ nf encodeViaText (decodeA jpA)
98− , bench "aeson-to-text" $ nf encodeToText (decode jpA)
81+ , bench "aeson-to-text" $ nf encodeToText (decodeA jpA)
99 , bench "json" $ nf encodeJ (decodeJ jpJ)
82 , bench "json" $ nf encodeJ (decodeJ jpJ)
100 ]
83 ]
101 ]
84 ]
benchmarks/Dates.hs+9−14
@@ -1,9 +1,4 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+import Control.Applicative ((<$>))
2−
3−module Main (main) where
4−
5−import Prelude.Compat
6−
7import Criterion.Main
2import Criterion.Main
8import Data.Aeson (decode, encode)
3import Data.Aeson (decode, encode)
9import Data.Time.Clock (UTCTime)
4import Data.Time.Clock (UTCTime)
@@ -23,22 +18,22 @@ main = do
23 defaultMain [
18 defaultMain [
24 bgroup "decode" [
19 bgroup "decode" [
25 bgroup "UTCTime" [
20 bgroup "UTCTime" [
26− env file1 $ \bs -> bench "whole" $ nf utcTime bs
21+ env file1 $ \ ~bs -> bench "whole" $ nf utcTime bs
27− , env file2 $ \bs -> bench "fractional" $ nf utcTime bs
22+ , env file2 $ \ ~bs -> bench "fractional" $ nf utcTime bs
28 ]
23 ]
29 , bgroup "ZonedTime" [
24 , bgroup "ZonedTime" [
30− env file1 $ \bs -> bench "whole" $ nf zTime bs
25+ env file1 $ \ ~bs -> bench "whole" $ nf zTime bs
31− , env file2 $ \bs -> bench "fractional" $ nf zTime bs
26+ , env file2 $ \ ~bs -> bench "fractional" $ nf zTime bs
32 ]
27 ]
33 ]
28 ]
34 , bgroup "encode" [
29 , bgroup "encode" [
35 bgroup "UTCTime" [
30 bgroup "UTCTime" [
36− env (utcTime <$> file1) $ \ts -> bench "whole" $ nf encode ts
31+ env (utcTime <$> file1) $ \ ~ts -> bench "whole" $ nf encode ts
37− , env (utcTime <$> file2) $ \ts -> bench "fractional" $ nf encode ts
32+ , env (utcTime <$> file2) $ \ ~ts -> bench "fractional" $ nf encode ts
38 ]
33 ]
39 , bgroup "ZonedTime" [
34 , bgroup "ZonedTime" [
40− env (zTime <$> file1) $ \ts -> bench "whole" $ nf encode ts
35+ env (zTime <$> file1) $ \ ~ts -> bench "whole" $ nf encode ts
41− , env (zTime <$> file2) $ \ts -> bench "fractional" $ nf encode ts
36+ , env (zTime <$> file2) $ \ ~ts -> bench "fractional" $ nf encode ts
42 ]
37 ]
43 ]
38 ]
44 ]
39 ]
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.hs+6−10
@@ -1,22 +1,18 @@
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
8−
4+import qualified Data.Aeson.Encode.Builder as AB
9−-- Encoding is a newtype wrapper around Builder
5+import qualified Data.ByteString.Builder as B
10−import Data.Aeson.Encoding (text, string, encodingToLazyByteString)
11import qualified Data.Text as T
6import qualified Data.Text as T
12
7
8+
13main :: IO ()
9main :: IO ()
14main = do
10main = do
15 let txt = "append (append b (primBounded w1 x1)) (primBounded w2 x2)"
11 let txt = "append (append b (primBounded w1 x1)) (primBounded w2 x2)"
16 defaultMain [
12 defaultMain [
17 bgroup "string" [
13 bgroup "string" [
18− bench "text" $ nf (encodingToLazyByteString . text) (T.pack txt)
14+ bench "text" $ nf (B.toLazyByteString . AB.text) (T.pack txt)
19− , bench "string direct" $ nf (encodingToLazyByteString . string) txt
15+ , bench "string direct" $ nf (B.toLazyByteString . AB.string) txt
20− , bench "string via text" $ nf (encodingToLazyByteString . text . T.pack) txt
16+ , bench "string via text" $ nf (B.toLazyByteString . AB.text . T.pack) txt
21 ]
17 ]
22 ]
18 ]
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+8−23
@@ -1,13 +1,11 @@
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
@@ -19,26 +17,13 @@ encodeViaValue = encode . toJSON
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+7−22
@@ -1,11 +1,9 @@
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
@@ -19,26 +17,13 @@ encodeViaValue = encode . toJSON
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+7−22
@@ -1,11 +1,9 @@
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
10import Twitter.TH
8import Twitter.TH
11import Typed.Common
9import Typed.Common
@@ -19,26 +17,13 @@ encodeViaValue = encode . toJSON
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+64−224
@@ -1,193 +1,97 @@
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
15+
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−
73− exposed-modules:
16+ exposed-modules:
74− Data.Aeson
17+ Data.Aeson
75− Data.Aeson.Encoding
18+ Data.Aeson.Encode
76− Data.Aeson.Encoding.Builder
19+ Data.Aeson.Encode.Builder
77− Data.Aeson.Encoding.Internal
20+ Data.Aeson.Encode.Functions
78− Data.Aeson.Internal
21+ Data.Aeson.Functions
79− Data.Aeson.Internal.Functions
22+ Data.Aeson.Internal
80− Data.Aeson.Internal.Time
23+ Data.Aeson.Internal.Time
81− Data.Aeson.Parser
24+ Data.Aeson.Parser
82− Data.Aeson.Parser.Internal
25+ Data.Aeson.Parser.Internal
83− Data.Aeson.Parser.Time
26+ Data.Aeson.Parser.Time
84− Data.Aeson.Parser.Unescape
85− Data.Aeson.Parser.UnescapeFFI
86− Data.Aeson.Parser.UnescapePure
87− Data.Aeson.TH
27+ Data.Aeson.TH
88− Data.Aeson.Text
89− Data.Aeson.Types
28+ Data.Aeson.Types
90− Data.Aeson.Types.Class
29+ Data.Aeson.Types.Class
91− Data.Aeson.Types.FromJSON
92− Data.Aeson.Types.Generic
30+ Data.Aeson.Types.Generic
93− Data.Aeson.Types.Internal
31+ Data.Aeson.Types.Instances
94− Data.Aeson.Types.ToJSON
32+ Data.Aeson.Types.Internal
95− Data.Attoparsec.Time
33+ Data.Aeson.Types.Instances.Tuple
96− Data.Attoparsec.Time.Internal
97
34
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:
116− Auto.T.D
117− Auto.T.BigRecord
118− Auto.T.BigProduct
119− Auto.T.BigSum
120− Auto.G.D
121− Auto.G.BigRecord
122− Auto.G.BigProduct
123− Auto.G.BigSum
124− Options
125 build-depends:
35 build-depends:
126− aeson-benchmarks,
36+ attoparsec >= 0.13.0.1,
127− base,
37+ base == 4.*,
128− criterion,
38+ bytestring >= 0.10.4.0,
39+ containers,
129 deepseq,
40 deepseq,
41+ dlist >= 0.2,
42+ fail == 4.9.*,
43+ ghc-prim >= 0.2,
44+ hashable >= 1.1.2.0,
45+ mtl,
46+ scientific >= 0.3.1 && < 0.4,
47+ syb,
48+ tagged >=0.8.3 && <0.9,
130− template-haskell
49+ template-haskell >= 2.4,
131−
50+ text >= 1.1.1.0,
132−executable aeson-benchmark-escape
51+ time,
133− default-language: Haskell2010
52+ transformers,
134− main-is: Escape.hs
53+ unordered-containers >= 0.2.3.0,
135− hs-source-dirs: ../examples .
54+ vector >= 0.7.1
136− ghc-options: -Wall -O2 -rtsopts
55+
137− if flag(local-aeson)
56+ if impl(ghc >=7.8)
57+ cpp-options: -DHAS_COERCIBLE
58+
59+ if !impl(ghc >= 8.0)
60+ -- `Data.Semigroup` is available in base only since GHC 8.0 / base 4.9
61+ build-depends: semigroups >= 0.16.1 && < 0.19
62+
63+ if flag(old-locale)
138− build-depends:
64+ build-depends: time < 1.5, old-locale
139− aeson-benchmarks,
140− base,
141− base-compat,
142− bytestring,
143− criterion >= 1.0,
144− deepseq,
145− ghc-prim,
146− text
147 else
65 else
148− -- Disabled because of inaccessible internals
66+ build-depends: time >= 1.5
149− buildable: False
67+
68+ include-dirs: ../include
69+
70+ ghc-options: -O2 -Wall
71+ cpp-options: -DGENERICS
150
72
151executable aeson-benchmark-compare
73executable aeson-benchmark-compare
152− default-language: Haskell2010
153 main-is: Compare.hs
74 main-is: Compare.hs
154 hs-source-dirs: ../examples .
75 hs-source-dirs: ../examples .
155 ghc-options: -Wall -O2 -rtsopts
76 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:
77 build-depends:
163 aeson-benchmarks,
78 aeson-benchmarks,
164 base,
79 base,
165− base-compat,
166 buffer-builder,
80 buffer-builder,
167 bytestring,
81 bytestring,
168 criterion >= 1.0,
82 criterion >= 1.0,
169 deepseq,
83 deepseq,
170 ghc-prim,
84 ghc-prim,
85+ json-builder,
171 text
86 text
172
87
173− if impl(ghc < 8.4)
174− other-modules:
175− Compare.JsonBuilder
176− build-depends:
177− json-builder
178− if impl(ghc < 8.0)
179− build-depends:
180− semigroups
181−
182executable aeson-benchmark-micro
88executable aeson-benchmark-micro
183− default-language: Haskell2010
184 main-is: Micro.hs
89 main-is: Micro.hs
185 hs-source-dirs: ../examples .
90 hs-source-dirs: ../examples .
186 ghc-options: -Wall -O2 -rtsopts
91 ghc-options: -Wall -O2 -rtsopts
187 build-depends:
92 build-depends:
188 aeson-benchmarks,
93 aeson-benchmarks,
189 base,
94 base,
190− base-compat,
191 bytestring,
95 bytestring,
192 criterion >= 1.0,
96 criterion >= 1.0,
193 deepseq,
97 deepseq,
@@ -195,46 +99,25 @@ executable aeson-benchmark-micro
195 text
99 text
196
100
197executable aeson-benchmark-typed
101executable aeson-benchmark-typed
198− default-language: Haskell2010
199 main-is: Typed.hs
102 main-is: Typed.hs
200 hs-source-dirs: ../examples .
103 hs-source-dirs: ../examples .
201 ghc-options: -Wall -O2 -rtsopts
104 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:
105 build-depends:
213 aeson-benchmarks,
106 aeson-benchmarks,
214 base,
107 base,
215− base-compat,
108+ bytestring,
216 criterion >= 1.0,
109 criterion >= 1.0,
217 deepseq,
110 deepseq,
218 ghc-prim,
111 ghc-prim,
219 text,
112 text,
220 time
113 time
221
114
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
115executable aeson-benchmark-compare-with-json
231− default-language: Haskell2010
232 main-is: CompareWithJSON.hs
116 main-is: CompareWithJSON.hs
233 ghc-options: -Wall -O2 -rtsopts
117 ghc-options: -Wall -O2 -rtsopts
234 build-depends:
118 build-depends:
235 aeson-benchmarks,
119 aeson-benchmarks,
236 base,
120 base,
237− base-compat,
238 blaze-builder,
121 blaze-builder,
239 bytestring,
122 bytestring,
240 criterion,
123 criterion,
@@ -243,65 +126,53 @@ executable aeson-benchmark-compare-with-json
243 text
126 text
244
127
245executable aeson-benchmark-aeson-encode
128executable aeson-benchmark-aeson-encode
246− default-language: Haskell2010
247 main-is: AesonEncode.hs
129 main-is: AesonEncode.hs
248 ghc-options: -Wall -O2 -rtsopts
130 ghc-options: -Wall -O2 -rtsopts
249 build-depends:
131 build-depends:
250 aeson-benchmarks,
132 aeson-benchmarks,
251 attoparsec,
133 attoparsec,
252 base,
134 base,
253− base-compat,
254 bytestring,
135 bytestring,
255 deepseq,
136 deepseq,
256 time
137 time
257
138
258executable aeson-benchmark-aeson-parse
139executable aeson-benchmark-aeson-parse
259− default-language: Haskell2010
260 main-is: AesonParse.hs
140 main-is: AesonParse.hs
261 ghc-options: -Wall -O2 -rtsopts
141 ghc-options: -Wall -O2 -rtsopts
262 build-depends:
142 build-depends:
263 aeson-benchmarks,
143 aeson-benchmarks,
264 attoparsec,
144 attoparsec,
265 base,
145 base,
266− base-compat,
267 bytestring,
146 bytestring,
268 time
147 time
269
148
270executable aeson-benchmark-json-parse
149executable aeson-benchmark-json-parse
271− default-language: Haskell2010
272 main-is: JsonParse.hs
150 main-is: JsonParse.hs
273 ghc-options: -Wall -O2 -rtsopts
151 ghc-options: -Wall -O2 -rtsopts
274 build-depends:
152 build-depends:
275 base,
153 base,
276− base-compat,
277 deepseq,
154 deepseq,
278 json,
155 json,
279 time
156 time
280
157
281executable aeson-benchmark-dates
158executable aeson-benchmark-dates
282− default-language: Haskell2010
283 main-is: Dates.hs
159 main-is: Dates.hs
284 ghc-options: -Wall -O2 -rtsopts
160 ghc-options: -Wall -O2 -rtsopts
285 build-depends:
161 build-depends:
286 base,
162 base,
287− base-compat,
288 bytestring,
163 bytestring,
289 criterion,
164 criterion,
290 deepseq,
165 deepseq,
291 aeson-benchmarks,
166 aeson-benchmarks,
292 text,
167 text,
293 time
168 time
294− if impl(ghc >= 8.2)
295− ghc-options: -Wno-simplifiable-class-constraints
296
169
297executable aeson-benchmark-map
170executable aeson-benchmark-map
298− default-language: Haskell2010
299 main-is: AesonMap.hs
171 main-is: AesonMap.hs
300 ghc-options: -Wall -O2 -rtsopts
172 ghc-options: -Wall -O2 -rtsopts
301 build-depends:
173 build-depends:
302 aeson-benchmarks,
174 aeson-benchmarks,
303 base,
175 base,
304− base-compat,
305 criterion >= 1.0,
176 criterion >= 1.0,
306 bytestring,
177 bytestring,
307 containers,
178 containers,
@@ -309,37 +180,6 @@ executable aeson-benchmark-map
309 hashable,
180 hashable,
310 tagged,
181 tagged,
311 text,
182 text,
183+ transformers,
184+ transformers-compat,
312 unordered-containers
185 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
cabal.projectdeleted−5
@@ -1,5 +0,0 @@
1−with-compiler: ghc
2−packages: .
3−packages: attoparsec-iso8601
4−-- packages: benchmarks
5−tests: true
cbits/unescape_string.cdeleted−149
@@ -1,149 +0,0 @@
1−// Copyright (c) 2008-2009 Bjoern Hoehrmann
2−// Copyright (c) 2015, Ondrej Palkovsky
3−// Copyright (c) 2016, Winterland
4−
5−#include <string.h>
6−#include <stdio.h>
7−#include <stdint.h>
8−
9−
10−#define UTF8_ACCEPT 0
11−#define UTF8_REJECT 12
12−
13−static const uint8_t utf8d[] = {
14− // The first part of the table maps bytes to character classes that
15− // to reduce the size of the transition table and create bitmasks.
16− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
17− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
18− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
19− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
20− 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,
21− 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
22− 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
23− 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,
24−
25− // The second part is a transition table that maps a combination
26− // of a state of the automaton and a character class to a state.
27− 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
28− 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
29− 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
30− 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
31− 12,36,12,12,12,12,12,12,12,12,12,12,
32−};
33−
34−static inline uint32_t decode(uint32_t* state, uint32_t* codep, uint32_t byte) {
35− uint32_t type = utf8d[byte];
36−
37− *codep = (*state != UTF8_ACCEPT) ?
38− (byte & 0x3fu) | (*codep << 6) :
39− (0xff >> type) & (byte);
40−
41− *state = utf8d[256 + *state + type];
42− return *state;
43−}
44−
45−static inline uint16_t decode_hex(uint32_t c)
46−{
47− if (c >= '0' && c <= '9') return c - '0';
48− else if (c >= 'a' && c <= 'f') return c - 'a' + 10;
49− else if (c >= 'A' && c <= 'F') return c - 'A' + 10;
50− return 0xFFFF; // Should not happen
51−}
52−
53−// Decode, return non-zero value on error
54−int _js_decode_string(uint16_t *const dest, size_t *destoff,
55− const uint8_t *s, const uint8_t *const srcend)
56−{
57− uint16_t *d = dest + *destoff;
58− uint32_t state = 0;
59− uint32_t codepoint;
60−
61− uint8_t surrogate = 0;
62− uint16_t temp_hex = 0;
63− uint16_t unidata;
64−
65− // Optimized version of dispatch when just an ASCII char is expected
66− #define DISPATCH_ASCII(label) {\
67− if (s >= srcend) {\
68− return -1;\
69− }\
70− codepoint = *s++;\
71− goto label;\
72− }
73−
74− standard:
75− // Test end of stream
76− while (s < srcend) {
77− if (decode(&state, &codepoint, *s++) != UTF8_ACCEPT) {
78− if (state == UTF8_REJECT) { return -1; }
79− continue;
80− }
81−
82− if (codepoint == '\\')
83− DISPATCH_ASCII(backslash)
84− else if (codepoint <= 0xffff)
85− *d++ = (uint16_t) codepoint;
86− else {
87− *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));
88− *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));
89− }
90− }
91− *destoff = d - dest;
92− // Exit point
93− return (state != UTF8_ACCEPT);
94− backslash:
95− switch (codepoint) {
96− case '"':
97− case '\\':
98− case '/':
99− *d++ = (uint16_t) codepoint;
100− goto standard;
101− break;
102− case 'b': *d++ = '\b';goto standard;
103− case 'f': *d++ = '\f';goto standard;
104− case 'n': *d++ = '\n';goto standard;
105− case 'r': *d++ = '\r';goto standard;
106− case 't': *d++ = '\t';goto standard;
107− case 'u': DISPATCH_ASCII(unicode1);;break;
108− default:
109− return -1;
110− }
111− unicode1:
112− temp_hex = decode_hex(codepoint);
113− if (temp_hex == 0xFFFF) { return -1; }
114− else unidata = temp_hex << 12;
115− DISPATCH_ASCII(unicode2);
116− unicode2:
117− temp_hex = decode_hex(codepoint);
118− if (temp_hex == 0xFFFF) { return -1; }
119− else unidata |= temp_hex << 8;
120− DISPATCH_ASCII(unicode3);
121− unicode3:
122− temp_hex = decode_hex(codepoint);
123− if (temp_hex == 0xFFFF) { return -1; }
124− else unidata |= temp_hex << 4;
125− DISPATCH_ASCII(unicode4);
126− unicode4:
127− temp_hex = decode_hex(codepoint);
128− if (temp_hex == 0xFFFF) { return -1; }
129− else unidata |= temp_hex;
130− *d++ = (uint16_t) unidata;
131−
132− if (surrogate) {
133− if (unidata < 0xDC00 || unidata > 0xDFFF) // is not low surrogate
134− return -1;
135− surrogate = 0;
136− } else if (unidata >= 0xD800 && unidata <= 0xDBFF ) { // is high surrogate
137− surrogate = 1;
138− DISPATCH_ASCII(surrogate1);
139− } else if (unidata >= 0xDC00 && unidata <= 0xDFFF) { // is low surrogate
140− return -1;
141− }
142− goto standard;
143− surrogate1:
144− if (codepoint != '\\') { return -1; }
145− DISPATCH_ASCII(surrogate2)
146− surrogate2:
147− if (codepoint != 'u') { return -1; }
148− DISPATCH_ASCII(unicode1)
149−}
changelog.md+8−315
@@ -1,335 +1,28 @@
1For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).
1For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).
2
2
3−### upcoming
3+# 0.12.0.0
4
4
5−* `FromJSON` instance of `Ratio a` now parses numbers in addtion to
5+* Added list specific members to `ToJSON` and `FromJSON` classes. In the same
6− standard `{numerator=..., denumerator=...}` encoding.
6+ way `Read` / `Show` handle lists specifically. This removes need for
7+ overlapping instances to handle `String`.
7
8
8−### 1.4.6.0
9+* Added higher rank classes: `ToJSON1`, `ToJSON2`, `FromJSON1`, and `FromJSON2`.
9
10
10−* Provide a clearer error message when a required tagKey for a constructor is missing, thanks to Guru Devanla.
11+* Modified instances for `Map` and `HashMap`. Introduced new `FromJSONKey` and
11− The error message now looks like this: `Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found`
12−
13−* Add `formatPath` and `formatRelativePath` functions to turn a `JSONPath` into a `String`, thanks to Robbie McMichael
14−
15−
16−### 1.4.5.0
17−
18−* Expose `(<?>)`, `JSONPath` and `JSONPathElement(..)` from `Data.Aeson.Types`. Previously only available through internal modules. Thanks to Luke Clifton.
19−
20−* Support for base-compat 0.11, thanks to Ryan Scott.
21−
22−* Travis build for GHC 8.8, thanks to Oleg Grenrus.
23−
24−### 1.4.4.0
25−
26−**New features**:
27−
28−* Adds a parameterized parser `jsonWith` that can be used to choose how to handle duplicate keys in objects, thanks to Xia Li-Yao.
29−
30−* Add generic implementations of `FromJSONKey` and `ToJSONKey`, thanks to Xia Li-Yao. Example:
31−
32−```haskell
33−data Foo = Bar
34− deriving Generic
35−
36−opts :: JSONKeyOptions
37−opts = defaultJSONKeyOptions { keyModifier = toLower }
38−
39−instance ToJSONKey Foo where
40− toJSONKey = genericToJSONKey opts
41−
42−instance FromJSONKey Foo where
43− fromJSONKey = genericFromJSONKey opts
44−```
45−
46−**Minor**:
47−* aeson now uses `time-compat` instead of `time-locale-compat`, thanks to Oleg Grenrus.
48−* Prepare for `MonadFail` breakages in GHC 8.8, thanks to Oleg Grenrus.
49−* Require `bytestring >= 0.10.8.1` for newer GHCs to avoid build failures, thanks to Oleg Grenrus.
50−* Support `primitive 0.7.*`, thanks to Adam Bergmark.
51−* Allow `semigroups 0.19.*` and `hashable 1.3.*`, thanks to Oleg Grenrus.
52−* Fix a typo in the error message when parsing `NonEmpty`, thanks to Colin Woodbury.
53−* Document surprising behavior when using `omitNothingFields` with type variables, thanks to Xia Li-Yao.
54−
55−**Internal changes**:
56−* Code cleanup by Oleg Grenrus
57−* Fix dependencies of the benchmarks on older GHC's, thanks to Xia Li-Yao.
58−
59−### 1.4.3.0
60−* Improve error messages for FromJSON in existing instances and GHC Generic implementation. Thanks to Xia Li-Yao & Igor Pashev.
61−* Tweak error-reporting combinators and their documentation. Thanks to Xia Li-Yao.
62− * `typeMismatch` is now about comparing JSON types (i.e., the expected and actual names of the Value constructor).
63− * `withObject` and other `with*` combinators now also mention the JSON types they expect
64− * New `unexpected` and `prependFailure` combinators.
65−* Add `Contravariant` `ToJSONKeyFunction` instance. Thanks to Oleg Grenrus.
66−* Add `KeyValue` instance for `Object`. Thanks to Robert Hensing.
67−* Improve performance when parsing certain large numbers, thanks to Oleg Grenrus.
68−* Add `Data.Aeson.QQ.Simple` - A limited version of aeson-qq. Thanks to Oleg Grenrus.
69−* Exposes internal helper functions like `<?>`, `JSONPath`, and `parseIndexedJSON` from `Data.Aeson` module. Thanks to Abid Uzair.
70−* Better error messages when there are syntax errors parsing objects and arrays. Thanks to Fintan Halpenny.
71−* Support building with `th-abstraction-0.3.0.0` or later. Thanks to Ryan Scott.
72−
73−### 1.4.2.0
74−
75−* Add `Data.Aeson.QQ.Simple` which is a simpler version of the `aeson-qq` package, it does not support interpolation, thanks to Oleg Grenrus.
76−* Add `Contravariant ToJSONKeyFunction` instance, thanks to Oleg Grenrus.
77−* Add `KeyValue Object` instance, thanks to Robert Hensing
78−* Improved performance when parsing large numbers, thanks to Oleg Grenrus.
79−
80−### 1.4.1.0
81−
82−* Optimizations of generics, thanks to Rémy Oudompheng, here are some numbers for GHC 8.4:
83− * Compilation time: G/BigProduct.hs is 25% faster, G/BigRecord.hs is 2x faster.
84− * Runtime performance: BigRecord/toJSON/generic and BigProduct/encode/generic are more than 2x faster.
85−* Added To/FromJSON instances for `Void` and Generics's `V1`, thanks to Will Yager
86−* Added To/FromJSON instances for `primitive`'s `Array`, `SmallArray`, `PrimArray` and `UnliftedArray`, thanks to Andrew Thad.
87−* Fixes handling of `UTCTime` wrt. leap seconds , thanks to Adam Schønemann
88−* Warning and documentation fixes thanks to tom-bop, Gabor Greif, Ian Jeffries, and Mateusz Curyło.
89−
90−## 1.4.0.0
91−
92−This release introduces bounds on the size of `Scientific` numbers when they are converted to other arbitrary precision types that do not represent them efficiently in memory.
93−
94−This means that trying to decode a number such as `1e1000000000` into an `Integer` will now fail instead of using a lot of memory. If you need to represent large numbers you can add a newtype (preferably over `Scientific`) and providing a parser using `withScientific`.
95−
96−The following instances are affected by this:
97−* `FromJSON Natural`
98−* `FromJSONKey Natural`
99−* `FromJSON Integer`
100−* `FromJSONKey Integer`
101−* `FromJSON NominalDiffTime`
102−
103−For the same reasons the following instances & functions have been removed:
104−* Remove `FromJSON Data.Attoparsec.Number` instance. Note that `Data.Attoparsec.Number` is deprecated.
105−* Remove deprecated `withNumber`, use `withScientific` instead.
106−
107−Finally, encoding integral values with large exponents now uses scientific notation, this saves space for large numbers.
108−
109−#### 1.3.1.1
110−
111−* Catch 0 denominators when parsing Ratio
112−
113−### 1.3.1.0
114−
115−* Fix bug in generically derived `FromJSON` instances that are using `unwrapUnaryRecords`, thanks to Xia Li-yao
116−* Allow base-compat 0.10.*, thanks to Oleg Grenrus
117−
118−## 1.3.0.0
119−
120−Breaking changes:
121−* `GKeyValue` has been renamed to `KeyValuePair`, thanks to Xia Li-yao
122−* Removed unused `FromJSON` constraint in `withEmbeddedJson`, thanks to Tristan Seligmann
123−
124−Other improvements:
125−* Optimizations of TH toEncoding, thanks to Xia Li-yao
126−* Optimizations of hex decoding when using the default/pure unescape implementation, thanks to Xia Li-yao
127−* Improved error message on `Day` parse failures, thanks to Gershom Bazerman
128−* Add `encodeFile` as well as `decodeFile*` variants, thanks to Markus Hauck
129−* Documentation fixes, thanks to Lennart Spitzner
130−* CPP cleanup, thanks to Ryan Scott
131−
132−### 1.2.4.0
133−
134−* Add `Ord` instance for `JSONPathElement`, thanks to Simon Hengel.
135−
136−
137−### 1.2.3.0
138−
139−* Added `withEmbeddedJSON` to help parse JSON embedded inside a JSON string, thanks to Jesse Kempf.
140−* Memory usage improvements to the default (pure) parser, thanks to Jonathan Paugh. Also thanks to Neil Mitchell & Oleg Grenrus for contributing a benchmark.
141−* `omitNothingFields` now works for the `Option` newtype, thanks to Xia Li-yao.
142−* Some documentation fixes, thanks to Jonathan Paug & Philippe Crama.
143−
144−### 1.2.2.0
145−
146−* Add `FromJSON` and `ToJSON` instances for
147− * `DiffTime`, thanks to Víctor López Juan.
148− * `CTime`, thanks to Daniel Díaz.
149−* Fix handling of fractions when parsing Natural, thanks to Yuriy Syrovetskiy.
150−* Change text in error messages for Integral types to make them follow the common pattern, thanks to Yuriy Syrovetskiy.
151−* Add missing `INCOHERENT` pragma for `RecordToPair`, thanks to Xia Li-yao.
152−* Everything related to `Options` is now exported from `Data.Aeson`, thanks to Xia Li-yao.
153−* Optimizations to not escape text in clear cases, thanks to Oleg Grenrus.
154−* Some documentation fixes, thanks to Phil de Joux & Xia Li-yao.
155−
156−### 1.2.1.0
157−
158−* Add `parserThrowError` and `parserCatchError` combinators, thanks to Oleg Grenrus.
159−
160−* Add `Generic` instance for `Value`, thanks to Xia Li-yao.
161−
162−* Fix a mistake in the 1.2.0.0 changelog, the `cffi` flag is disabled by default! Thanks to dbaynard.
163−
164−## 1.2.0.0
165−
166−* `tagSingleConstructors`, an option to encode single-constructor types as tagged sums was added to `Options`. It is disabled by default for backward compatibility.
167−
168−* The `cffi` flag is now turned off (`False`) by default, this means C FFI code is no longer used by default. You can flip the flag to get C implementation.
169−
170−* The `Options` constructor is no longer exposed to prevent new options from being breaking changes, use `defaultOptions` instead.
171−
172−* The contents of `GToJSON` and `GToEncoding` are no longer exposed.
173−
174−* Some INLINE pragmas were removed to avoid GHC running out of simplifier ticks.
175−
176−### 1.1.2.0
177−
178−* Fix an accidental change in the format of `deriveJSON`. Thanks to Xia Li-yao!
179−
180−* Documentation improvements regarding `ToJSON`, `FromJSON`, and `SumEncoding`. Thanks to Xia Li-yao and Lennart Spitzner!
181−
182−### 1.1.1.0
183−
184−* Added a pure implementation of the C FFI code, the C FFI code. If you wish to use the pure haskell version set the `cffi` flag to `False`. This should make aeson compile when C isn't available, such as for GHCJS. Thanks to James Parker & Marcin Tolysz!
185−
186−* Using the `fast` flag can no longer cause a test case to fail. As far as we know this didn't affect any users of the library itself. Thanks to Xia Li-yao!
187−
188−## 1.1.0.0
189−
190−* Added instances for `UUID`.
191−
192−* The operators for parsing fields now have named aliases:
193− - `.:` => `parseField`
194− - `.:?` => `parseFieldMaybe`
195− - `.:!` => `parseFieldMaybe'`
196− - These functions now also have variants with explicit parser functions: `explicitParseField`, `explicitParseFieldMaybe`, "explicitParseFieldMaybe'`
197−Thanks to Oleg Grenrus.
198−
199−* `ToJSONKey (Identity a)` and `FromJSONKey (Identity a)` no longer require the unnecessary `FromJSON a` constraint. Thanks to Oleg Grenrus.
200−
201−* Added `Data.Aeson.Encoding.pair'` which is a more general version of `Data.Aeson.Encoding.pair`. Thanks to Andrew Martin.
202−
203−* `Day`s BCE are properly encoded and `+` is now a valid prefix for `Day`s CE. Thanks to Matt Parsons.
204−
205−* Some commonly used ToJSON instances are now specialized in order to improve compile time. Thanks to Bartosz Nitka.
206−
207−
208−[JSONTestSuite](https://github.com/nst/JSONTestSuite) cleanups, all
209−motivated by tighter RFC 7159 compliance:
210−
211−* The parser now rejects numbers for which
212− [the integer portion contains a leading zero](https://github.com/bos/aeson/commit/3fb7c155f2255482b1b9566ec5c1eaf9895d630e).
213−* The parser now rejects numbers for which
214− [a decimal point is not followed by at least one digit](https://github.com/bos/aeson/commit/ecfca35a45286dbe2bbaf5f62354be393bc59b66),
215−* The parser now rejects documents that contain [whitespace outside the
216− set {space, newline, carriage return, tab}](https://github.com/bos/aeson/commit/8ef622c2ad8d4a109884e17c2792238a2a320e44).
217−
218−Over 90% of JSONTestSuite tests currently pass. The remainder can be
219−categorised as follows:
220−
221−* The string parser is strict with Unicode compliance where the RFC
222− leaves room for implementation-defined behaviour (tests prefixed
223− with "`i_string_`". (This is necessary because the `text` library
224− cannot accommodate invalid Unicode.)
225−
226−* The parser does not (and will not) support UTF-16, UTF-32, or byte
227− order marks (BOM).
228−* The parser accepts unescaped control characters, even though the RFC
229− states that control characters must be escaped. (This may change at
230− some point, but doesn't seem important.)
231−
232−#### 1.0.2.1
233−
234−* Fixes a regression where a bunch of valid characters caused an
235− "Invalid UTF8-Stream" error when decoding. Thanks to Vladimir
236− Shabanov who investigated and fixed this.
237−
238−### 1.0.2.0
239−
240−* Fixes a regression where it was no longer possible to derive
241− instances for types such as `data T a = T { f1 :: a, f2 :: Maybe a
242− }`.
243−
244−Thanks to Sean Leather for fixing this, and to Ryan Scott for helping out.
245−
246−### 1.0.1.0
247−
248−* Decoding performance has been significantly improved (see
249− https://github.com/bos/aeson/pull/452). Thanks to @winterland1989.
250−
251−* Add `ToJSON`/`FromJSON` instances for newtypes from
252− `Data.Semigroup`: `Min`, `Max`, `First`, `Last`, `WrappedMonoid`,
253− `Option`. Thanks to Lennart Spitzner.
254−
255−* Make the documentation for `.:!` more accurate. Thanks to Ian Jeffries.
256−
257−# 1.0.0.0
258−
259−Major enhancements:
260−
261−* Introduced new `FromJSONKey` and `ToJSONKey` type classes that are
12+ `ToJSONKey` type classes.
262− used to encode maps without going through HashMap. This also allows arbitrary
263− serialization of keys where a string-like key will encode into an object and
264− other keys will encode into an array of key-value tuples.
265−
266−* Added higher rank classes: `ToJSON1`, `ToJSON2`, `FromJSON1`, and
267− `FromJSON2`.
268−
269−* Added `Data.Aeson.Encoding` with functions to safely write `ToJSON`
270− instances using `toEncoding`.
271−
272−Other enhancements:
273−
274−* A Cabal `fast` flag was added to disable building with optimizations. This drastically speeds up compiling both aeson ***and*** libraries using aeson so it is recommended to enable it during development. With cabal-install you can `cabal install aeson -ffast` and with stack you can add a flag section to your stack.yaml:
275−```
276−flags:
277− aeson:
278− fast: true
279−```
280−
281−* Added list specific members to `ToJSON` and `FromJSON` classes. In
282− the same way `Read` and `Show` handle lists specifically. This
283− removes need for overlapping instances to handle `String`.
284−
285−* Added a new `sumEncoding` option `UntaggedValue` which prevents
286− objects from being tagged with the constructor name.
287−
288−* JSONPaths are now tracked in instances derived with template-haskell
289− and generics.
290−
291−* Get rid of redundancy of JSONPath error messages in nested records.
292−
293− `eitherDecode "{\"x\":{\"a\": [1,2,true]}}" :: Either String Y`
294− previously yielded
295− `Error in $.x.a[2]: failed to parse field" x: failed to parse field a: expected Int, encountered Boolean`
296− and now yields `Error in $.x.a[2]: expected Int, encountered Boolean"`.
297−
298− Some users might prefer to insert `modifyFailure` themselves to
299− customize error messages, which previously prevented the use of
300− `(.:)`.
301−
302−* Backwards compatibility with `bytestring-0.9` using the
303− `bytestring-builder` compatibility package.
304
13
305* Export `decodeWith`, `decodeStrictWith`, `eitherDecodeWith`, and
14* Export `decodeWith`, `decodeStrictWith`, `eitherDecodeWith`, and
306 `eitherDecodeStrictWith` from `Data.Aeson.Parser`. This allows
15 `eitherDecodeStrictWith` from `Data.Aeson.Parser`. This allows
307 decoding using explicit parsers instead of using `FromJSON`
16 decoding using explicit parsers instead of using `FromJSON`
308 instances.
17 instances.
309
18
310−* Un-orphan internal instances to render them in haddocks.
311−
312−Other changes:
313−
314−* Integral `FromJSON` instances now only accept integral
315− values. E.g. parsing `3.14` to `Int` fails instead of succeeding
316− with the value `3`.
317−
318−* Over/underflows are now caught for bounded numeric types.
319−
320* Remove the `contents` field encoding with `allNullaryToStringTag = False`,
19* Remove the `contents` field encoding with `allNullaryToStringTag = False`,
321 giving us `{ "tag" : "c1" }` instead of `{ "tag" : "c1", contents : [] }`.
20 giving us `{ "tag" : "c1" }` instead of `{ "tag" : "c1", contents : [] }`.
322− The contents field is optional when parsing so this is only a breaking
21+ The contents field is optional when parsing so this is only a breaking change for ToJSON.
323− change for ToJSON instances.
324
22
325* Fix a bug where `genericToEncoding` with `unwrapUnaryRecords = True`
23* Fix a bug where `genericToEncoding` with `unwrapUnaryRecords = True`
326 would produce an invalid encoding: `"unwrap\":""`.
24 would produce an invalid encoding: `"unwrap\":""`.
327
25
328−* `ToJSON` instances using `genericToEncoding` and `omitNothingFields`
329− no longer produce invalid JSON.
330−
331−* Added instances for `DList`, `Compose`, `Product`, `Sum`.
332−
333### 0.11.2.0
26### 0.11.2.0
334
27
335* Enable `PolyKinds` to generalize `Proxy`, `Tagged`, and `Const` instances.
28* Enable `PolyKinds` to generalize `Proxy`, `Tagged`, and `Const` instances.
examples/Generic.hs+5−7
@@ -6,19 +6,17 @@
6-- automatically derive the Generic class for us.
6-- automatically derive the Generic class for us.
7
7
8{-# LANGUAGE DeriveGeneric #-}
8{-# LANGUAGE DeriveGeneric #-}
9−{-# LANGUAGE NoImplicitPrelude #-}
10−{-# LANGUAGE OverloadedStrings #-}
11−
12−module Main (main) where
13
9
14−import Prelude.Compat
10+{-# LANGUAGE OverloadedStrings #-}
15
11
16import Data.Aeson (FromJSON, ToJSON, decode, encode)
12import Data.Aeson (FromJSON, ToJSON, decode, encode)
17import qualified Data.ByteString.Lazy.Char8 as BL
13import qualified Data.ByteString.Lazy.Char8 as BL
18−import GHC.Generics (Generic)
19
14
20-- To decode or encode a value using the generic machinery, we must
15-- To decode or encode a value using the generic machinery, we must
21-- make the type an instance of the Generic class.
16-- make the type an instance of the Generic class.
17+
18+import GHC.Generics (Generic)
19+
22data Coord = Coord { x :: Double, y :: Double }
20data Coord = Coord { x :: Double, y :: Double }
23 deriving (Show, Generic)
21 deriving (Show, Generic)
24
22
@@ -33,5 +31,5 @@ main :: IO ()
33main = do
31main = do
34 let req = decode "{\"x\":3.0,\"y\":-1.0}" :: Maybe Coord
32 let req = decode "{\"x\":3.0,\"y\":-1.0}" :: Maybe Coord
35 print req
33 print req
36− let reply = Coord { x = 123.4, y = 20 }
34+ let reply = Coord 123.4 20
37 BL.putStrLn (encode reply)
35 BL.putStrLn (encode reply)
examples/Simplest.hs+2−8
@@ -1,12 +1,6 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
3−{-# LANGUAGE RecordWildCards #-}
4
2
5−module Main (main) where
6−
7−import Prelude.Compat
8−
9−import Control.Applicative (empty)
3+import Control.Applicative ((<$>), (<*>), empty)
10import Data.Aeson
4import Data.Aeson
11import Data.Monoid
5import Data.Monoid
12import qualified Data.ByteString.Lazy.Char8 as BL
6import qualified Data.ByteString.Lazy.Char8 as BL
examples/TemplateHaskell.hs+3−6
@@ -1,13 +1,10 @@
1-- We can use Template Haskell (TH) to generate instances of the
1-- We can use Template Haskell (TH) to generate instances of the
2-- FromJSON and ToJSON classes automatically. This is the fastest way
2-- FromJSON and ToJSON classes automatically. This is the fastest way
3-- to add JSON support for a type.
3-- to add JSON support for a type.
4−{-# LANGUAGE NoImplicitPrelude #-}
5−{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE TemplateHaskell #-}
7
4
8−module Main (main) where
5+{-# LANGUAGE TemplateHaskell #-}
9
6
10−import Prelude.Compat
7+{-# LANGUAGE OverloadedStrings #-}
11
8
12import Data.Aeson (decode, encode)
9import Data.Aeson (decode, encode)
13import Data.Aeson.TH (deriveJSON, defaultOptions)
10import Data.Aeson.TH (deriveJSON, defaultOptions)
@@ -24,5 +21,5 @@ main :: IO ()
24main = do
21main = do
25 let req = decode "{\"x\":3.0,\"y\":-1.0}" :: Maybe Coord
22 let req = decode "{\"x\":3.0,\"y\":-1.0}" :: Maybe Coord
26 print req
23 print req
27− let reply = Coord { x = 123.4, y = 20 }
24+ let reply = Coord 123.4 20
28 BL.putStrLn (encode reply)
25 BL.putStrLn (encode reply)
examples/Twitter.hs+6−12
@@ -8,28 +8,22 @@
8-- renamed "type" to "type_" in the *.json files, to avoid overlap
8-- renamed "type" to "type_" in the *.json files, to avoid overlap
9-- with a Haskell reserved keyword.
9-- with a Haskell reserved keyword.
10
10
11−{-# LANGUAGE DeriveDataTypeable #-}
11+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
12−{-# LANGUAGE DeriveGeneric #-}
13−{-# LANGUAGE NoImplicitPrelude #-}
14
12
15−module Twitter
13+module Twitter (
16− (
17 Metadata(..)
14 Metadata(..)
18 , Geo(..)
15 , Geo(..)
19 , Story(..)
16 , Story(..)
20 , Result(..)
17 , Result(..)
21 ) where
18 ) where
22
19
23−import Prelude.Compat
24−
25−import Control.DeepSeq
26import Data.Data (Typeable, Data)
20import Data.Data (Typeable, Data)
27import Data.Int (Int64)
21import Data.Int (Int64)
28import Data.Text (Text)
22import Data.Text (Text)
23+-- import Data.Time (ZonedTime)
29import GHC.Generics (Generic)
24import GHC.Generics (Generic)
30−
25+import Prelude hiding (id)
31−{-# ANN module "Hlint: ignore Use camelCase" #-}
26+import Control.DeepSeq
32−{-# ANN module "Hlint: ignore Use newtype instead of data" #-}
33
27
34data Metadata = Metadata {
28data Metadata = Metadata {
35 result_type :: Text
29 result_type :: Text
@@ -53,7 +47,7 @@ data Story = Story {
53 , metadata :: Metadata
47 , metadata :: Metadata
54 , to_user_id :: Maybe Int64
48 , to_user_id :: Maybe Int64
55 , text :: Text
49 , text :: Text
56− , id_ :: Int64
50+ , id :: Int64
57 , from_user_id :: Int64
51 , from_user_id :: Int64
58 , geo :: Maybe Geo
52 , geo :: Maybe Geo
59 , iso_language_code :: Text
53 , iso_language_code :: Text
examples/Twitter/Generic.hs+9−27
@@ -1,7 +1,5 @@
1-- Use GHC generics to automatically generate good instances.
1-- Use GHC generics to automatically generate good instances.
2
2
3−{-# LANGUAGE NoImplicitPrelude #-}
4−
5{-# OPTIONS_GHC -fno-warn-orphans #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
6
4
7module Twitter.Generic
5module Twitter.Generic
@@ -12,33 +10,17 @@ module Twitter.Generic
12 , Result(..)
10 , Result(..)
13 ) where
11 ) where
14
12
15−import Prelude.Compat ()
13+import Data.Aeson (ToJSON, FromJSON)
16−
17import Twitter
14import Twitter
18−import Twitter.Options
19−
20−import Data.Aeson (ToJSON (..), FromJSON (..), genericToJSON, genericToEncoding, genericParseJSON)
21
15
22−instance ToJSON Metadata where
16+instance ToJSON Metadata
23− toJSON = genericToJSON twitterOptions
24− toEncoding = genericToEncoding twitterOptions
25−instance FromJSON Metadata where
17+instance FromJSON Metadata
26− parseJSON = genericParseJSON twitterOptions
27
18
28−instance ToJSON Geo where
19+instance ToJSON Geo
29− toJSON = genericToJSON twitterOptions
30− toEncoding = genericToEncoding twitterOptions
31−instance FromJSON Geo where
20+instance FromJSON Geo
32− parseJSON = genericParseJSON twitterOptions
33
21
34−instance ToJSON Story where
22+instance ToJSON Story
35− toJSON = genericToJSON twitterOptions
36− toEncoding = genericToEncoding twitterOptions
37−instance FromJSON Story where
23+instance FromJSON Story
38− parseJSON = genericParseJSON twitterOptions
39
24
40−instance ToJSON Result where
25+instance ToJSON Result
41− toJSON = genericToJSON twitterOptions
42− toEncoding = genericToEncoding twitterOptions
43−instance FromJSON Result where
26+instance FromJSON Result
44− parseJSON = genericParseJSON twitterOptions
examples/Twitter/Manual.hs+6−11
@@ -1,8 +1,6 @@
1-- Manually write instances.
1-- Manually write instances.
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE RecordWildCards #-}
5
2
3+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
7
5
8module Twitter.Manual
6module Twitter.Manual
@@ -13,16 +11,13 @@ module Twitter.Manual
13 , Result(..)
11 , Result(..)
14 ) where
12 ) where
15
13
16−import Prelude.Compat
17−
18import Control.Applicative
14import Control.Applicative
19−import Data.Semigroup ((<>))
20−import Twitter
21−
22import Data.Aeson hiding (Result)
15import Data.Aeson hiding (Result)
16+import Data.Monoid ((<>))
17+import Prelude hiding (id)
18+import Twitter
23
19
24instance ToJSON Metadata where
20instance ToJSON Metadata where
25−
26 toJSON Metadata{..} = object [
21 toJSON Metadata{..} = object [
27 "result_type" .= result_type
22 "result_type" .= result_type
28 ]
23 ]
@@ -60,7 +55,7 @@ instance ToJSON Story where
60 , "metadata" .= metadata
55 , "metadata" .= metadata
61 , "to_user_id" .= to_user_id
56 , "to_user_id" .= to_user_id
62 , "text" .= text
57 , "text" .= text
63− , "id" .= id_
58+ , "id" .= id
64 , "from_user_id" .= from_user_id
59 , "from_user_id" .= from_user_id
65 , "geo" .= geo
60 , "geo" .= geo
66 , "iso_language_code" .= iso_language_code
61 , "iso_language_code" .= iso_language_code
@@ -77,7 +72,7 @@ instance ToJSON Story where
77 <> "metadata" .= metadata
72 <> "metadata" .= metadata
78 <> "to_user_id" .= to_user_id
73 <> "to_user_id" .= to_user_id
79 <> "text" .= text
74 <> "text" .= text
80− <> "id" .= id_
75+ <> "id" .= id
81 <> "from_user_id" .= from_user_id
76 <> "from_user_id" .= from_user_id
82 <> "geo" .= geo
77 <> "geo" .= geo
83 <> "iso_language_code" .= iso_language_code
78 <> "iso_language_code" .= iso_language_code
examples/Twitter/Options.hsdeleted−10
@@ -1,10 +0,0 @@
1−module Twitter.Options (module Twitter.Options) where
2−
3−import Data.Aeson
4−
5−twitterOptions :: Options
6−twitterOptions = defaultOptions
7− { fieldLabelModifier = \x -> case x of
8− "id_" -> "id"
9− _ -> x
10− }
examples/Twitter/TH.hs+5−10
@@ -1,8 +1,6 @@
1-- Use Template Haskell to generate good instances.
1-- Use Template Haskell to generate good instances.
2
2
3−{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
5−
6{-# OPTIONS_GHC -fno-warn-orphans #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
7
5
8module Twitter.TH
6module Twitter.TH
@@ -13,13 +11,10 @@ module Twitter.TH
13 , Result(..)
11 , Result(..)
14 ) where
12 ) where
15
13
16−
17−import Twitter
18−import Twitter.Options
19−
20import Data.Aeson.TH
14import Data.Aeson.TH
15+import Twitter
21
16
22−$(deriveJSON twitterOptions ''Metadata)
17+$(deriveJSON defaultOptions ''Metadata)
23−$(deriveJSON twitterOptions ''Geo)
18+$(deriveJSON defaultOptions ''Geo)
24−$(deriveJSON twitterOptions ''Story)
19+$(deriveJSON defaultOptions ''Story)
25−$(deriveJSON twitterOptions ''Result)
20+$(deriveJSON defaultOptions ''Result)
examples/aeson-examples.cabal−3
@@ -9,7 +9,6 @@ executable aeson-example-generic
9 build-depends:
9 build-depends:
10 aeson >= 0.10,
10 aeson >= 0.10,
11 base,
11 base,
12− base-compat,
13 bytestring,
12 bytestring,
14 ghc-prim
13 ghc-prim
15
14
@@ -19,7 +18,6 @@ executable aeson-example-simplest
19 build-depends:
18 build-depends:
20 aeson,
19 aeson,
21 base,
20 base,
22− base-compat,
23 bytestring
21 bytestring
24
22
25executable aeson-example-th
23executable aeson-example-th
@@ -28,5 +26,4 @@ executable aeson-example-th
28 build-depends:
26 build-depends:
29 aeson,
27 aeson,
30 base,
28 base,
31− base-compat,
32 bytestring
29 bytestring
ffi/Data/Aeson/Parser/UnescapeFFI.hsdeleted−52
@@ -1,52 +0,0 @@
1−{-# LANGUAGE ForeignFunctionInterface #-}
2−{-# LANGUAGE MagicHash #-}
3−{-# LANGUAGE UnliftedFFITypes #-}
4−
5−module Data.Aeson.Parser.UnescapeFFI
6− (
7− unescapeText
8− ) where
9−
10−import Control.Exception (evaluate, throw, try)
11−import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
12−import Data.ByteString as B
13−import Data.ByteString.Internal as B
14−import Data.Text.Encoding.Error (UnicodeException (..))
15−import Data.Text.Internal (Text (..))
16−import Data.Text.Internal.Private (runText)
17−import Data.Text.Unsafe (unsafeDupablePerformIO)
18−import Data.Word (Word8)
19−import Foreign.C.Types (CInt (..), CSize (..))
20−import Foreign.ForeignPtr (withForeignPtr)
21−import Foreign.Marshal.Utils (with)
22−import Foreign.Ptr (Ptr, plusPtr)
23−import Foreign.Storable (peek)
24−import GHC.Base (MutableByteArray#)
25−import qualified Data.Text.Array as A
26−
27−foreign import ccall unsafe "_js_decode_string" c_js_decode
28− :: MutableByteArray# s -> Ptr CSize
29− -> Ptr Word8 -> Ptr Word8 -> IO CInt
30−
31−unescapeText' :: ByteString -> Text
32−unescapeText' (PS fp off len) = runText $ \done -> do
33− let go dest = withForeignPtr fp $ \ptr ->
34− with (0::CSize) $ \destOffPtr -> do
35− let end = ptr `plusPtr` (off + len)
36− loop curPtr = do
37− res <- c_js_decode (A.maBA dest) destOffPtr curPtr end
38− case res of
39− 0 -> do
40− n <- peek destOffPtr
41− unsafeSTToIO (done dest (fromIntegral n))
42− _ ->
43− throw (DecodeError desc Nothing)
44− loop (ptr `plusPtr` off)
45− (unsafeIOToST . go) =<< A.new len
46− where
47− desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
48−{-# INLINE unescapeText' #-}
49−
50−unescapeText :: ByteString -> Either UnicodeException Text
51−unescapeText = unsafeDupablePerformIO . try . evaluate . unescapeText'
52−{-# INLINE unescapeText #-}
include/incoherent-compat.hdeleted−7
@@ -1,7 +0,0 @@
1−#if __GLASGOW_HASKELL__ >= 710
2−#define INCOHERENT_ {-# INCOHERENT #-}
3−#else
4−-- This causes some type class instances to break:
5−-- {-# LANGUAGE IncoherentInstances #-}
6−#define INCOHERENT_
7−#endif
include/overlapping-compat.h+7
@@ -1,8 +1,15 @@
1#if __GLASGOW_HASKELL__ >= 710
1#if __GLASGOW_HASKELL__ >= 710
2#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
2#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3#define OVERLAPPING_ {-# OVERLAPPING #-}
3#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#ifdef NEEDS_INCOHERENT
5+#define INCOHERENT_ {-# INCOHERENT #-}
6+#endif
4#else
7#else
5{-# LANGUAGE OverlappingInstances #-}
8{-# LANGUAGE OverlappingInstances #-}
6#define OVERLAPPABLE_
9#define OVERLAPPABLE_
7#define OVERLAPPING_
10#define OVERLAPPING_
11+#ifdef NEEDS_INCOHERENT
12+{-# LANGUAGE IncoherentInstances #-}
13+#define INCOHERENT_
14+#endif
8#endif
15#endif
pure/Data/Aeson/Parser/UnescapePure.hsdeleted−254
@@ -1,254 +0,0 @@
1−-- WARNING: This file is security sensitive as it uses unsafeWrite which does
2−-- not check bounds. Any changes should be made with care and we would love to
3−-- get informed about them, just cc us in any PR targetting this file: @eskimor @jprider63
4−-- We would be happy to review the changes!
5−
6−-- The security check at the end (pos > length) only works if pos grows
7−-- monotonously, if this condition does not hold, the check is flawed.
8−module Data.Aeson.Parser.UnescapePure
9− (
10− unescapeText
11− ) where
12−
13−import Control.Exception (evaluate, throw, try)
14−import Control.Monad (when)
15−import Data.ByteString as B
16−import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.))
17−import Data.Text (Text)
18−import qualified Data.Text.Array as A
19−import Data.Text.Encoding.Error (UnicodeException (..))
20−import Data.Text.Internal.Private (runText)
21−import Data.Text.Unsafe (unsafeDupablePerformIO)
22−import Data.Word (Word8, Word16, Word32)
23−import GHC.ST (ST)
24−
25−-- Different UTF states.
26−data Utf =
27− UtfGround
28− | UtfTail1
29− | UtfU32e0
30− | UtfTail2
31− | UtfU32ed
32− | Utf843f0
33− | UtfTail3
34− | Utf843f4
35− deriving (Eq)
36−
37−data State =
38− StateNone
39− | StateUtf !Utf !Word32
40− | StateBackslash
41− | StateU0
42− | StateU1 !Word16
43− | StateU2 !Word16
44− | StateU3 !Word16
45− | StateS0
46− | StateS1
47− | StateSU0
48− | StateSU1 !Word16
49− | StateSU2 !Word16
50− | StateSU3 !Word16
51− deriving (Eq)
52−
53−-- References:
54−-- http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
55−-- https://github.com/jwilm/vte/blob/master/utf8parse/src/table.rs.in
56−
57−setByte1 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
58−setByte1 point word = point .|. fromIntegral (word .&. 0x3f)
59−{-# INLINE setByte1 #-}
60−
61−setByte2 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
62−setByte2 point word = point .|. (fromIntegral (word .&. 0x3f) `shiftL` 6)
63−{-# INLINE setByte2 #-}
64−
65−setByte2Top :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
66−setByte2Top point word = point .|. (fromIntegral (word .&. 0x1f) `shiftL` 6)
67−{-# INLINE setByte2Top #-}
68−
69−setByte3 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
70−setByte3 point word = point .|. (fromIntegral (word .&. 0x3f) `shiftL` 12)
71−{-# INLINE setByte3 #-}
72−
73−setByte3Top :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
74−setByte3Top point word = point .|. (fromIntegral (word .&. 0xf) `shiftL` 12)
75−{-# INLINE setByte3Top #-}
76−
77−setByte4 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
78−setByte4 point word = point .|. (fromIntegral (word .&. 0x7) `shiftL` 18)
79−{-# INLINE setByte4 #-}
80−
81−decode :: Utf -> Word32 -> Word8 -> (Utf, Word32)
82−decode UtfGround point word = case word of
83− w | 0x00 <= w && w <= 0x7f -> (UtfGround, fromIntegral word)
84− w | 0xc2 <= w && w <= 0xdf -> (UtfTail1, setByte2Top point word)
85− 0xe0 -> (UtfU32e0, setByte3Top point word)
86− w | 0xe1 <= w && w <= 0xec -> (UtfTail2, setByte3Top point word)
87− 0xed -> (UtfU32ed, setByte3Top point word)
88− w | 0xee <= w && w <= 0xef -> (UtfTail2, setByte3Top point word)
89− 0xf0 -> (Utf843f0, setByte4 point word)
90− w | 0xf1 <= w && w <= 0xf3 -> (UtfTail3, setByte4 point word)
91− 0xf4 -> (Utf843f4, setByte4 point word)
92− _ -> throwDecodeError
93−
94−decode UtfU32e0 point word = case word of
95− w | 0xa0 <= w && w <= 0xbf -> (UtfTail1, setByte2 point word)
96− _ -> throwDecodeError
97−
98−decode UtfU32ed point word = case word of
99− w | 0x80 <= w && w <= 0x9f -> (UtfTail1, setByte2 point word)
100− _ -> throwDecodeError
101−
102−decode Utf843f0 point word = case word of
103− w | 0x90 <= w && w <= 0xbf -> (UtfTail2, setByte3 point word)
104− _ -> throwDecodeError
105−
106−decode Utf843f4 point word = case word of
107− w | 0x80 <= w && w <= 0x8f -> (UtfTail2, setByte3 point word)
108− _ -> throwDecodeError
109−
110−decode UtfTail3 point word = case word of
111− w | 0x80 <= w && w <= 0xbf -> (UtfTail2, setByte3 point word)
112− _ -> throwDecodeError
113−
114−decode UtfTail2 point word = case word of
115− w | 0x80 <= w && w <= 0xbf -> (UtfTail1, setByte2 point word)
116− _ -> throwDecodeError
117−
118−decode UtfTail1 point word = case word of
119− w | 0x80 <= w && w <= 0xbf -> (UtfGround, setByte1 point word)
120− _ -> throwDecodeError
121−
122−decodeHex :: Word8 -> Word16
123−decodeHex x
124− | 48 <= x && x <= 57 = fromIntegral x - 48 -- 0-9
125− | 65 <= x && x <= 70 = fromIntegral x - 55 -- A-F
126− | 97 <= x && x <= 102 = fromIntegral x - 87 -- a-f
127− | otherwise = throwDecodeError
128−
129−unescapeText' :: ByteString -> Text
130−unescapeText' bs = runText $ \done -> do
131− dest <- A.new len
132−
133− (pos, finalState) <- loop dest (0, StateNone) 0
134−
135− -- Check final state. Currently pos gets only increased over time, so this check should catch overflows.
136− when ( finalState /= StateNone || pos > len)
137− throwDecodeError
138−
139− done dest pos -- TODO: pos, pos-1??? XXX
140−
141− where
142− len = B.length bs
143−
144− runUtf dest pos st point c = case decode st point c of
145− (UtfGround, 92) -> -- Backslash
146− return (pos, StateBackslash)
147− (UtfGround, w) | w <= 0xffff ->
148− writeAndReturn dest pos (fromIntegral w) StateNone
149− (UtfGround, w) -> do
150− write dest pos (0xd7c0 + fromIntegral (w `shiftR` 10))
151− writeAndReturn dest (pos + 1) (0xdc00 + fromIntegral (w .&. 0x3ff)) StateNone
152− (st', p) ->
153− return (pos, StateUtf st' p)
154−
155− loop :: A.MArray s -> (Int, State) -> Int -> ST s (Int, State)
156− loop _ ps i | i >= len = return ps
157− loop dest ps i = do
158− let c = B.index bs i -- JP: We can use unsafe index once we prove bounds with Liquid Haskell.
159− ps' <- f dest ps c
160− loop dest ps' $ i+1
161−
162− -- No pending state.
163− f dest (pos, StateNone) c = runUtf dest pos UtfGround 0 c
164−
165− -- In the middle of parsing a UTF string.
166− f dest (pos, StateUtf st point) c = runUtf dest pos st point c
167−
168− -- In the middle of escaping a backslash.
169− f dest (pos, StateBackslash) 34 = writeAndReturn dest pos 34 StateNone -- "
170− f dest (pos, StateBackslash) 92 = writeAndReturn dest pos 92 StateNone -- Backslash
171− f dest (pos, StateBackslash) 47 = writeAndReturn dest pos 47 StateNone -- /
172− f dest (pos, StateBackslash) 98 = writeAndReturn dest pos 8 StateNone -- b
173− f dest (pos, StateBackslash) 102 = writeAndReturn dest pos 12 StateNone -- f
174− f dest (pos, StateBackslash) 110 = writeAndReturn dest pos 10 StateNone -- n
175− f dest (pos, StateBackslash) 114 = writeAndReturn dest pos 13 StateNone -- r
176− f dest (pos, StateBackslash) 116 = writeAndReturn dest pos 9 StateNone -- t
177− f _ (pos, StateBackslash) 117 = return (pos, StateU0) -- u
178− f _ ( _, StateBackslash) _ = throwDecodeError
179−
180− -- Processing '\u'.
181− f _ (pos, StateU0) c =
182− let w = decodeHex c in
183− return (pos, StateU1 (w `shiftL` 12))
184−
185− f _ (pos, StateU1 w') c =
186− let w = decodeHex c in
187− return (pos, StateU2 (w' .|. (w `shiftL` 8)))
188−
189− f _ (pos, StateU2 w') c =
190− let w = decodeHex c in
191− return (pos, StateU3 (w' .|. (w `shiftL` 4)))
192−
193− f dest (pos, StateU3 w') c =
194− let w = decodeHex c in
195− let u = w' .|. w in
196−
197− -- Get next state based on surrogates.
198− let st
199− | u >= 0xd800 && u <= 0xdbff = -- High surrogate.
200− StateS0
201− | u >= 0xdc00 && u <= 0xdfff = -- Low surrogate.
202− throwDecodeError
203− | otherwise =
204− StateNone
205− in
206− writeAndReturn dest pos u st
207−
208− -- Handle surrogates.
209− f _ (pos, StateS0) 92 = return (pos, StateS1) -- Backslash
210− f _ ( _, StateS0) _ = throwDecodeError
211−
212− f _ (pos, StateS1) 117 = return (pos, StateSU0) -- u
213− f _ ( _, StateS1) _ = throwDecodeError
214−
215− f _ (pos, StateSU0) c =
216− let w = decodeHex c in
217− return (pos, StateSU1 (w `shiftL` 12))
218−
219− f _ (pos, StateSU1 w') c =
220− let w = decodeHex c in
221− return (pos, StateSU2 (w' .|. (w `shiftL` 8)))
222−
223− f _ (pos, StateSU2 w') c =
224− let w = decodeHex c in
225− return (pos, StateSU3 (w' .|. (w `shiftL` 4)))
226−
227− f dest (pos, StateSU3 w') c =
228− let w = decodeHex c in
229− let u = w' .|. w in
230−
231− -- Check if not low surrogate.
232− if u < 0xdc00 || u > 0xdfff then
233− throwDecodeError
234− else
235− writeAndReturn dest pos u StateNone
236−
237−write :: A.MArray s -> Int -> Word16 -> ST s ()
238−write dest pos char =
239− A.unsafeWrite dest pos char
240−{-# INLINE write #-}
241−
242−writeAndReturn :: A.MArray s -> Int -> Word16 -> t -> ST s (Int, t)
243−writeAndReturn dest pos char res = do
244− write dest pos char
245− return (pos + 1, res)
246−{-# INLINE writeAndReturn #-}
247−
248−throwDecodeError :: a
249−throwDecodeError =
250− let desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream" in
251− throw (DecodeError desc Nothing)
252−
253−unescapeText :: ByteString -> Either UnicodeException Text
254−unescapeText = unsafeDupablePerformIO . try . evaluate . unescapeText'
run-hlint.shdeleted−7
@@ -1,7 +0,0 @@
1−#!/bin/bash
2−
3−if hash hlint 2>/dev/null; then
4− hlint "$@"
5−else
6− ./hlint.sh "$@"
7−fi
stack-bench.yamldeleted−12
@@ -1,12 +0,0 @@
1−resolver: nightly-2019-09-21
2−# We use aeson in the snapshot to
3−# - avoid recompilation of criterion
4−# - compare against it
5−# - '.'
6−#
7−# Also we use separate working directory to avoid "unregistering aeson"
8−# caused recompilations
9−work-dir: .stack-work-bench
10−packages:
11−- benchmarks
12−extra-deps: []
stack-ffi-unescape.yamldeleted−9
@@ -1,9 +0,0 @@
1−resolver: nightly-2019-09-21
2−packages:
3−- '.'
4−flags:
5− aeson:
6− fast: true
7− cffi: true
8−extra-deps:
9−- Diff-0.4.0
stack-lts12.yamldeleted−15
@@ -1,15 +0,0 @@
1−resolver: lts-12.26
2−packages:
3−- '.'
4−- attoparsec-iso8601
5−flags:
6− aeson:
7− fast: true
8− cffi: true
9−extra-deps:
10−- base-orphans-0.8.1
11−- hashable-time-0.2.0.1
12−- QuickCheck-2.13.1
13−- quickcheck-instances-0.3.21
14−- splitmix-0.0.2
15−- time-compat-1.9.2.2
stack-nightly.yamldeleted−11
@@ -1,11 +0,0 @@
1−resolver: nightly-2019-10-14
2−packages:
3−- '.'
4−- attoparsec-iso8601
5−flags:
6− aeson:
7− fast: true
8− attoparsec-iso8601:
9− fast: true
10−extra-deps:
11−- generic-deriving-1.12.4
stack.yamlnew file+7
@@ -0,0 +1,7 @@
1+resolver: lts-5.16
2+packages:
3+- '.'
4+- benchmarks
5+extra-deps:
6+- generic-deriving-1.10.4.1
7+flags: {}
tests/DataFamilies/Encoders.hs+2−5
@@ -1,16 +1,13 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE GADTs #-}
2{-# LANGUAGE GADTs #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
5
4
6−module DataFamilies.Encoders (module DataFamilies.Encoders) where
5+module DataFamilies.Encoders where
7−
8−import Prelude.Compat
9
6
10import Data.Aeson.TH
7import Data.Aeson.TH
11import Data.Aeson.Types
8import Data.Aeson.Types
12−import DataFamilies.Types
13import Options
9import Options
10+import DataFamilies.Types
14
11
15--------------------------------------------------------------------------------
12--------------------------------------------------------------------------------
16-- Nullary encoders/decoders
13-- Nullary encoders/decoders
tests/DataFamilies/Instances.hs+3−6
@@ -1,19 +1,17 @@
1{-# LANGUAGE FlexibleInstances #-}
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE GADTs #-}
2{-# LANGUAGE GADTs #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE TypeFamilies #-}
6−
7{-# OPTIONS_GHC -fno-warn-orphans #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
8
6
9−module DataFamilies.Instances () where
7+module DataFamilies.Instances where
10−
11−import Prelude.Compat
12
8
9+import Control.Applicative
13import Data.Aeson.TH
10import Data.Aeson.TH
14import Data.Aeson.Types (FromJSON(..))
11import Data.Aeson.Types (FromJSON(..))
15import DataFamilies.Types
12import DataFamilies.Types
16import Test.QuickCheck (Arbitrary(..), elements, oneof)
13import Test.QuickCheck (Arbitrary(..), elements, oneof)
14+import Prelude
17
15
18instance (Arbitrary a) => Arbitrary (Approx a) where
16instance (Arbitrary a) => Arbitrary (Approx a) where
19 arbitrary = Approx <$> arbitrary
17 arbitrary = Approx <$> arbitrary
@@ -26,7 +24,6 @@ instance Arbitrary a => Arbitrary (SomeType c () a) where
26 , Unary <$> arbitrary
24 , Unary <$> arbitrary
27 , Product <$> arbitrary <*> arbitrary <*> arbitrary
25 , Product <$> arbitrary <*> arbitrary <*> arbitrary
28 , Record <$> arbitrary <*> arbitrary <*> arbitrary
26 , Record <$> arbitrary <*> arbitrary <*> arbitrary
29− , List <$> arbitrary
30 ]
27 ]
31
28
32instance Arbitrary (GADT String) where
29instance Arbitrary (GADT String) where
tests/DataFamilies/Properties.hs+4−7
@@ -1,21 +1,18 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−{-# LANGUAGE NoImplicitPrelude #-}
3
2
4module DataFamilies.Properties (tests) where
3module DataFamilies.Properties (tests) where
5
4
6−import Prelude.Compat
7−
8import DataFamilies.Encoders
5import DataFamilies.Encoders
9import DataFamilies.Instances ()
6import DataFamilies.Instances ()
10−import PropUtils
11
7
8+import Properties hiding (tests)
12
9
13−import Test.Tasty (TestTree, testGroup)
10+import Test.Framework (Test, testGroup)
14−import Test.Tasty.QuickCheck (testProperty)
11+import Test.Framework.Providers.QuickCheck2 (testProperty)
15
12
16--------------------------------------------------------------------------------
13--------------------------------------------------------------------------------
17
14
18−tests :: TestTree
15+tests :: Test
19tests = testGroup "data families" [
16tests = testGroup "data families" [
20 testGroup "template-haskell" [
17 testGroup "template-haskell" [
21 testGroup "toJSON" [
18 testGroup "toJSON" [
tests/DataFamilies/Types.hs+3−8
@@ -1,17 +1,14 @@
1-- DataKinds is needed for deriveAll0 calls on GHC 8
1-- DataKinds is needed for deriveAll0 calls on GHC 8
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GADTs #-}
4{-# LANGUAGE GADTs #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE NoImplicitPrelude #-}
8{-# LANGUAGE StandaloneDeriving #-}
6{-# LANGUAGE StandaloneDeriving #-}
7+{-# LANGUAGE DeriveGeneric #-}
9{-# LANGUAGE TemplateHaskell #-}
8{-# LANGUAGE TemplateHaskell #-}
10{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE TypeFamilies #-}
11
10
12−module DataFamilies.Types (module DataFamilies.Types) where
11+module DataFamilies.Types where
13−
14−import Prelude.Compat
15
12
16import Generics.Deriving.TH (deriveAll0)
13import Generics.Deriving.TH (deriveAll0)
17import Types (ApproxEq(..))
14import Types (ApproxEq(..))
@@ -27,9 +24,7 @@ data instance SomeType c () a = Nullary
27 | Record { testOne :: Double
24 | Record { testOne :: Double
28 , testTwo :: Maybe Bool
25 , testTwo :: Maybe Bool
29 , testThree :: Maybe a
26 , testThree :: Maybe a
30− }
31− | List [a]
32− deriving (Eq, Show)
27+ } deriving (Eq, Show)
33
28
34data family Approx a
29data family Approx a
35newtype instance Approx a = Approx { fromApprox :: a }
30newtype instance Approx a = Approx { fromApprox :: a }
tests/Encoders.hs+7−232
@@ -1,12 +1,7 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE GADTs #-}
1{-# LANGUAGE GADTs #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TemplateHaskell #-}
5
3
6−module Encoders (module Encoders) where
4+module Encoders where
7−
8−import Prelude.Compat
9−import Data.Text (Text)
10
5
11import Data.Aeson.TH
6import Data.Aeson.TH
12import Data.Aeson.Types
7import Data.Aeson.Types
@@ -97,49 +92,20 @@ gNullaryToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingle
97gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
92gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
98gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
93gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
99
94
100−keyOptions :: JSONKeyOptions
101−keyOptions = defaultJSONKeyOptions { keyModifier = ('k' :) }
102−
103−gNullaryToJSONKey :: Nullary -> Either String Text
104−gNullaryToJSONKey x = case genericToJSONKey keyOptions of
105− ToJSONKeyText p _ -> Right (p x)
106− _ -> Left "Should be a ToJSONKeyText"
107−
108−gNullaryFromJSONKey :: Text -> Parser Nullary
109−gNullaryFromJSONKey t = case genericFromJSONKey keyOptions of
110− FromJSONKeyTextParser p -> p t
111− _ -> fail "Not a TextParser"
112
95
113--------------------------------------------------------------------------------
96--------------------------------------------------------------------------------
114-- SomeType encoders/decoders
97-- SomeType encoders/decoders
115--------------------------------------------------------------------------------
98--------------------------------------------------------------------------------
116
99
117−-- Unary types
118−type LiftToJSON f a =
119− (a -> Value) -> ([a] -> Value) -> f a -> Value
120−type LiftToEncoding f a =
121− (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
122−type LiftParseJSON f a =
123− (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (f a)
124−
125thSomeTypeToJSON2ElemArray :: SomeType Int -> Value
100thSomeTypeToJSON2ElemArray :: SomeType Int -> Value
126thSomeTypeToJSON2ElemArray = $(mkToJSON opts2ElemArray ''SomeType)
101thSomeTypeToJSON2ElemArray = $(mkToJSON opts2ElemArray ''SomeType)
127
102
128thSomeTypeToEncoding2ElemArray :: SomeType Int -> Encoding
103thSomeTypeToEncoding2ElemArray :: SomeType Int -> Encoding
129thSomeTypeToEncoding2ElemArray = $(mkToEncoding opts2ElemArray ''SomeType)
104thSomeTypeToEncoding2ElemArray = $(mkToEncoding opts2ElemArray ''SomeType)
130
105
131−thSomeTypeLiftToJSON2ElemArray :: LiftToJSON SomeType a
132−thSomeTypeLiftToJSON2ElemArray = $(mkLiftToJSON opts2ElemArray ''SomeType)
133−
134−thSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a
135−thSomeTypeLiftToEncoding2ElemArray = $(mkLiftToEncoding opts2ElemArray ''SomeType)
136−
137thSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
106thSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
138thSomeTypeParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''SomeType)
107thSomeTypeParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''SomeType)
139
108
140−thSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a
141−thSomeTypeLiftParseJSON2ElemArray = $(mkLiftParseJSON opts2ElemArray ''SomeType)
142−
143
109
144thSomeTypeToJSONTaggedObject :: SomeType Int -> Value
110thSomeTypeToJSONTaggedObject :: SomeType Int -> Value
145thSomeTypeToJSONTaggedObject = $(mkToJSON optsTaggedObject ''SomeType)
111thSomeTypeToJSONTaggedObject = $(mkToJSON optsTaggedObject ''SomeType)
@@ -147,36 +113,21 @@ thSomeTypeToJSONTaggedObject = $(mkToJSON optsTaggedObject ''SomeType)
147thSomeTypeToEncodingTaggedObject :: SomeType Int -> Encoding
113thSomeTypeToEncodingTaggedObject :: SomeType Int -> Encoding
148thSomeTypeToEncodingTaggedObject = $(mkToEncoding optsTaggedObject ''SomeType)
114thSomeTypeToEncodingTaggedObject = $(mkToEncoding optsTaggedObject ''SomeType)
149
115
150−thSomeTypeLiftToJSONTaggedObject :: LiftToJSON SomeType a
151−thSomeTypeLiftToJSONTaggedObject = $(mkLiftToJSON optsTaggedObject ''SomeType)
152−
153−thSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a
154−thSomeTypeLiftToEncodingTaggedObject = $(mkLiftToEncoding optsTaggedObject ''SomeType)
155−
156thSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
116thSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
157thSomeTypeParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''SomeType)
117thSomeTypeParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''SomeType)
158
118
159−thSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a
160−thSomeTypeLiftParseJSONTaggedObject = $(mkLiftParseJSON optsTaggedObject ''SomeType)
161−
162
119
163thSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
120thSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
121+thSomeTypeToJSONObjectWithSingleField =
164−thSomeTypeToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''SomeType)
122+ $(mkToJSON optsObjectWithSingleField ''SomeType)
165
123
166thSomeTypeToEncodingObjectWithSingleField :: SomeType Int -> Encoding
124thSomeTypeToEncodingObjectWithSingleField :: SomeType Int -> Encoding
125+thSomeTypeToEncodingObjectWithSingleField =
167−thSomeTypeToEncodingObjectWithSingleField = $(mkToEncoding optsObjectWithSingleField ''SomeType)
126+ $(mkToEncoding optsObjectWithSingleField ''SomeType)
168−
169−thSomeTypeLiftToJSONObjectWithSingleField :: LiftToJSON SomeType a
170−thSomeTypeLiftToJSONObjectWithSingleField = $(mkLiftToJSON optsObjectWithSingleField ''SomeType)
171−
172−thSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a
173−thSomeTypeLiftToEncodingObjectWithSingleField = $(mkLiftToEncoding optsObjectWithSingleField ''SomeType)
174
127
175thSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
128thSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
129+thSomeTypeParseJSONObjectWithSingleField =
176−thSomeTypeParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''SomeType)
130+ $(mkParseJSON optsObjectWithSingleField ''SomeType)
177−
178−thSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a
179−thSomeTypeLiftParseJSONObjectWithSingleField = $(mkLiftParseJSON optsObjectWithSingleField ''SomeType)
180
131
181
132
182gSomeTypeToJSON2ElemArray :: SomeType Int -> Value
133gSomeTypeToJSON2ElemArray :: SomeType Int -> Value
@@ -188,15 +139,6 @@ gSomeTypeToEncoding2ElemArray = genericToEncoding opts2ElemArray
188gSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
139gSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
189gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray
140gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray
190
141
191−gSomeTypeLiftToEncoding2ElemArray :: LiftToEncoding SomeType a
192−gSomeTypeLiftToEncoding2ElemArray = genericLiftToEncoding opts2ElemArray
193−
194−gSomeTypeLiftToJSON2ElemArray :: LiftToJSON SomeType a
195−gSomeTypeLiftToJSON2ElemArray = genericLiftToJSON opts2ElemArray
196−
197−gSomeTypeLiftParseJSON2ElemArray :: LiftParseJSON SomeType a
198−gSomeTypeLiftParseJSON2ElemArray = genericLiftParseJSON opts2ElemArray
199−
200
142
201gSomeTypeToJSONTaggedObject :: SomeType Int -> Value
143gSomeTypeToJSONTaggedObject :: SomeType Int -> Value
202gSomeTypeToJSONTaggedObject = genericToJSON optsTaggedObject
144gSomeTypeToJSONTaggedObject = genericToJSON optsTaggedObject
@@ -207,15 +149,6 @@ gSomeTypeToEncodingTaggedObject = genericToEncoding optsTaggedObject
207gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
149gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
208gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject
150gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject
209
151
210−gSomeTypeLiftToEncodingTaggedObject :: LiftToEncoding SomeType a
211−gSomeTypeLiftToEncodingTaggedObject = genericLiftToEncoding optsTaggedObject
212−
213−gSomeTypeLiftToJSONTaggedObject :: LiftToJSON SomeType a
214−gSomeTypeLiftToJSONTaggedObject = genericLiftToJSON optsTaggedObject
215−
216−gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a
217−gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject
218−
219
152
220gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
153gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
221gSomeTypeToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField
154gSomeTypeToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField
@@ -226,15 +159,6 @@ gSomeTypeToEncodingObjectWithSingleField = genericToEncoding optsObjectWithSingl
226gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
159gSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
227gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
160gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
228
161
229−gSomeTypeLiftToEncodingObjectWithSingleField :: LiftToEncoding SomeType a
230−gSomeTypeLiftToEncodingObjectWithSingleField = genericLiftToEncoding optsObjectWithSingleField
231−
232−gSomeTypeLiftToJSONObjectWithSingleField :: LiftToJSON SomeType a
233−gSomeTypeLiftToJSONObjectWithSingleField = genericLiftToJSON optsObjectWithSingleField
234−
235−gSomeTypeLiftParseJSONObjectWithSingleField :: LiftParseJSON SomeType a
236−gSomeTypeLiftParseJSONObjectWithSingleField = genericLiftParseJSON optsObjectWithSingleField
237−
238
162
239gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value
163gSomeTypeToJSONOmitNothingFields :: SomeType Int -> Value
240gSomeTypeToJSONOmitNothingFields = genericToJSON optsOmitNothingFields
164gSomeTypeToJSONOmitNothingFields = genericToJSON optsOmitNothingFields
@@ -243,104 +167,6 @@ gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding
243gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
167gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
244
168
245
169
246−thSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)
247−thSomeTypeParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''SomeType)
248−
249−gSomeTypeParseJSONRejectUnknownFields :: Value -> Parser (SomeType Int)
250−gSomeTypeParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields
251−
252−
253−--------------------------------------------------------------------------------
254−-- Foo decoders
255−--------------------------------------------------------------------------------
256−
257−thFooParseJSONRejectUnknownFields :: Value -> Parser Foo
258−thFooParseJSONRejectUnknownFields = $(mkParseJSON optsRejectUnknownFields ''Foo)
259−
260−gFooParseJSONRejectUnknownFields :: Value -> Parser Foo
261−gFooParseJSONRejectUnknownFields = genericParseJSON optsRejectUnknownFields
262−
263−
264−thFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo
265−thFooParseJSONRejectUnknownFieldsTagged = $(mkParseJSON optsRejectUnknownFieldsTagged ''Foo)
266−
267−gFooParseJSONRejectUnknownFieldsTagged :: Value -> Parser Foo
268−gFooParseJSONRejectUnknownFieldsTagged = genericParseJSON optsRejectUnknownFieldsTagged
269−
270−
271−--------------------------------------------------------------------------------
272−-- Option fields
273−--------------------------------------------------------------------------------
274−
275−thOptionFieldToJSON :: OptionField -> Value
276−thOptionFieldToJSON = $(mkToJSON optsOptionField 'OptionField)
277−
278−thOptionFieldToEncoding :: OptionField -> Encoding
279−thOptionFieldToEncoding = $(mkToEncoding optsOptionField 'OptionField)
280−
281−thOptionFieldParseJSON :: Value -> Parser OptionField
282−thOptionFieldParseJSON = $(mkParseJSON optsOptionField 'OptionField)
283−
284−gOptionFieldToJSON :: OptionField -> Value
285−gOptionFieldToJSON = genericToJSON optsOptionField
286−
287−gOptionFieldToEncoding :: OptionField -> Encoding
288−gOptionFieldToEncoding = genericToEncoding optsOptionField
289−
290−gOptionFieldParseJSON :: Value -> Parser OptionField
291−gOptionFieldParseJSON = genericParseJSON optsOptionField
292−
293−thMaybeFieldToJSON :: MaybeField -> Value
294−thMaybeFieldToJSON = $(mkToJSON optsOptionField 'MaybeField)
295−
296−
297−--------------------------------------------------------------------------------
298−-- IncoherentInstancesNeeded
299−--------------------------------------------------------------------------------
300−
301−-- | This test demonstrates the need for IncoherentInstances. See the definition
302−-- of 'IncoherentInstancesNeeded' for a discussion of the issue.
303−--
304−-- NOTE 1: We only need to compile this test. We do not need to run it.
305−--
306−-- NOTE 2: We actually only use the INCOHERENT pragma on specific instances
307−-- instead of the IncoherentInstances language extension. Therefore, this is
308−-- only supported on GHC versions >= 7.10.
309−#if __GLASGOW_HASKELL__ >= 710
310−incoherentInstancesNeededParseJSONString :: FromJSON a => Value -> Parser (IncoherentInstancesNeeded a)
311−incoherentInstancesNeededParseJSONString = case () of
312− _ | True -> $(mkParseJSON defaultOptions ''IncoherentInstancesNeeded)
313− | False -> genericParseJSON defaultOptions
314−
315−incoherentInstancesNeededToJSON :: ToJSON a => IncoherentInstancesNeeded a -> Value
316−incoherentInstancesNeededToJSON = case () of
317− _ | True -> $(mkToJSON defaultOptions ''IncoherentInstancesNeeded)
318− | False -> genericToJSON defaultOptions
319−#endif
320−
321−-------------------------------------------------------------------------------
322−-- EitherTextInt encoders/decodes
323−-------------------------------------------------------------------------------
324−
325−thEitherTextIntToJSONUntaggedValue :: EitherTextInt -> Value
326−thEitherTextIntToJSONUntaggedValue = $(mkToJSON optsUntaggedValue ''EitherTextInt)
327−
328−thEitherTextIntToEncodingUntaggedValue :: EitherTextInt -> Encoding
329−thEitherTextIntToEncodingUntaggedValue = $(mkToEncoding optsUntaggedValue ''EitherTextInt)
330−
331−thEitherTextIntParseJSONUntaggedValue :: Value -> Parser EitherTextInt
332−thEitherTextIntParseJSONUntaggedValue = $(mkParseJSON optsUntaggedValue ''EitherTextInt)
333−
334−
335−gEitherTextIntToJSONUntaggedValue :: EitherTextInt -> Value
336−gEitherTextIntToJSONUntaggedValue = genericToJSON optsUntaggedValue
337−
338−gEitherTextIntToEncodingUntaggedValue :: EitherTextInt -> Encoding
339−gEitherTextIntToEncodingUntaggedValue = genericToEncoding optsUntaggedValue
340−
341−gEitherTextIntParseJSONUntaggedValue :: Value -> Parser EitherTextInt
342−gEitherTextIntParseJSONUntaggedValue = genericParseJSON optsUntaggedValue
343−
344--------------------------------------------------------------------------------
170--------------------------------------------------------------------------------
345-- Approx encoders/decoders
171-- Approx encoders/decoders
346--------------------------------------------------------------------------------
172--------------------------------------------------------------------------------
@@ -405,54 +231,3 @@ thGADTToEncodingDefault = $(mkToEncoding defaultOptions ''GADT)
405
231
406thGADTParseJSONDefault :: Value -> Parser (GADT String)
232thGADTParseJSONDefault :: Value -> Parser (GADT String)
407thGADTParseJSONDefault = $(mkParseJSON defaultOptions ''GADT)
233thGADTParseJSONDefault = $(mkParseJSON defaultOptions ''GADT)
408−
409−--------------------------------------------------------------------------------
410−-- OneConstructor encoders/decoders
411−--------------------------------------------------------------------------------
412−
413−thOneConstructorToJSONDefault :: OneConstructor -> Value
414−thOneConstructorToJSONDefault = $(mkToJSON defaultOptions ''OneConstructor)
415−
416−thOneConstructorToEncodingDefault :: OneConstructor -> Encoding
417−thOneConstructorToEncodingDefault = $(mkToEncoding defaultOptions ''OneConstructor)
418−
419−thOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
420−thOneConstructorParseJSONDefault = $(mkParseJSON defaultOptions ''OneConstructor)
421−
422−thOneConstructorToJSONTagged :: OneConstructor -> Value
423−thOneConstructorToJSONTagged = $(mkToJSON optsTagSingleConstructors ''OneConstructor)
424−
425−thOneConstructorToEncodingTagged :: OneConstructor -> Encoding
426−thOneConstructorToEncodingTagged = $(mkToEncoding optsTagSingleConstructors ''OneConstructor)
427−
428−thOneConstructorParseJSONTagged :: Value -> Parser OneConstructor
429−thOneConstructorParseJSONTagged = $(mkParseJSON optsTagSingleConstructors ''OneConstructor)
430−
431−
432−gOneConstructorToJSONDefault :: OneConstructor -> Value
433−gOneConstructorToJSONDefault = genericToJSON defaultOptions
434−
435−gOneConstructorToEncodingDefault :: OneConstructor -> Encoding
436−gOneConstructorToEncodingDefault = genericToEncoding defaultOptions
437−
438−gOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
439−gOneConstructorParseJSONDefault = genericParseJSON defaultOptions
440−
441−gOneConstructorToJSONTagged :: OneConstructor -> Value
442−gOneConstructorToJSONTagged = genericToJSON optsTagSingleConstructors
443−
444−gOneConstructorToEncodingTagged :: OneConstructor -> Encoding
445−gOneConstructorToEncodingTagged = genericToEncoding optsTagSingleConstructors
446−
447−gOneConstructorParseJSONTagged :: Value -> Parser OneConstructor
448−gOneConstructorParseJSONTagged = genericParseJSON optsTagSingleConstructors
449−
450−--------------------------------------------------------------------------------
451−-- Product2 encoders/decoders
452−--------------------------------------------------------------------------------
453−
454−thProduct2ParseJSON :: Value -> Parser (Product2 Int Bool)
455−thProduct2ParseJSON = $(mkParseJSON defaultOptions ''Product2)
456−
457−gProduct2ParseJSON :: Value -> Parser (Product2 Int Bool)
458−gProduct2ParseJSON = genericParseJSON defaultOptions
tests/ErrorMessages.hsdeleted−224
@@ -1,224 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−
5−module ErrorMessages
6− (
7− tests
8− ) where
9−
10−import Prelude.Compat
11−
12−import Data.Aeson (FromJSON(..), Value, json)
13−import Data.Aeson.Types (Parser)
14−import Data.Aeson.Parser (eitherDecodeWith)
15−import Data.Aeson.Internal (formatError, iparse)
16−import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff)
17−import Data.Proxy (Proxy(..))
18−import Data.Semigroup ((<>))
19−import Data.Sequence (Seq)
20−import Instances ()
21−import Numeric.Natural (Natural)
22−import Test.Tasty (TestTree, TestName)
23−import Test.Tasty.Golden.Advanced (goldenTest)
24−import qualified Data.ByteString.Lazy.Char8 as L
25−import qualified Data.HashMap.Strict as HM
26−
27−import Encoders
28−import Types
29−
30−tests :: [TestTree]
31−tests =
32− [ aesonGoldenTest "simple" "tests/golden/simple.expected" output
33− , aesonGoldenTest "generic" "tests/golden/generic.expected" (outputGeneric G)
34− ]
35−
36−output :: Output
37−output = concat
38− [ testFor "Int" (Proxy :: Proxy Int)
39− [ "\"\""
40− , "[]"
41− , "{}"
42− , "null"
43− ]
44−
45− , testFor "Integer" (Proxy :: Proxy Integer)
46− [ "44.44"
47− ]
48−
49− , testFor "Natural" (Proxy :: Proxy Natural)
50− [ "44.44"
51− , "-50"
52− ]
53−
54− , testFor "String" (Proxy :: Proxy String)
55− [ "1"
56− , "[]"
57− , "{}"
58− , "null"
59− ]
60−
61− , testFor "HashMap" (Proxy :: Proxy (HM.HashMap String Int))
62− [ "\"\""
63− , "[]"
64− ]
65−
66− -- issue #356
67− , testFor "Either" (Proxy :: Proxy (Int, Either (Int, Bool) ()))
68− [ "[1,{\"Left\":[2,3]}]"
69− ]
70−
71− -- issue #358
72− , testFor "Seq" (Proxy :: Proxy (Seq Int))
73− [ "[0,1,true]"
74− ]
75− ]
76−
77−data Choice = TH | G
78−
79−outputGeneric :: Choice -> Output
80−outputGeneric choice = concat
81− [ testWith "OneConstructor"
82− (select
83− thOneConstructorParseJSONDefault
84− gOneConstructorParseJSONDefault)
85− [ "\"X\""
86− , "[0]"
87− ]
88−
89− , testWith "Nullary"
90− (select
91− thNullaryParseJSONString
92− gNullaryParseJSONString)
93− [ "\"X\""
94− , "[]"
95− ]
96−
97− , testWithSomeType "SomeType (tagged)"
98− (select
99− thSomeTypeParseJSONTaggedObject
100− gSomeTypeParseJSONTaggedObject)
101− [ "{\"tag\": \"unary\", \"contents\": true}"
102− , "{\"tag\": \"unary\"}"
103− , "{\"tag\": \"record\"}"
104− , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"
105− , "{\"tag\": \"X\"}"
106− , "{}"
107− , "[]"
108− ]
109−
110− , testWithSomeType "SomeType (single-field)"
111− (select
112− thSomeTypeParseJSONObjectWithSingleField
113− gSomeTypeParseJSONObjectWithSingleField)
114− [ "{\"unary\": {}}"
115− , "{\"unary\": []}"
116− , "{\"X\": []}"
117− , "{\"record\": {}, \"W\":{}}"
118− , "{}"
119− , "[]"
120− , "{\"unary\""
121− , "{\"unary\":"
122− , "{\"unary\":1"
123− ]
124−
125− , testWithSomeType "SomeType (two-element array)"
126− (select
127− thSomeTypeParseJSON2ElemArray
128− gSomeTypeParseJSON2ElemArray)
129− [ "[\"unary\", true]"
130− , "[\"record\", null]"
131− , "[\"X\", 0]"
132− , "[null, 0]"
133− , "[]"
134− , "{}"
135− , "[1"
136− , "[1,"
137− ]
138−
139− , testWithSomeType "SomeType (reject unknown fields)"
140− (select
141− thSomeTypeParseJSONRejectUnknownFields
142− gSomeTypeParseJSONRejectUnknownFields)
143− [ "{\"tag\": \"record\", \"testOne\": 1.0, \"testZero\": 1}"
144− , "{\"testZero\": 1}"
145− , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"
146− ]
147−
148− , testWithFoo "Foo (reject unknown fields)"
149− (select
150− thFooParseJSONRejectUnknownFields
151− gFooParseJSONRejectUnknownFields)
152− [ "{\"tag\": \"foo\"}"
153− ]
154−
155− , testWithFoo "Foo (reject unknown fields, tagged single)"
156− (select
157− thFooParseJSONRejectUnknownFieldsTagged
158− gFooParseJSONRejectUnknownFieldsTagged)
159− [ "{\"tag\": \"foo\", \"unknownField\": 0}"
160− ]
161−
162− , testWith "EitherTextInt"
163− (select
164− thEitherTextIntParseJSONUntaggedValue
165− gEitherTextIntParseJSONUntaggedValue)
166− [ "\"X\""
167− , "[]"
168− ]
169−
170− , testWith "Product2 Int Bool"
171− (select
172− thProduct2ParseJSON
173− gProduct2ParseJSON)
174− [ "[1, null]"
175− , "[]"
176− , "{}"
177− ]
178− ]
179− where
180− select a b = case choice of
181− TH -> a
182− G -> b
183−
184−-- Test infrastructure
185−
186−type Output = [String]
187−
188−outputLine :: String -> Output
189−outputLine = pure
190−
191−aesonGoldenTest :: TestName -> FilePath -> Output -> TestTree
192−aesonGoldenTest name ref out = goldenTest name (L.readFile ref) act cmp upd
193− where
194− act = pure (L.pack (unlines out))
195− upd = L.writeFile ref
196− cmp x y | x == y = return Nothing
197− cmp x y = return $ Just $ unlines $
198− concatMap f (getGroupedDiff (L.lines x) (L.lines y))
199− where
200− f (First xs) = map (cons3 '-' . L.unpack) xs
201− f (Second ys) = map (cons3 '+' . L.unpack) ys
202− -- we print unchanged lines too. It shouldn't be a problem while we have
203− -- reasonably small examples
204− f (Both xs _) = map (cons3 ' ' . L.unpack) xs
205− -- we add three characters, so the changed lines are easier to spot
206− cons3 c cs = c : c : c : ' ' : cs
207−
208−testWith :: Show a => String -> (Value -> Parser a) -> [L.ByteString] -> Output
209−testWith name parser ts =
210− outputLine name <>
211− foldMap (\s ->
212− case eitherDecodeWith json (iparse parser) s of
213− Left err -> outputLine $ uncurry formatError err
214− Right a -> outputLine $ show a) ts
215−
216−testFor :: forall a proxy. (FromJSON a, Show a)
217− => String -> proxy a -> [L.ByteString] -> Output
218−testFor name _ = testWith name (parseJSON :: Value -> Parser a)
219−
220−testWithSomeType :: String -> (Value -> Parser (SomeType Int)) -> [L.ByteString] -> Output
221−testWithSomeType = testWith
222−
223−testWithFoo :: String -> (Value -> Parser Foo) -> [L.ByteString] -> Output
224−testWithFoo = testWith
tests/Functions.hs+1−9
@@ -1,12 +1,4 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−
3−module Functions
1+module Functions where
4− (
5− approxEq
6− , approxEqWith
7− ) where
8−
9−import Prelude.Compat
10
2
11approxEq :: (Fractional a, Ord a) => a -> a -> Bool
3approxEq :: (Fractional a, Ord a) => a -> a -> Bool
12approxEq = approxEqWith 1e-15 1e-15
4approxEq = approxEqWith 1e-15 1e-15
tests/Instances.hs+50−44
@@ -1,35 +1,39 @@
1−{-# LANGUAGE FlexibleContexts #-}
1+{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
6−
5+{-# LANGUAGE StandaloneDeriving #-}
7{-# OPTIONS_GHC -fno-warn-orphans #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
8
7
9−module Instances () where
8+module Instances where
10−
11−import Prelude.Compat
12
9
13−import Control.Applicative (empty)
10+import Types
14−import Control.Monad
15−import Data.Aeson.Types
16import Data.Function (on)
11import Data.Function (on)
17−import Data.Time (ZonedTime(..), TimeZone(..))
12+import Control.Monad
13+import Test.QuickCheck (Arbitrary(..), getNonNegative, elements,
14+ listOf1, oneof, resize)
18import Data.Time.Clock (UTCTime(..))
15import Data.Time.Clock (UTCTime(..))
16+import Data.Time (ZonedTime(..), TimeZone(..))
17+import Data.List.NonEmpty (NonEmpty(..))
18+import Data.Version
19+import Data.Aeson.Types
20+import Control.Applicative (Const(..))
21+import Data.Tagged (Tagged(..))
22+import Data.Proxy (Proxy(..))
23+import Control.Applicative
19import Functions
24import Functions
20−import Test.QuickCheck (Arbitrary(..), elements, oneof)
21−import Types
22−import qualified Data.DList as DList
23−import qualified Data.HashMap.Strict as HM
24
25
25import Data.Orphans ()
26import Data.Orphans ()
26import Test.QuickCheck.Instances ()
27import Test.QuickCheck.Instances ()
27−import Data.Hashable.Time ()
28+
29+#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)
30+import Numeric.Natural
31+#endif
28
32
29-- "System" types.
33-- "System" types.
30
34
31instance Arbitrary DotNetTime where
35instance Arbitrary DotNetTime where
32− arbitrary = DotNetTime `fmap` arbitrary
36+ arbitrary = DotNetTime `liftM` arbitrary
33 shrink = map DotNetTime . shrink . fromDotNetTime
37 shrink = map DotNetTime . shrink . fromDotNetTime
34
38
35-- | Compare timezone part only on 'timeZoneMinutes'
39-- | Compare timezone part only on 'timeZoneMinutes'
@@ -47,20 +51,8 @@ instance ApproxEq UTCTime where
47instance ApproxEq DotNetTime where
51instance ApproxEq DotNetTime where
48 (=~) = (=~) `on` fromDotNetTime
52 (=~) = (=~) `on` fromDotNetTime
49
53
50−instance ApproxEq Float where
51− a =~ b
52− | isNaN a && isNaN b = True
53− | otherwise = approxEq a b
54−
55instance ApproxEq Double where
54instance ApproxEq Double where
56− a =~ b
57− | isNaN a && isNaN b = True
58− | otherwise = approxEq a b
55+ (=~) = approxEq
59−
60−instance (ApproxEq k, Eq v) => ApproxEq (HM.HashMap k v) where
61− a =~ b = and $ zipWith eq (HM.toList a) (HM.toList b)
62− where
63− eq (x,y) (u,v) = x =~ u && y == v
64
56
65-- Test-related types.
57-- Test-related types.
66
58
@@ -139,29 +131,43 @@ instance Arbitrary a => Arbitrary (SomeType a) where
139 , Unary <$> arbitrary
131 , Unary <$> arbitrary
140 , Product <$> arbitrary <*> arbitrary <*> arbitrary
132 , Product <$> arbitrary <*> arbitrary <*> arbitrary
141 , Record <$> arbitrary <*> arbitrary <*> arbitrary
133 , Record <$> arbitrary <*> arbitrary <*> arbitrary
142− , List <$> arbitrary
143 ]
134 ]
144
135
145−instance Arbitrary EitherTextInt where
146− arbitrary = oneof
147− [ LeftBool <$> arbitrary
148− , RightInt <$> arbitrary
149− , BothTextInt <$> arbitrary <*> arbitrary
150− , pure NoneNullary
151− ]
152−
153instance Arbitrary (GADT String) where
136instance Arbitrary (GADT String) where
154 arbitrary = GADT <$> arbitrary
137 arbitrary = GADT <$> arbitrary
155
138
156−instance Arbitrary OptionField where
157− arbitrary = OptionField <$> arbitrary
158−
159−
160instance ApproxEq Char where
139instance ApproxEq Char where
161 (=~) = (==)
140 (=~) = (==)
162
141
163instance (ApproxEq a) => ApproxEq [a] where
142instance (ApproxEq a) => ApproxEq [a] where
164 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
143 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
165
144
166−instance Arbitrary a => Arbitrary (DList.DList a) where
145+instance Arbitrary Version where
167− arbitrary = DList.fromList <$> arbitrary
146+ arbitrary = makeVersion . fmap getNonNegative <$> resize 4 (listOf1 arbitrary)
147+
148+instance Arbitrary a => Arbitrary (NonEmpty a) where
149+ arbitrary = (:|) <$> arbitrary <*> arbitrary
150+
151+-- Version tags are deprecated, so we avoid using them in the Arbitrary
152+-- instance. However, the recommended constructor 'makeVersion' is not
153+-- exported by "Data.Version" until base-4.8.0.0. For previous versions,
154+-- a definition is given below.
155+
156+#if !MIN_VERSION_base(4,8,0)
157+makeVersion :: [Int] -> Version
158+makeVersion b = Version b []
159+#endif
160+
161+#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)
162+instance Arbitrary Natural where
163+ arbitrary = fromInteger . abs <$> arbitrary
164+#endif
165+
166+instance Arbitrary (Proxy a) where
167+ arbitrary = pure Proxy
168+
169+instance Arbitrary b => Arbitrary (Tagged a b) where
170+ arbitrary = Tagged <$> arbitrary
171+
172+instance Arbitrary a => Arbitrary (Const a b) where
173+ arbitrary = Const <$> arbitrary
tests/JSONTestSuite/LICENSEdeleted−21
@@ -1,21 +0,0 @@
1−MIT License
2−
3−Copyright (c) 2016 Nicolas Seriot
4−
5−Permission is hereby granted, free of charge, to any person obtaining a copy
6−of this software and associated documentation files (the "Software"), to deal
7−in the Software without restriction, including without limitation the rights
8−to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9−copies of the Software, and to permit persons to whom the Software is
10−furnished to do so, subject to the following conditions:
11−
12−The above copyright notice and this permission notice shall be included in all
13−copies or substantial portions of the Software.
14−
15−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17−FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18−AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19−LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20−OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21−SOFTWARE.
tests/JSONTestSuite/README.mddeleted−50
@@ -1,50 +0,0 @@
1−# JSON Parsing Test Suite
2−A comprehensive test suite for RFC 7159 compliant JSON parsers
3−
4−This repository was created as an appendix to the article [Parsing JSON is a Minefield 💣](http://seriot.ch/parsing_json.php).
5−
6−**/parsers/**
7−
8−This directory contains several parsers and tiny wrappers to turn the parsers into JSON validators, by returning a specific value.
9−
10−- `0` the parser did accept the content
11−- `1` the parser did reject the content
12−- `>=1` the process did crash
13−- `timeout` happens after 5 seconds
14−
15−**/test\_parsing/**
16−
17−The name of these files tell if their contents should be accepted or rejected.
18−
19−- `y_` content must be accepted by parsers
20−- `n_` content must be rejected by parsers
21−- `i_` parsers are free to accept or reject content
22−
23−**/test\_transform/**
24−
25−These files contain weird structures and characters that parsers may understand differently, eg:
26−
27−- huge numbers
28−- dictionaries with similar keys
29−- NULL characters
30−- escaped invalid strings
31−
32−These files were used to produce `results/transform.html`.
33−
34−**/run_tests.py**
35−
36−Run all parsers with all files:
37−
38− $ python3 run_tests.py
39−
40−Run all parsers with a specific file:
41−
42− $ python3 run_tests.py file.json
43−
44−The script writes logs in `results/logs.txt`.
45−
46−The script then reads `logs.txt` and generates `results/parsing.html`.
47−
48−**/results/**
49−
50−<img src="results/pruned_results.png" alt="JSON Parsing Tests" />
tests/JSONTestSuite/parsers/test-AppleJSONSerialization/bin/test-AppleJSONSerializationdeleted

Binary file not shown.

tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization.xcodeproj/project.pbxprojdeleted−260
@@ -1,260 +0,0 @@
1−// !$*UTF8*$!
2−{
3− archiveVersion = 1;
4− classes = {
5− };
6− objectVersion = 46;
7− objects = {
8−
9−/* Begin PBXBuildFile section */
10− 03997F941D70CE0C0001C89F /* main.swift in Sources */ = {isa = PBXBuildFile; fileRef = 03997F931D70CE0C0001C89F /* main.swift */; };
11−/* End PBXBuildFile section */
12−
13−/* Begin PBXCopyFilesBuildPhase section */
14− 03997F8E1D70CE0C0001C89F /* CopyFiles */ = {
15− isa = PBXCopyFilesBuildPhase;
16− buildActionMask = 2147483647;
17− dstPath = /usr/share/man/man1/;
18− dstSubfolderSpec = 0;
19− files = (
20− );
21− runOnlyForDeploymentPostprocessing = 1;
22− };
23−/* End PBXCopyFilesBuildPhase section */
24−
25−/* Begin PBXFileReference section */
26− 03997F901D70CE0C0001C89F /* test-AppleJSONSerialization */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = "test-AppleJSONSerialization"; sourceTree = BUILT_PRODUCTS_DIR; };
27− 03997F931D70CE0C0001C89F /* main.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = main.swift; sourceTree = "<group>"; };
28−/* End PBXFileReference section */
29−
30−/* Begin PBXFrameworksBuildPhase section */
31− 03997F8D1D70CE0C0001C89F /* Frameworks */ = {
32− isa = PBXFrameworksBuildPhase;
33− buildActionMask = 2147483647;
34− files = (
35− );
36− runOnlyForDeploymentPostprocessing = 0;
37− };
38−/* End PBXFrameworksBuildPhase section */
39−
40−/* Begin PBXGroup section */
41− 03997F871D70CE0C0001C89F = {
42− isa = PBXGroup;
43− children = (
44− 03997F921D70CE0C0001C89F /* test-AppleJSONSerialization */,
45− 03997F911D70CE0C0001C89F /* Products */,
46− );
47− sourceTree = "<group>";
48− };
49− 03997F911D70CE0C0001C89F /* Products */ = {
50− isa = PBXGroup;
51− children = (
52− 03997F901D70CE0C0001C89F /* test-AppleJSONSerialization */,
53− );
54− name = Products;
55− sourceTree = "<group>";
56− };
57− 03997F921D70CE0C0001C89F /* test-AppleJSONSerialization */ = {
58− isa = PBXGroup;
59− children = (
60− 03997F931D70CE0C0001C89F /* main.swift */,
61− );
62− path = "test-AppleJSONSerialization";
63− sourceTree = "<group>";
64− };
65−/* End PBXGroup section */
66−
67−/* Begin PBXNativeTarget section */
68− 03997F8F1D70CE0C0001C89F /* test-AppleJSONSerialization */ = {
69− isa = PBXNativeTarget;
70− buildConfigurationList = 03997F971D70CE0C0001C89F /* Build configuration list for PBXNativeTarget "test-AppleJSONSerialization" */;
71− buildPhases = (
72− 03997F8C1D70CE0C0001C89F /* Sources */,
73− 03997F8D1D70CE0C0001C89F /* Frameworks */,
74− 03997F8E1D70CE0C0001C89F /* CopyFiles */,
75− );
76− buildRules = (
77− );
78− dependencies = (
79− );
80− name = "test-AppleJSONSerialization";
81− productName = "test-AppleJSONSerialization";
82− productReference = 03997F901D70CE0C0001C89F /* test-AppleJSONSerialization */;
83− productType = "com.apple.product-type.tool";
84− };
85−/* End PBXNativeTarget section */
86−
87−/* Begin PBXProject section */
88− 03997F881D70CE0C0001C89F /* Project object */ = {
89− isa = PBXProject;
90− attributes = {
91− LastSwiftUpdateCheck = 0800;
92− LastUpgradeCheck = 0800;
93− ORGANIZATIONNAME = "Nicolas Seriot";
94− TargetAttributes = {
95− 03997F8F1D70CE0C0001C89F = {
96− CreatedOnToolsVersion = 8.0;
97− DevelopmentTeam = VBYRKYS73S;
98− ProvisioningStyle = Automatic;
99− };
100− };
101− };
102− buildConfigurationList = 03997F8B1D70CE0C0001C89F /* Build configuration list for PBXProject "test-AppleJSONSerialization" */;
103− compatibilityVersion = "Xcode 3.2";
104− developmentRegion = English;
105− hasScannedForEncodings = 0;
106− knownRegions = (
107− en,
108− );
109− mainGroup = 03997F871D70CE0C0001C89F;
110− productRefGroup = 03997F911D70CE0C0001C89F /* Products */;
111− projectDirPath = "";
112− projectRoot = "";
113− targets = (
114− 03997F8F1D70CE0C0001C89F /* test-AppleJSONSerialization */,
115− );
116− };
117−/* End PBXProject section */
118−
119−/* Begin PBXSourcesBuildPhase section */
120− 03997F8C1D70CE0C0001C89F /* Sources */ = {
121− isa = PBXSourcesBuildPhase;
122− buildActionMask = 2147483647;
123− files = (
124− 03997F941D70CE0C0001C89F /* main.swift in Sources */,
125− );
126− runOnlyForDeploymentPostprocessing = 0;
127− };
128−/* End PBXSourcesBuildPhase section */
129−
130−/* Begin XCBuildConfiguration section */
131− 03997F951D70CE0C0001C89F /* Debug */ = {
132− isa = XCBuildConfiguration;
133− buildSettings = {
134− ALWAYS_SEARCH_USER_PATHS = NO;
135− CLANG_ANALYZER_NONNULL = YES;
136− CLANG_CXX_LANGUAGE_STANDARD = "gnu++0x";
137− CLANG_CXX_LIBRARY = "libc++";
138− CLANG_ENABLE_MODULES = YES;
139− CLANG_ENABLE_OBJC_ARC = YES;
140− CLANG_WARN_BOOL_CONVERSION = YES;
141− CLANG_WARN_CONSTANT_CONVERSION = YES;
142− CLANG_WARN_DIRECT_OBJC_ISA_USAGE = YES_ERROR;
143− CLANG_WARN_DOCUMENTATION_COMMENTS = YES;
144− CLANG_WARN_EMPTY_BODY = YES;
145− CLANG_WARN_ENUM_CONVERSION = YES;
146− CLANG_WARN_INFINITE_RECURSION = YES;
147− CLANG_WARN_INT_CONVERSION = YES;
148− CLANG_WARN_OBJC_ROOT_CLASS = YES_ERROR;
149− CLANG_WARN_SUSPICIOUS_MOVES = YES;
150− CLANG_WARN_UNREACHABLE_CODE = YES;
151− CLANG_WARN__DUPLICATE_METHOD_MATCH = YES;
152− CODE_SIGN_IDENTITY = "-";
153− COPY_PHASE_STRIP = NO;
154− DEBUG_INFORMATION_FORMAT = dwarf;
155− ENABLE_STRICT_OBJC_MSGSEND = YES;
156− ENABLE_TESTABILITY = YES;
157− GCC_C_LANGUAGE_STANDARD = gnu99;
158− GCC_DYNAMIC_NO_PIC = NO;
159− GCC_NO_COMMON_BLOCKS = YES;
160− GCC_OPTIMIZATION_LEVEL = 0;
161− GCC_PREPROCESSOR_DEFINITIONS = (
162− "DEBUG=1",
163− "$(inherited)",
164− );
165− GCC_WARN_64_TO_32_BIT_CONVERSION = YES;
166− GCC_WARN_ABOUT_RETURN_TYPE = YES_ERROR;
167− GCC_WARN_UNDECLARED_SELECTOR = YES;
168− GCC_WARN_UNINITIALIZED_AUTOS = YES_AGGRESSIVE;
169− GCC_WARN_UNUSED_FUNCTION = YES;
170− GCC_WARN_UNUSED_VARIABLE = YES;
171− MACOSX_DEPLOYMENT_TARGET = 10.11;
172− MTL_ENABLE_DEBUG_INFO = YES;
173− ONLY_ACTIVE_ARCH = YES;
174− SDKROOT = macosx;
175− SWIFT_OPTIMIZATION_LEVEL = "-Onone";
176− };
177− name = Debug;
178− };
179− 03997F961D70CE0C0001C89F /* Release */ = {
180− isa = XCBuildConfiguration;
181− buildSettings = {
182− ALWAYS_SEARCH_USER_PATHS = NO;
183− CLANG_ANALYZER_NONNULL = YES;
184− CLANG_CXX_LANGUAGE_STANDARD = "gnu++0x";
185− CLANG_CXX_LIBRARY = "libc++";
186− CLANG_ENABLE_MODULES = YES;
187− CLANG_ENABLE_OBJC_ARC = YES;
188− CLANG_WARN_BOOL_CONVERSION = YES;
189− CLANG_WARN_CONSTANT_CONVERSION = YES;
190− CLANG_WARN_DIRECT_OBJC_ISA_USAGE = YES_ERROR;
191− CLANG_WARN_DOCUMENTATION_COMMENTS = YES;
192− CLANG_WARN_EMPTY_BODY = YES;
193− CLANG_WARN_ENUM_CONVERSION = YES;
194− CLANG_WARN_INFINITE_RECURSION = YES;
195− CLANG_WARN_INT_CONVERSION = YES;
196− CLANG_WARN_OBJC_ROOT_CLASS = YES_ERROR;
197− CLANG_WARN_SUSPICIOUS_MOVES = YES;
198− CLANG_WARN_UNREACHABLE_CODE = YES;
199− CLANG_WARN__DUPLICATE_METHOD_MATCH = YES;
200− CODE_SIGN_IDENTITY = "-";
201− COPY_PHASE_STRIP = NO;
202− DEBUG_INFORMATION_FORMAT = "dwarf-with-dsym";
203− ENABLE_NS_ASSERTIONS = NO;
204− ENABLE_STRICT_OBJC_MSGSEND = YES;
205− GCC_C_LANGUAGE_STANDARD = gnu99;
206− GCC_NO_COMMON_BLOCKS = YES;
207− GCC_WARN_64_TO_32_BIT_CONVERSION = YES;
208− GCC_WARN_ABOUT_RETURN_TYPE = YES_ERROR;
209− GCC_WARN_UNDECLARED_SELECTOR = YES;
210− GCC_WARN_UNINITIALIZED_AUTOS = YES_AGGRESSIVE;
211− GCC_WARN_UNUSED_FUNCTION = YES;
212− GCC_WARN_UNUSED_VARIABLE = YES;
213− MACOSX_DEPLOYMENT_TARGET = 10.11;
214− MTL_ENABLE_DEBUG_INFO = NO;
215− SDKROOT = macosx;
216− };
217− name = Release;
218− };
219− 03997F981D70CE0C0001C89F /* Debug */ = {
220− isa = XCBuildConfiguration;
221− buildSettings = {
222− DEVELOPMENT_TEAM = VBYRKYS73S;
223− PRODUCT_NAME = "$(TARGET_NAME)";
224− SWIFT_VERSION = 3.0;
225− };
226− name = Debug;
227− };
228− 03997F991D70CE0C0001C89F /* Release */ = {
229− isa = XCBuildConfiguration;
230− buildSettings = {
231− DEVELOPMENT_TEAM = VBYRKYS73S;
232− PRODUCT_NAME = "$(TARGET_NAME)";
233− SWIFT_VERSION = 3.0;
234− };
235− name = Release;
236− };
237−/* End XCBuildConfiguration section */
238−
239−/* Begin XCConfigurationList section */
240− 03997F8B1D70CE0C0001C89F /* Build configuration list for PBXProject "test-AppleJSONSerialization" */ = {
241− isa = XCConfigurationList;
242− buildConfigurations = (
243− 03997F951D70CE0C0001C89F /* Debug */,
244− 03997F961D70CE0C0001C89F /* Release */,
245− );
246− defaultConfigurationIsVisible = 0;
247− defaultConfigurationName = Release;
248− };
249− 03997F971D70CE0C0001C89F /* Build configuration list for PBXNativeTarget "test-AppleJSONSerialization" */ = {
250− isa = XCConfigurationList;
251− buildConfigurations = (
252− 03997F981D70CE0C0001C89F /* Debug */,
253− 03997F991D70CE0C0001C89F /* Release */,
254− );
255− defaultConfigurationIsVisible = 0;
256− };
257−/* End XCConfigurationList section */
258− };
259− rootObject = 03997F881D70CE0C0001C89F /* Project object */;
260−}
tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization.xcodeproj/project.xcworkspace/contents.xcworkspacedatadeleted−7
@@ -1,7 +0,0 @@
1−<?xml version="1.0" encoding="UTF-8"?>
2−<Workspace
3− version = "1.0">
4− <FileRef
5− location = "self:test-AppleJSONSerialization.xcodeproj">
6− </FileRef>
7−</Workspace>
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
@@ -1,91 +0,0 @@
1−<?xml version="1.0" encoding="UTF-8"?>
2−<Scheme
3− LastUpgradeVersion = "0800"
4− version = "1.3">
5− <BuildAction
6− parallelizeBuildables = "YES"
7− buildImplicitDependencies = "YES">
8− <BuildActionEntries>
9− <BuildActionEntry
10− buildForTesting = "YES"
11− buildForRunning = "YES"
12− buildForProfiling = "YES"
13− buildForArchiving = "YES"
14− buildForAnalyzing = "YES">
15− <BuildableReference
16− BuildableIdentifier = "primary"
17− BlueprintIdentifier = "03997F8F1D70CE0C0001C89F"
18− BuildableName = "test-AppleJSONSerialization"
19− BlueprintName = "test-AppleJSONSerialization"
20− ReferencedContainer = "container:test-AppleJSONSerialization.xcodeproj">
21− </BuildableReference>
22− </BuildActionEntry>
23− </BuildActionEntries>
24− </BuildAction>
25− <TestAction
26− buildConfiguration = "Debug"
27− selectedDebuggerIdentifier = "Xcode.DebuggerFoundation.Debugger.LLDB"
28− selectedLauncherIdentifier = "Xcode.DebuggerFoundation.Launcher.LLDB"
29− shouldUseLaunchSchemeArgsEnv = "YES">
30− <Testables>
31− </Testables>
32− <MacroExpansion>
33− <BuildableReference
34− BuildableIdentifier = "primary"
35− BlueprintIdentifier = "03997F8F1D70CE0C0001C89F"
36− BuildableName = "test-AppleJSONSerialization"
37− BlueprintName = "test-AppleJSONSerialization"
38− ReferencedContainer = "container:test-AppleJSONSerialization.xcodeproj">
39− </BuildableReference>
40− </MacroExpansion>
41− <AdditionalOptions>
42− </AdditionalOptions>
43− </TestAction>
44− <LaunchAction
45− buildConfiguration = "Debug"
46− selectedDebuggerIdentifier = "Xcode.DebuggerFoundation.Debugger.LLDB"
47− selectedLauncherIdentifier = "Xcode.DebuggerFoundation.Launcher.LLDB"
48− launchStyle = "0"
49− useCustomWorkingDirectory = "NO"
50− ignoresPersistentStateOnLaunch = "NO"
51− debugDocumentVersioning = "YES"
52− debugServiceExtension = "internal"
53− allowLocationSimulation = "YES">
54− <BuildableProductRunnable
55− runnableDebuggingMode = "0">
56− <BuildableReference
57− BuildableIdentifier = "primary"
58− BlueprintIdentifier = "03997F8F1D70CE0C0001C89F"
59− BuildableName = "test-AppleJSONSerialization"
60− BlueprintName = "test-AppleJSONSerialization"
61− ReferencedContainer = "container:test-AppleJSONSerialization.xcodeproj">
62− </BuildableReference>
63− </BuildableProductRunnable>
64− <AdditionalOptions>
65− </AdditionalOptions>
66− </LaunchAction>
67− <ProfileAction
68− buildConfiguration = "Release"
69− shouldUseLaunchSchemeArgsEnv = "YES"
70− savedToolIdentifier = ""
71− useCustomWorkingDirectory = "NO"
72− debugDocumentVersioning = "YES">
73− <BuildableProductRunnable
74− runnableDebuggingMode = "0">
75− <BuildableReference
76− BuildableIdentifier = "primary"
77− BlueprintIdentifier = "03997F8F1D70CE0C0001C89F"
78− BuildableName = "test-AppleJSONSerialization"
79− BlueprintName = "test-AppleJSONSerialization"
80− ReferencedContainer = "container:test-AppleJSONSerialization.xcodeproj">
81− </BuildableReference>
82− </BuildableProductRunnable>
83− </ProfileAction>
84− <AnalyzeAction
85− buildConfiguration = "Debug">
86− </AnalyzeAction>
87− <ArchiveAction
88− buildConfiguration = "Release"
89− revealArchiveInOrganizer = "YES">
90− </ArchiveAction>
91−</Scheme>
tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization.xcodeproj/xcuserdata/nst.xcuserdatad/xcschemes/xcschememanagement.plistdeleted−22
@@ -1,22 +0,0 @@
1−<?xml version="1.0" encoding="UTF-8"?>
2−<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3−<plist version="1.0">
4−<dict>
5− <key>SchemeUserState</key>
6− <dict>
7− <key>test-AppleJSONSerialization.xcscheme</key>
8− <dict>
9− <key>orderHint</key>
10− <integer>0</integer>
11− </dict>
12− </dict>
13− <key>SuppressBuildableAutocreation</key>
14− <dict>
15− <key>03997F8F1D70CE0C0001C89F</key>
16− <dict>
17− <key>primary</key>
18− <true/>
19− </dict>
20− </dict>
21−</dict>
22−</plist>
tests/JSONTestSuite/parsers/test-AppleJSONSerialization/test-AppleJSONSerialization/main.swiftdeleted−34
@@ -1,34 +0,0 @@
1−//
2−// main.swift
3−// test-AppleJSONSerialization
4−//
5−// Created by nst on 26/08/16.
6−// Copyright © 2016 Nicolas Seriot. All rights reserved.
7−//
8−
9−import Foundation
10−
11−func main() {
12−
13− guard ProcessInfo.processInfo.arguments.count == 2 else {
14− let url = NSURL(fileURLWithPath: ProcessInfo.processInfo.arguments[0])
15− guard let programName = url.lastPathComponent else { exit(1) }
16− print("Usage: ./\(programName) file.json")
17− exit(1)
18− }
19−
20− let path = ProcessInfo.processInfo.arguments[1]
21− let url = NSURL.fileURL(withPath:path)
22−
23− do {
24− let data = try Data(contentsOf:url)
25−
26− let _ = try JSONSerialization.jsonObject(with: data, options: [.allowFragments])
27−
28− exit(0)
29− } catch {
30− exit(1)
31− }
32−}
33−
34−main()
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−33

This diff is too big to show here.

tests/PropUtils.hsdeleted−208

This diff is too big to show here.

tests/Properties.hs+266−19

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

This diff is too big to show here.

tests/Types.hs+4−93

This diff is too big to show here.

tests/UnitTests.hs+98−503

This diff is too big to show here.

tests/UnitTests/NullaryConstructors.hs+3−14

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.sh−11

This diff is too big to show here.

travis/script.sh+1−8

This diff is too big to show here.

tuple-instances.hsnew file+126

This diff is too big to show here.