git.iko.soy/typeable/aeson
on master help sign in
fixed merge conflicts
commit652d301714b8c7b313eb955fa4fdc84a10e87232 authorAndrew Martin <amartin@layer3com.com> dateWed 15 Jun 2016, 09:32 (10 years ago) parentcdc4b81599aa8f
27 files changed+716−402
compare with master
unifiedsplit
Data/Aeson.hs+10−1 Data/Aeson/Encode.hs+12−94 Data/Aeson/Encode/Functions.hs−14 Data/Aeson/Encoding.hs+7 Data/Aeson/Encode/Builder.hs → Data/Aeson/Encoding/Builder.hs+5−2 Data/Aeson/Encoding/Internal.hs+95−70 Data/Aeson/Functions.hs → Data/Aeson/Internal/Functions.hs+4−8 Data/Aeson/Internal/Time.hs+3 Data/Aeson/Parser/Internal.hs+3−4 Data/Aeson/Parser/Time.hs+4−5 Data/Aeson/TH.hs+4−5 Data/Aeson/Text.hs+97 Data/Aeson/Types.hs+3 Data/Aeson/Types/Class.hs+1 Data/Aeson/Types/FromJSON.hs+81−24 Data/Aeson/Types/Generic.hs+3 Data/Aeson/Types/Internal.hs+4−7 Data/Aeson/Types/ToJSON.hs+186−118 aeson.cabal+15−8 benchmarks/CompareWithJSON.hs+1−1 benchmarks/Micro.hs+1−1 benchmarks/aeson-benchmarks.cabal+7−6 include/overlapping-compat.h−7 tests/Instances.hs+24−1 tests/Properties.hs+45−2 tests/Types.hs+6 tests/UnitTests.hs+95−24
Data/Aeson.hs+10−1
@@ -108,8 +108,11 @@ module Data.Aeson
108108 , json'
109109 ) where
110110
111+import Prelude ()
112+import Prelude.Compat (Maybe, either, Either(..), uncurry, String, (.))
113+
111114import Data.Aeson.Types.FromJSON (ifromJSON)
112−import Data.Aeson.Encode (encode)
115+import Data.Aeson.Encoding (encodingToLazyByteString)
113116import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith,
114117 eitherDecodeWith, eitherDecodeStrictWith,
115118 jsonEOF, json, jsonEOF', json')
@@ -118,6 +121,12 @@ import Data.Aeson.Types.Internal (JSONPath, formatError)
118121import qualified Data.ByteString as B
119122import qualified Data.ByteString.Lazy as L
120123
124+-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
125+--
126+-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.
127+encode :: (ToJSON a) => a -> L.ByteString
128+encode = encodingToLazyByteString . toEncoding
129+
121130-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
122131-- If this fails due to incomplete or invalid input, 'Nothing' is
123132-- returned.
Data/Aeson/Encode.hs+12−94
@@ -1,5 +1,3 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2−
31-- |
42-- Module: Data.Aeson.Encode
53-- Copyright: (c) 2012-2016 Bryan O'Sullivan
@@ -9,102 +7,22 @@
97-- Stability: experimental
108-- Portability: portable
119--
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
10+-- This module is left to supply limited backwards-compatibility.
11+module Data.Aeson.Encode {-# DEPRECATED "Use Data.Aeson or Data.Aeson.Text instead" #-}
2012 ( encode
21−
22− -- * Encoding to Builders
23− , encodeToBuilder
2413 , encodeToTextBuilder
25−
26− -- * Deprecated
27− , fromValue
2814 ) where
2915
30−import Data.Aeson.Encode.Builder (encodeToBuilder)
31−import Data.Aeson.Types (Value(..), ToJSON (..))
32−import Data.Aeson.Encoding (fromEncoding)
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−
38−import Numeric (showHex)
39−import qualified Data.ByteString.Builder as B
40−import qualified Data.HashMap.Strict as H
41−import qualified Data.Text as T
42−import qualified Data.Vector as V
43−import qualified Data.ByteString.Lazy as L
44−
45−-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
46−--
47−-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.
48−encode :: ToJSON a => a -> L.ByteString
49−encode = B.toLazyByteString . fromEncoding . toEncoding
50−{-# INLINE encode #-}
51−
52−-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
53−-- embedded efficiently in a text-based protocol.
54−--
55−-- If you are going to immediately encode straight to a
56−-- 'L.ByteString', it is more efficient to use 'encodeToBuilder'
57−-- instead.
58−encodeToTextBuilder :: Value -> Builder
59−encodeToTextBuilder =
60− go
61− where
62− go Null = {-# SCC "go/Null" #-} "null"
63− go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"
64− go (Number s) = {-# SCC "go/Number" #-} fromScientific s
65− go (String s) = {-# SCC "go/String" #-} string s
66− go (Array v)
67− | V.null v = {-# SCC "go/Array" #-} "[]"
68− | otherwise = {-# SCC "go/Array" #-}
69− singleton '[' <>
70− go (V.unsafeHead v) <>
71− V.foldr f (singleton ']') (V.unsafeTail v)
72− where f a z = singleton ',' <> go a <> z
73− go (Object m) = {-# SCC "go/Object" #-}
74− case H.toList m of
75− (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs
76− _ -> "{}"
77− where f a z = singleton ',' <> one a <> z
78− one (k,v) = string k <> singleton ':' <> go v
79−
80−{-# DEPRECATED fromValue "Use 'encodeToTextBuilder' instead" #-}
81−fromValue :: Value -> Builder
82−fromValue = encodeToTextBuilder
16+import Data.ByteString.Lazy (ByteString)
17+import Data.Text.Lazy.Builder (Builder)
8318
84−string :: T.Text -> Builder
85−string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'
86− where
87− quote q = case T.uncons t of
88− Nothing -> fromText h
89− Just (!c,t') -> fromText h <> escape c <> quote t'
90− where (h,t) = {-# SCC "break" #-} T.break isEscape q
91− isEscape c = c == '\"' ||
92− c == '\\' ||
93− c < '\x20'
94− escape '\"' = "\\\""
95− escape '\\' = "\\\\"
96− escape '\n' = "\\n"
97− escape '\r' = "\\r"
98− escape '\t' = "\\t"
19+import qualified Data.Aeson as A
20+import qualified Data.Aeson.Text as A
9921
100− escape c
101− | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
102− | otherwise = singleton c
103− where h = showHex (fromEnum c) ""
22+encode :: A.ToJSON a => a -> ByteString
23+encode = A.encode
24+{-# DEPRECATED encode "Use encode from Data.Aeson" #-}
10425
105−fromScientific :: Scientific -> Builder
106−fromScientific s = formatScientificBuilder format prec s
107− where
108− (format, prec)
109− | base10Exponent s < 0 = (Generic, Nothing)
110− | otherwise = (Fixed, Just 0)
26+encodeToTextBuilder :: A.Value -> Builder
27+encodeToTextBuilder = A.encodeToTextBuilder
28+{-# DEPRECATED encodeToTextBuilder "Use encodeTotextBuilder from Data.Aeson.Text" #-}
Data/Aeson/Encode/Functions.hsdeleted−14
@@ -1,14 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−module Data.Aeson.Encode.Functions
4− (
5− builder
6− ) where
7−
8−import Data.Aeson.Encoding
9−import Data.Aeson.Types.Class
10−import Data.ByteString.Builder (Builder)
11−import Data.Monoid ((<>))
12−
13−
14−{-# INLINE builder #-}
Data/Aeson/Encoding.hs+7
@@ -1,7 +1,14 @@
1+-- |
2+--
3+-- Functions in this module return well-formed 'Encoding''.
4+-- Polymorphic variants, which return @'Encoding' a@, return a textual JSON
5+-- value, so it can be used as both @'Encoding'' 'Text'@ and @'Encoding' = 'Encoding'' 'Value'@.
16module Data.Aeson.Encoding
27 (
38 -- * Encoding
49 Encoding
10+ , Encoding'
11+ , encodingToLazyByteString
512 , fromEncoding
613 , unsafeToEncoding
714 , Series
Data/Aeson/Encode/Builder.hs → Data/Aeson/Encoding/Builder.hsrenamed+5−2
@@ -1,7 +1,7 @@
11{-# LANGUAGE BangPatterns, OverloadedStrings #-}
22
33-- |
4−-- Module: Data.Aeson.Encode.Builder
4+-- Module: Data.Aeson.Encoding.Builder
55-- Copyright: (c) 2011 MailRank, Inc.
66-- (c) 2013 Simon Meier <iridcode@gmail.com>
77-- License: BSD3
@@ -11,7 +11,7 @@
1111--
1212-- Efficiently serialize a JSON value using the UTF-8 encoding.
1313
14−module Data.Aeson.Encode.Builder
14+module Data.Aeson.Encoding.Builder
1515 (
1616 encodeToBuilder
1717 , null_
@@ -35,6 +35,9 @@ module Data.Aeson.Encode.Builder
3535 , ascii5
3636 ) where
3737
38+import Prelude ()
39+import Prelude.Compat
40+
3841import Data.Aeson.Internal.Time
3942import Data.Aeson.Types.Internal (Value (..))
4043import Data.ByteString.Builder as B
Data/Aeson/Encoding/Internal.hs+95−70
@@ -1,13 +1,16 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE RankNTypes #-}
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE EmptyDataDecls #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE RankNTypes #-}
55module Data.Aeson.Encoding.Internal
66 (
77 -- * Encoding
8− Encoding (..) -- TODO: export fromEncoding for now
8+ Encoding' (..)
9+ , Encoding
10+ , encodingToLazyByteString
911 , unsafeToEncoding
10− , Series (..) -- TODO: don't export constructor
12+ , retagEncoding
13+ , Series (..)
1114 , pairs
1215 , pair
1316 -- * Predicates
@@ -15,8 +18,8 @@ module Data.Aeson.Encoding.Internal
1518 -- * Encoding constructors
1619 , emptyArray_
1720 , emptyObject_
18− , wrapArray
1921 , wrapObject
22+ , wrapArray
2023 , null_
2124 , bool
2225 , text
@@ -26,6 +29,10 @@ module Data.Aeson.Encoding.Internal
2629 , dict
2730 , tuple
2831 , (>*<)
32+ , InArray
33+ , empty
34+ , (><)
35+ , econcat
2936 -- ** Decimal numbers
3037 , int8, int16, int32, int64, int
3138 , word8, word16, word32, word64, word
@@ -62,35 +69,48 @@ import Data.Word
6269
6370import Data.Aeson.Types.Internal (Value)
6471
65−import qualified Data.Aeson.Encode.Builder as EB
66−import qualified Data.ByteString.Builder as B
67−import qualified Data.ByteString.Lazy as BSL
68−import qualified Data.Text.Lazy as LT
72+import qualified Data.Aeson.Encoding.Builder as EB
73+import qualified Data.ByteString.Builder as B
74+import qualified Data.ByteString.Lazy as BSL
75+import qualified Data.Text.Lazy as LT
6976
7077-- | An encoding of a JSON value.
71−newtype Encoding = Encoding {
78+--
79+-- @tag@ represents which kind of JSON the Encoding is encoding to,
80+-- we reuse 'Text' and 'Value' as tags here.
81+newtype Encoding' tag = Encoding {
7282 fromEncoding :: Builder
7383 -- ^ Acquire the underlying bytestring builder.
74− } deriving (Semigroup,Monoid,Typeable)
84+ } deriving (Typeable)
85+
86+-- | Often used synonnym for 'Encoding''.
87+type Encoding = Encoding' Value
7588
7689-- | Make Encoding from Builder.
7790--
7891-- Use with care! You have to make sure that the passed Builder
7992-- is a valid JSON Encoding!
80−unsafeToEncoding :: Builder -> Encoding
93+unsafeToEncoding :: Builder -> Encoding' a
8194unsafeToEncoding = Encoding
8295
96+encodingToLazyByteString :: Encoding' a -> BSL.ByteString
97+encodingToLazyByteString = toLazyByteString . fromEncoding
98+{-# INLINE encodingToLazyByteString #-}
99+
100+retagEncoding :: Encoding' a -> Encoding' b
101+retagEncoding = Encoding . fromEncoding
102+
83103-------------------------------------------------------------------------------
84104-- Encoding instances
85105-------------------------------------------------------------------------------
86106
87−instance Show Encoding where
107+instance Show (Encoding' a) where
88108 show (Encoding e) = show (toLazyByteString e)
89109
90−instance Eq Encoding where
110+instance Eq (Encoding' a) where
91111 Encoding a == Encoding b = toLazyByteString a == toLazyByteString b
92112
93−instance Ord Encoding where
113+instance Ord (Encoding' a) where
94114 compare (Encoding a) (Encoding b) =
95115 compare (toLazyByteString a) (toLazyByteString b)
96116
@@ -102,25 +122,22 @@ instance Ord Encoding where
102122--
103123-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
104124data Series = Empty
105− | Value Encoding
125+ | Value (Encoding' Series)
106126 deriving (Typeable)
107127
108128pair :: Text -> Encoding -> Series
109−pair name val = Value $ text name <> colon <> val
129+pair name val = Value $ retagEncoding $ text name >< colon >< val
110130
111131instance Semigroup Series where
112− Empty <> a = a
113− Value a <> b =
114− Value $
115− a <> case b of
116− Empty -> mempty
117− Value c -> Encoding (char7 ',') <> c
132+ Empty <> a = a
133+ a <> Empty = a
134+ Value a <> Value b = Value (a >< comma >< b)
118135
119136instance Monoid Series where
120137 mempty = Empty
121138 mappend = (<>)
122139
123−nullEncoding :: Encoding -> Bool
140+nullEncoding :: Encoding' a -> Bool
124141nullEncoding = BSL.null . toLazyByteString . fromEncoding
125142
126143emptyArray_ :: Encoding
@@ -129,11 +146,11 @@ emptyArray_ = Encoding EB.emptyArray_
129146emptyObject_ :: Encoding
130147emptyObject_ = Encoding EB.emptyObject_
131148
132−wrapArray :: Encoding -> Encoding
133−wrapArray e = openBracket <> e <> closeBracket
149+wrapArray :: Encoding' a -> Encoding
150+wrapArray e = retagEncoding $ openBracket >< e >< closeBracket
134151
135−wrapObject :: Encoding -> Encoding
136−wrapObject e = openCurly <> e <> closeCurly
152+wrapObject :: Encoding' a -> Encoding
153+wrapObject e = retagEncoding $ openCurly >< e >< closeCurly
137154
138155null_ :: Encoding
139156null_ = Encoding EB.null_
@@ -144,41 +161,50 @@ bool False = Encoding "false"
144161
145162-- | Encode a series of key/value pairs, separated by commas.
146163pairs :: Series -> Encoding
147−pairs = brackets '{' '}'
164+pairs (Value v) = openCurly >< retagEncoding v >< closeCurly
165+pairs Empty = emptyObject_
148166{-# INLINE pairs #-}
149167
150−brackets :: Char -> Char -> Series -> Encoding
151−brackets begin end (Value v) = Encoding $
152− char7 begin <> fromEncoding v <> char7 end
153−brackets begin end Empty = Encoding (primBounded (EB.ascii2 (begin,end)) ())
154−
155168list :: (a -> Encoding) -> [a] -> Encoding
156169list _ [] = emptyArray_
157−list to' (x:xs) = Encoding $
158− char7 '[' <> fromEncoding (to' x) <> commas xs <> char7 ']'
170+list to' (x:xs) = openBracket >< to' x >< commas xs >< closeBracket
159171 where
160− commas = foldr (\v vs -> char7 ',' <> fromEncoding (to' v) <> vs) mempty
172+ commas = foldr (\v vs -> comma >< to' v >< vs) empty
161173{-# INLINE list #-}
162174
163175-- | Encode as JSON object
164176dict
165− :: (k -> Encoding) -- ^ key encoding
177+ :: (k -> Encoding' Text) -- ^ key encoding
166178 -> (v -> Encoding) -- ^ value encoding
167179 -> (forall a. (k -> v -> a -> a) -> a -> m -> a) -- ^ @foldrWithKey@ - indexed fold
168180 -> m -- ^ container
169181 -> Encoding
170−dict encodeKey encodeVal foldrWithKey = brackets '{' '}' . foldrWithKey go mempty
182+dict encodeKey encodeVal foldrWithKey = pairs . foldrWithKey go mempty
171183 where
172184 go k v c = Value (encodeKV k v) <> c
173− encodeKV k v = encodeKey k <> Encoding (char7 ':') <> encodeVal v
185+ encodeKV k v = retagEncoding (encodeKey k) >< colon >< retagEncoding (encodeVal v)
174186{-# INLINE dict #-}
175187
188+-- | Type tag for tuples contents, see 'tuple'.
189+data InArray
190+
176191infixr 6 >*<
177192-- | See 'tuple'.
178−(>*<) :: Encoding -> Encoding -> Encoding
179−Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b
193+(>*<) :: Encoding' a -> Encoding' b -> Encoding' InArray
194+a >*< b = retagEncoding a >< comma >< retagEncoding b
180195{-# INLINE (>*<) #-}
181196
197+empty :: Encoding' a
198+empty = Encoding mempty
199+
200+econcat :: [Encoding' a] -> Encoding' a
201+econcat = foldr (><) empty
202+
203+infixr 6 ><
204+(><) :: Encoding' a -> Encoding' a -> Encoding' a
205+Encoding a >< Encoding b = Encoding (a <> b)
206+{-# INLINE (><) #-}
207+
182208-- | Encode as a tuple.
183209--
184210-- @
@@ -186,26 +212,26 @@ Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b
186212-- toEncoding a >*<
187213-- toEncoding b >*<
188214-- toEncoding c
189−tuple :: Encoding -> Encoding
190−tuple b = Encoding (char7 '[' <> fromEncoding b <> char7 ']')
215+tuple :: Encoding' InArray -> Encoding
216+tuple b = retagEncoding $ openBracket >< b >< closeBracket
191217{-# INLINE tuple #-}
192218
193−text :: Text -> Encoding
219+text :: Text -> Encoding' a
194220text = Encoding . EB.text
195221
196−lazyText :: LT.Text -> Encoding
222+lazyText :: LT.Text -> Encoding' a
197223lazyText t = Encoding $
198224 B.char7 '"' <>
199225 LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t
200226
201−string :: String -> Encoding
227+string :: String -> Encoding' a
202228string = Encoding . EB.string
203229
204230-------------------------------------------------------------------------------
205231-- chars
206232-------------------------------------------------------------------------------
207233
208−comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding
234+comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding' a
209235comma = Encoding $ char7 ','
210236colon = Encoding $ char7 ':'
211237openBracket = Encoding $ char7 '['
@@ -269,66 +295,65 @@ realFloatToEncoding e d
269295-- Decimal numbers as Text
270296-------------------------------------------------------------------------------
271297
272−int8Text :: Int8 -> Encoding
298+int8Text :: Int8 -> Encoding' a
273299int8Text = Encoding . EB.quote . B.int8Dec
274300
275−int16Text :: Int16 -> Encoding
301+int16Text :: Int16 -> Encoding' a
276302int16Text = Encoding . EB.quote . B.int16Dec
277303
278−int32Text :: Int32 -> Encoding
304+int32Text :: Int32 -> Encoding' a
279305int32Text = Encoding . EB.quote . B.int32Dec
280306
281−int64Text :: Int64 -> Encoding
307+int64Text :: Int64 -> Encoding' a
282308int64Text = Encoding . EB.quote . B.int64Dec
283309
284−intText :: Int -> Encoding
310+intText :: Int -> Encoding' a
285311intText = Encoding . EB.quote . B.intDec
286312
287−word8Text :: Word8 -> Encoding
313+word8Text :: Word8 -> Encoding' a
288314word8Text = Encoding . EB.quote . B.word8Dec
289315
290−word16Text :: Word16 -> Encoding
316+word16Text :: Word16 -> Encoding' a
291317word16Text = Encoding . EB.quote . B.word16Dec
292318
293−word32Text :: Word32 -> Encoding
319+word32Text :: Word32 -> Encoding' a
294320word32Text = Encoding . EB.quote . B.word32Dec
295321
296−word64Text :: Word64 -> Encoding
322+word64Text :: Word64 -> Encoding' a
297323word64Text = Encoding . EB.quote . B.word64Dec
298324
299−wordText :: Word -> Encoding
325+wordText :: Word -> Encoding' a
300326wordText = Encoding . EB.quote . B.wordDec
301327
302−integerText :: Integer -> Encoding
328+integerText :: Integer -> Encoding' a
303329integerText = Encoding . EB.quote . B.integerDec
304330
305−-- | TODO: check infinite and nan?
306−floatText :: Float -> Encoding
331+floatText :: Float -> Encoding' a
307332floatText = Encoding . EB.quote . B.floatDec
308333
309−doubleText :: Double -> Encoding
334+doubleText :: Double -> Encoding' a
310335doubleText = Encoding . EB.quote . B.doubleDec
311336
312−scientificText :: Scientific -> Encoding
337+scientificText :: Scientific -> Encoding' a
313338scientificText = Encoding . EB.quote . EB.scientific
314339
315340-------------------------------------------------------------------------------
316341-- time
317342-------------------------------------------------------------------------------
318343
319−day :: Day -> Encoding
344+day :: Day -> Encoding' a
320345day = Encoding . EB.quote . EB.day
321346
322−localTime :: LocalTime -> Encoding
347+localTime :: LocalTime -> Encoding' a
323348localTime = Encoding . EB.quote . EB.localTime
324349
325−utcTime :: UTCTime -> Encoding
350+utcTime :: UTCTime -> Encoding' a
326351utcTime = Encoding . EB.quote . EB.utcTime
327352
328−timeOfDay :: TimeOfDay -> Encoding
353+timeOfDay :: TimeOfDay -> Encoding' a
329354timeOfDay = Encoding . EB.quote . EB.timeOfDay
330355
331−zonedTime :: ZonedTime -> Encoding
356+zonedTime :: ZonedTime -> Encoding' a
332357zonedTime = Encoding . EB.quote . EB.zonedTime
333358
334359-------------------------------------------------------------------------------
Data/Aeson/Functions.hs → Data/Aeson/Internal/Functions.hsrenamed+4−8
@@ -7,13 +7,15 @@
77-- Stability: experimental
88-- Portability: portable
99
10−module Data.Aeson.Functions
10+module Data.Aeson.Internal.Functions
1111 ( mapHashKeyVal
12− , hashMapKey
1312 , mapKeyVal
1413 , mapKey
1514 ) where
1615
16+import Prelude ()
17+import Prelude.Compat
18+
1719import Data.Hashable (Hashable)
1820import qualified Data.HashMap.Strict as H
1921import qualified Data.Map as M
@@ -24,12 +26,6 @@ mapHashKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
2426mapHashKeyVal fk kv = M.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty
2527{-# INLINE mapHashKeyVal #-}
2628
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−
3329-- | Transform the keys and values of a 'H.HashMap'.
3430mapKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)
3531 -> H.HashMap k1 v1 -> H.HashMap k2 v2
Data/Aeson/Internal/Time.hs+3
@@ -17,6 +17,9 @@ module Data.Aeson.Internal.Time
1717 , toTimeOfDay64
1818 ) where
1919
20+import Prelude ()
21+import Prelude.Compat
22+
2023import Data.Fixed (Pico)
2124import Data.Int (Int64)
2225import Data.Time
Data/Aeson/Parser/Internal.hs+3−4
@@ -31,6 +31,9 @@ module Data.Aeson.Parser.Internal
3131 , eitherDecodeStrictWith
3232 ) where
3333
34+import Prelude ()
35+import Prelude.Compat
36+
3437import Control.Monad.IO.Class (liftIO)
3538import Data.Aeson.Types.Internal (IResult(..), JSONPath, Result(..), Value(..))
3639import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,
@@ -58,10 +61,6 @@ import qualified Data.ByteString.Lazy as L
5861import qualified Data.ByteString.Unsafe as B
5962import qualified Data.HashMap.Strict as H
6063
61−#if !MIN_VERSION_base(4,8,0)
62−import Control.Applicative ((*>), (<$>), (<*), pure)
63−#endif
64−
6564#if MIN_VERSION_ghc_prim(0,3,1)
6665import GHC.Base (Int#, (==#), isTrue#, orI#, word2Int#)
6766import GHC.Word (Word8(W8#))
Data/Aeson/Parser/Time.hs+4−5
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
1+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
22
33-- |
44-- Module: Data.Aeson.Parser.Time
@@ -21,6 +21,9 @@ module Data.Aeson.Parser.Time
2121 , zonedTime
2222 ) where
2323
24+import Prelude ()
25+import Prelude.Compat
26+
2427import Control.Monad (when, void)
2528import Data.Aeson.Internal.Time (toPico)
2629import Data.Attoparsec.Text as A
@@ -36,10 +39,6 @@ import qualified Data.Aeson.Types.Internal as Aeson
3639import qualified Data.Text as T
3740import qualified Data.Time.LocalTime as Local
3841
39−#if !MIN_VERSION_base(4,8,0)
40−import Control.Applicative ((<$>), (<*>), (<*), (*>))
41−#endif
42−
4342-- | Run an attoparsec parser as an aeson parser.
4443run :: Parser a -> Text -> Aeson.Parser a
4544run p t = case A.parseOnly (p <* endOfInput) t of
Data/Aeson/TH.hs+4−5
@@ -141,7 +141,6 @@ import Data.List ( (++), all, any, find, foldl, foldl'
141141import Data.List.NonEmpty ( NonEmpty((:|)), (<|) )
142142import Data.Map ( Map )
143143import Data.Maybe ( Maybe(Nothing, Just), catMaybes, fromMaybe, mapMaybe )
144−import Data.Monoid ( (<>), mconcat )
145144import Data.Set ( Set )
146145import Language.Haskell.TH
147146#if MIN_VERSION_template_haskell(2,8,0)
@@ -581,7 +580,7 @@ isMaybe (_, _, (_, _, AppT (ConT t) _)) = t == ''Maybe
581580isMaybe _ = False
582581
583582(<^>) :: ExpQ -> ExpQ -> ExpQ
584−(<^>) a b = infixApp a [|(<>)|] b
583+(<^>) a b = infixApp a [|(E.><)|] b
585584infixr 6 <^>
586585
587586(<:>) :: ExpQ -> ExpQ -> ExpQ
@@ -660,10 +659,10 @@ argsToEncoding jc tes opts multiCons (RecC conName ts) = case (unwrapUnaryRecord
660659 (argTys, tvMap) <- reifyConTys jc tes conName
661660 let exp = object objBody
662661
663− objBody = [|mconcat|] `appE`
662+ objBody = [|E.econcat|] `appE`
664663 ([|intersperse E.comma|] `appE` pairs)
665664 pairs | omitNothingFields opts = infixApp maybeFields
666− [|(<>)|]
665+ [|(++)|]
667666 restFields
668667 | otherwise = listE (map toPair argCons)
669668
@@ -680,7 +679,7 @@ argsToEncoding jc tes opts multiCons (RecC conName ts) = case (unwrapUnaryRecord
680679 (infixApp
681680 (infixE
682681 (Just $ toFieldName field <^> [|E.colon|])
683− [|(<>)|]
682+ [|(E.><)|]
684683 Nothing)
685684 [|(.)|]
686685 (dispatchToEncoding jc conName tvMap argTy))
Data/Aeson/Text.hsnew file+97
@@ -0,0 +1,97 @@
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2+-- |
3+-- Module: Data.Aeson.Text
4+-- Copyright: (c) 2012-2016 Bryan O'Sullivan
5+-- (c) 2011 MailRank, Inc.
6+-- License: BSD3
7+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
8+-- Stability: experimental
9+-- Portability: portable
10+--
11+-- Most frequently, you'll probably want to encode straight to UTF-8
12+-- (the standard JSON encoding) using 'encode'.
13+--
14+-- You can use the conversions to 'Builder's when embedding JSON messages as
15+-- parts of a protocol.
16+module Data.Aeson.Text
17+ ( encodeToLazyText
18+ , encodeToTextBuilder
19+ ) where
20+
21+import Data.Aeson.Types (Value(..), ToJSON(..))
22+import Data.Aeson.Encoding (encodingToLazyByteString)
23+import Data.Monoid ((<>))
24+import Data.Scientific (FPFormat(..), Scientific, base10Exponent)
25+import Data.Text.Lazy.Builder
26+import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
27+
28+import Numeric (showHex)
29+import qualified Data.HashMap.Strict as H
30+import qualified Data.Text as T
31+import qualified Data.Text.Lazy as LT
32+import qualified Data.Text.Lazy.Encoding as LT
33+import qualified Data.Vector as V
34+
35+-- | Encode a JSON 'Value' to a "Data.Text.Lazy"
36+--
37+-- /Note:/ uses 'toEncoding'
38+encodeToLazyText :: ToJSON a => a -> LT.Text
39+encodeToLazyText = LT.decodeUtf8 . encodingToLazyByteString . toEncoding
40+
41+-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
42+-- embedded efficiently in a text-based protocol.
43+--
44+-- If you are going to immediately encode straight to a
45+-- 'L.ByteString', it is more efficient to use 'encodeToBuilder'
46+-- instead.
47+--
48+-- /Note:/ Uses 'toJSON'
49+encodeToTextBuilder :: ToJSON a => a -> Builder
50+encodeToTextBuilder =
51+ go . toJSON
52+ where
53+ go Null = {-# SCC "go/Null" #-} "null"
54+ go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"
55+ go (Number s) = {-# SCC "go/Number" #-} fromScientific s
56+ go (String s) = {-# SCC "go/String" #-} string s
57+ go (Array v)
58+ | V.null v = {-# SCC "go/Array" #-} "[]"
59+ | otherwise = {-# SCC "go/Array" #-}
60+ singleton '[' <>
61+ go (V.unsafeHead v) <>
62+ V.foldr f (singleton ']') (V.unsafeTail v)
63+ where f a z = singleton ',' <> go a <> z
64+ go (Object m) = {-# SCC "go/Object" #-}
65+ case H.toList m of
66+ (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs
67+ _ -> "{}"
68+ where f a z = singleton ',' <> one a <> z
69+ one (k,v) = string k <> singleton ':' <> go v
70+
71+string :: T.Text -> Builder
72+string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'
73+ where
74+ quote q = case T.uncons t of
75+ Nothing -> fromText h
76+ Just (!c,t') -> fromText h <> escape c <> quote t'
77+ where (h,t) = {-# SCC "break" #-} T.break isEscape q
78+ isEscape c = c == '\"' ||
79+ c == '\\' ||
80+ c < '\x20'
81+ escape '\"' = "\\\""
82+ escape '\\' = "\\\\"
83+ escape '\n' = "\\n"
84+ escape '\r' = "\\r"
85+ escape '\t' = "\\t"
86+
87+ escape c
88+ | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h
89+ | otherwise = singleton c
90+ where h = showHex (fromEnum c) ""
91+
92+fromScientific :: Scientific -> Builder
93+fromScientific s = formatScientificBuilder format prec s
94+ where
95+ (format, prec)
96+ | base10Exponent s < 0 = (Generic, Nothing)
97+ | otherwise = (Fixed, Just 0)
Data/Aeson/Types.hs+3
@@ -40,10 +40,13 @@ module Data.Aeson.Types
4040 -- ** Keys for maps
4141 , ToJSONKey(..)
4242 , ToJSONKeyFunction(..)
43+ , toJSONKeyText
44+ , contramapToJSONKeyFunction
4345 , FromJSONKey(..)
4446 , FromJSONKeyFunction(..)
4547 , fromJSONKeyCoerce
4648 , coerceFromJSONKeyFunction
49+ , mapFromJSONKeyFunction
4750
4851 -- ** Liftings to unary and binary type constructors
4952 , FromJSON1(..)
Data/Aeson/Types/Class.hs+1
@@ -51,6 +51,7 @@ module Data.Aeson.Types.Class
5151 -- * Classes and types for map keys
5252 , ToJSONKey(..)
5353 , ToJSONKeyFunction(..)
54+ , toJSONKeyText
5455 , contramapToJSONKeyFunction
5556 , FromJSONKey(..)
5657 , FromJSONKeyFunction(..)
Data/Aeson/Types/FromJSON.hs+81−24
@@ -69,7 +69,7 @@ module Data.Aeson.Types.FromJSON (
6969import Prelude ()
7070import Prelude.Compat hiding (foldr)
7171
72−import Data.Aeson.Functions (mapKey)
72+import Data.Aeson.Internal.Functions (mapKey)
7373import Data.Aeson.Types.Generic
7474import Data.Aeson.Types.Internal
7575
@@ -82,6 +82,7 @@ import Control.Monad ((<=<))
8282import Data.Attoparsec.Number (Number (..))
8383import Data.Bits (unsafeShiftR)
8484import Data.Fixed (Fixed, HasResolution)
85+import Data.Functor.Compose (Compose (..))
8586import Data.Functor.Identity (Identity (..))
8687import Data.Hashable (Hashable (..))
8788import Data.Int (Int16, Int32, Int64, Int8)
@@ -127,9 +128,8 @@ import qualified Data.Vector.Unboxed as VU
127128
128129import Unsafe.Coerce (unsafeCoerce)
129130
130−-- Coercible derivations aren't as powerful on GHC 7.8, though supported.
131131#ifndef HAS_COERCIBLE
132−#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 709)
132+#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)
133133#endif
134134
135135#if HAS_COERCIBLE
@@ -333,6 +333,7 @@ class FromJSONKey a where
333333 fromJSONKey :: FromJSONKeyFunction a
334334 default fromJSONKey :: FromJSON a => FromJSONKeyFunction a
335335 fromJSONKey = FromJSONKeyValue parseJSON
336+
336337 -- | This is similar in spirit to the 'readList' method of 'Read'.
337338 -- It makes it possible to give 'String' keys special treatment
338339 -- without using @OverlappingInstances@. End users should always
@@ -362,13 +363,13 @@ data CoerceText a where
362363-- 'FromJSONKeyText', which is in turn more powerful than 'FromJSONKeyCoerce'.
363364-- For performance reasons, these exist as three options instead of one.
364365data FromJSONKeyFunction a
365− = FromJSONKeyCoerce (CoerceText a)
366+ = FromJSONKeyCoerce !(CoerceText a)
366367 -- ^ uses 'coerce' ('unsafeCoerce' in older GHCs)
367− | FromJSONKeyText (Text -> a)
368+ | FromJSONKeyText !(Text -> a)
368369 -- ^ conversion from 'Text' that always succeeds
369− | FromJSONKeyTextParser (Text -> Parser a)
370+ | FromJSONKeyTextParser !(Text -> Parser a)
370371 -- ^ conversion from 'Text' that may fail
371− | FromJSONKeyValue (Value -> Parser a)
372+ | FromJSONKeyValue !(Value -> Parser a)
372373 -- ^ conversion for non-textual keys
373374
374375-- | Only law abiding up to interpretation
@@ -383,6 +384,9 @@ instance Functor FromJSONKeyFunction where
383384-- compatible with 'Text' i.e. hash values should be equal for wrapped values as well.
384385-- This property will always be maintained if the 'Hashable' and 'Eq' instances
385386-- are derived with generalized newtype deriving.
387+-- compatible with 'Text' i.e. hash values be equal for wrapped values as well.
388+--
389+-- On pre GHC 7.8 this is unconstrainted function.
386390fromJSONKeyCoerce ::
387391#if HAS_COERCIBLE
388392 Coercible Text a =>
@@ -390,15 +394,22 @@ fromJSONKeyCoerce ::
390394 FromJSONKeyFunction a
391395fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
392396
397+-- | Semantically the same as @coerceFromJSONKeyFunction = fmap coerce = coerce@.
398+--
399+-- See note on 'fromJSONKeyCoerce'.
393400coerceFromJSONKeyFunction ::
394401#if HAS_COERCIBLE
395402 Coercible a b =>
396403#endif
397404 FromJSONKeyFunction a -> FromJSONKeyFunction b
405+#if HAS_COERCIBLE
406+coerceFromJSONKeyFunction = coerce
407+#else
398408coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText
399409coerceFromJSONKeyFunction (FromJSONKeyText f) = FromJSONKeyText (coerce' . f)
400410coerceFromJSONKeyFunction (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap coerce' . f)
401411coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fmap coerce' . f)
412+#endif
402413
403414{-# RULES
404415 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).
@@ -411,6 +422,7 @@ coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fma
411422 #-}
412423#endif
413424
425+-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.
414426mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
415427mapFromJSONKeyFunction = fmap
416428
@@ -977,13 +989,6 @@ notFound key = fail $ "The key \"" ++ unpack key ++ "\" was not found"
977989-- base
978990-------------------------------------------------------------------------------
979991
980−instance FromJSON1 Identity where
981− liftParseJSON p _ a = Identity <$> p a
982− {-# INLINE liftParseJSON #-}
983−
984−instance (FromJSON a) => FromJSON (Identity a) where
985− parseJSON = parseJSON1
986− {-# INLINE parseJSON #-}
987992
988993instance FromJSON2 Const where
989994 liftParseJSON2 p _ _ _ = fmap Const . p
@@ -1203,6 +1208,7 @@ instance FromJSON Word64 where
12031208instance FromJSONKey Word64 where
12041209 fromJSONKey = FromJSONKeyTextParser parseIntegralText
12051210
1211+
12061212instance FromJSON Text where
12071213 parseJSON = withText "Text" pure
12081214 {-# INLINE parseJSON #-}
@@ -1210,17 +1216,28 @@ instance FromJSON Text where
12101216instance FromJSONKey Text where
12111217 fromJSONKey = fromJSONKeyCoerce
12121218
1219+
12131220instance FromJSON LT.Text where
12141221 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
12151222 {-# INLINE parseJSON #-}
12161223
1224+instance FromJSONKey LT.Text where
1225+ fromJSONKey = FromJSONKeyText LT.fromStrict
1226+
1227+
12171228instance FromJSON Version where
1229+ parseJSON = withText "Version" parseVersionText
12181230 {-# INLINE parseJSON #-}
1219− parseJSON = withText "Version" $ go . readP_to_S parseVersion . unpack
1220− where
1221− go [(v,[])] = return v
1222− go (_ : xs) = go xs
1223− go _ = fail $ "could not parse Version"
1231+
1232+instance FromJSONKey Version where
1233+ fromJSONKey = FromJSONKeyTextParser parseVersionText
1234+
1235+parseVersionText :: Text -> Parser Version
1236+parseVersionText = go . readP_to_S parseVersion . unpack
1237+ where
1238+ go [(v,[])] = return v
1239+ go (_ : xs) = go xs
1240+ go _ = fail $ "could not parse Version"
12241241
12251242-------------------------------------------------------------------------------
12261243-- semigroups NonEmpty
@@ -1260,6 +1277,49 @@ instance (FromJSON a) => FromJSON (DList.DList a) where
12601277 parseJSON = parseJSON1
12611278 {-# INLINE parseJSON #-}
12621279
1280+-------------------------------------------------------------------------------
1281+-- tranformers - Functors
1282+-------------------------------------------------------------------------------
1283+
1284+instance FromJSON1 Identity where
1285+ liftParseJSON p _ a = Identity <$> p a
1286+ {-# INLINE liftParseJSON #-}
1287+
1288+ liftParseJSONList _ p a = fmap Identity <$> p a
1289+ {-# INLINE liftParseJSONList #-}
1290+
1291+instance (FromJSON a) => FromJSON (Identity a) where
1292+ parseJSON = parseJSON1
1293+ {-# INLINE parseJSON #-}
1294+
1295+ parseJSONList = liftParseJSONList parseJSON parseJSONList
1296+ {-# INLINE parseJSONList #-}
1297+
1298+instance (FromJSONKey a, FromJSON a) => FromJSONKey (Identity a) where
1299+ fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction a)
1300+ fromJSONKeyList = coerceFromJSONKeyFunction (fromJSONKeyList :: FromJSONKeyFunction [a])
1301+
1302+
1303+instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Compose f g) where
1304+ liftParseJSON p pl a = Compose <$> liftParseJSON g gl a
1305+ where
1306+ g = liftParseJSON p pl
1307+ gl = liftParseJSONList p pl
1308+ {-# INLINE liftParseJSON #-}
1309+
1310+ liftParseJSONList p pl a = map Compose <$> liftParseJSONList g gl a
1311+ where
1312+ g = liftParseJSON p pl
1313+ gl = liftParseJSONList p pl
1314+ {-# INLINE liftParseJSONList #-}
1315+
1316+instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Compose f g a) where
1317+ parseJSON = parseJSON1
1318+ {-# INLINE parseJSON #-}
1319+
1320+ parseJSONList = liftParseJSONList parseJSON parseJSONList
1321+ {-# INLINE parseJSONList #-}
1322+
12631323-------------------------------------------------------------------------------
12641324-- containers
12651325-------------------------------------------------------------------------------
@@ -1304,7 +1364,7 @@ instance (FromJSONKey k, Ord k) => FromJSON1 (M.Map k) where
13041364 FromJSONKeyText f -> withObject "Map k v" $
13051365 fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)
13061366 FromJSONKeyTextParser f -> withObject "Map k v" $
1307− H.foldrWithKey (\k v m -> M.insert <$> f k <*> (p v <?> Key k) <*> m) (pure M.empty)
1367+ H.foldrWithKey (\k v m -> M.insert <$> f k <?> Key k <*> p v <?> Key k <*> m) (pure M.empty)
13081368 FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
13091369 M.fromList <$> (Tr.sequence .
13101370 zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr)
@@ -1372,7 +1432,7 @@ instance (FromJSONKey k, Eq k, Hashable k) => FromJSON1 (H.HashMap k) where
13721432 FromJSONKeyText f -> withObject "HashMap k v" $
13731433 fmap (mapKey f) . H.traverseWithKey (\k v -> p v <?> Key k)
13741434 FromJSONKeyTextParser f -> withObject "HashMap k v" $
1375− H.foldrWithKey (\k v m -> H.insert <$> f k <*> (p v <?> Key k) <*> m) (pure H.empty)
1435+ H.foldrWithKey (\k v m -> H.insert <$> f k <?> Key k <*> p v <?> Key k <*> m) (pure H.empty)
13761436 FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
13771437 H.fromList <$> (Tr.sequence .
13781438 zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr)
@@ -1518,9 +1578,6 @@ instance FromJSONKey Char where
15181578instance (FromJSONKey a, FromJSON a) => FromJSONKey [a] where
15191579 fromJSONKey = fromJSONKeyList
15201580
1521−instance (FromJSONKey a, FromJSON a) => FromJSONKey (Identity a) where
1522− fromJSONKey = mapFromJSONKeyFunction Identity fromJSONKey
1523−
15241581-------------------------------------------------------------------------------
15251582-- Tuple instances, see tuple-instances-from.hs
15261583-------------------------------------------------------------------------------
Data/Aeson/Types/Generic.hs+3
@@ -25,6 +25,9 @@
2525
2626module Data.Aeson.Types.Generic where
2727
28+import Prelude ()
29+import Prelude.Compat
30+
2831import GHC.Generics
2932import Data.Proxy (Proxy (..))
3033
Data/Aeson/Types/Internal.hs+4−7
@@ -60,8 +60,11 @@ module Data.Aeson.Types.Internal
6060 , DotNetTime(..)
6161 ) where
6262
63+import Prelude ()
64+import Prelude.Compat
65+
6366import Control.Arrow (first)
64−import Control.Applicative
67+import Control.Applicative (Alternative(..))
6568import Control.DeepSeq (NFData(..))
6669import Control.Monad (MonadPlus(..), ap)
6770import qualified Control.Monad.Fail as Fail
@@ -83,12 +86,6 @@ import qualified Data.Scientific as S
8386import qualified Data.Vector as V
8487import qualified Language.Haskell.TH.Syntax as TH
8588
86−#if !MIN_VERSION_base(4,8,0)
87−import Data.Foldable (Foldable(..))
88−import Data.Monoid (Monoid(..))
89−import Data.Traversable (Traversable(..))
90−#endif
91−
9289#if !MIN_VERSION_unordered_containers(0,2,6)
9390import Data.List (sort)
9491#endif
Data/Aeson/Types/ToJSON.hs+186−118
@@ -43,6 +43,7 @@ module Data.Aeson.Types.ToJSON (
4343 -- * Classes and types for map keys
4444 , ToJSONKey(..)
4545 , ToJSONKeyFunction(..)
46+ , toJSONKeyText
4647 , contramapToJSONKeyFunction
4748 -- * Object key-value pairs
4849 , KeyValue(..)
@@ -55,9 +56,9 @@ module Data.Aeson.Types.ToJSON (
5556import Prelude ()
5657import Prelude.Compat
5758
58−import Data.Aeson.Encoding.Internal (Encoding (..), Series, dict, emptyArray_,
59− tuple, (>*<))
60−import Data.Aeson.Functions (mapHashKeyVal, mapKeyVal)
59+import Data.Aeson.Encoding.Internal (Encoding, Encoding', Series, dict,
60+ emptyArray_, tuple, (>*<), (><))
61+import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
6162import Data.Aeson.Types.Generic
6263import Data.Aeson.Types.Internal
6364
@@ -71,6 +72,7 @@ import Data.Bits (unsafeShiftR)
7172import Data.DList (DList)
7273import Data.Fixed (Fixed, HasResolution)
7374import Data.Foldable (toList)
75+import Data.Functor.Compose (Compose (..))
7476import Data.Functor.Identity (Identity (..))
7577import Data.Int (Int16, Int32, Int64, Int8)
7678import Data.List (intersperse)
@@ -92,35 +94,30 @@ import Foreign.Storable (Storable)
9294import GHC.Generics
9395import Numeric.Natural (Natural)
9496
95−import qualified Data.ByteString.Builder as B (toLazyByteString)
96−import qualified Data.ByteString.Lazy as L
97−import qualified Data.DList as DList
98−import qualified Data.HashMap.Strict as H
99−import qualified Data.HashSet as HashSet
100−import qualified Data.IntMap as IntMap
101−import qualified Data.IntSet as IntSet
102−import qualified Data.List.NonEmpty as NE
103−import qualified Data.Map as M
104−import qualified Data.Scientific as Scientific
105−import qualified Data.Sequence as Seq
106−import qualified Data.Set as Set
107−import qualified Data.Text as T
108−import qualified Data.Text.Encoding as T
109−import qualified Data.Text.Lazy as LT
110−import qualified Data.Tree as Tree
111−import qualified Data.Vector as V
112−import qualified Data.Vector.Generic as VG
113−import qualified Data.Vector.Mutable as VM
114−import qualified Data.Vector.Primitive as VP
115−import qualified Data.Vector.Storable as VS
116−import qualified Data.Vector.Unboxed as VU
97+import qualified Data.ByteString.Lazy as L
98+import qualified Data.DList as DList
99+import qualified Data.HashMap.Strict as H
100+import qualified Data.HashSet as HashSet
101+import qualified Data.IntMap as IntMap
102+import qualified Data.IntSet as IntSet
103+import qualified Data.List.NonEmpty as NE
104+import qualified Data.Map as M
105+import qualified Data.Scientific as Scientific
106+import qualified Data.Sequence as Seq
107+import qualified Data.Set as Set
108+import qualified Data.Text as T
109+import qualified Data.Text.Encoding as T
110+import qualified Data.Text.Lazy as LT
111+import qualified Data.Tree as Tree
112+import qualified Data.Vector as V
113+import qualified Data.Vector.Generic as VG
114+import qualified Data.Vector.Mutable as VM
115+import qualified Data.Vector.Primitive as VP
116+import qualified Data.Vector.Storable as VS
117+import qualified Data.Vector.Unboxed as VU
117118
118119toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
119−toJSONPair keySerialiser valSerializer (a, b) = Array $ V.create $ do
120− mv <- VM.unsafeNew 2
121− VM.unsafeWrite mv 0 (keySerialiser a)
122− VM.unsafeWrite mv 1 (valSerializer b)
123− return mv
120+toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
124121{-# INLINE toJSONPair #-}
125122
126123realFloatToJSON :: RealFloat a => a -> Value
@@ -309,7 +306,7 @@ instance KeyValue Pair where
309306
310307-- | Typeclass for types that can be used as the key of a map-like container
311308-- (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
312−-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
309+-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
313310-- type 'Map' 'Text' 'Char':
314311--
315312-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
@@ -355,16 +352,16 @@ instance KeyValue Pair where
355352-- >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
356353-- >>> LBC8.putStrLn $ encode m
357354-- [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
358−--
355+--
359356-- The next case to consider is if we have a type that is a
360357-- newtype wrapper around 'Text'. The recommended approach is to use
361358-- generalized newtype deriving:
362359--
363360-- > newtype RecordId = RecordId { getRecordId :: Text}
364361-- > deriving (Eq,Ord,ToJSONKey)
365−--
362+--
366363-- Then we may write:
367−--
364+--
368365-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
369366-- {"abc":"a"}
370367--
@@ -382,7 +379,7 @@ instance KeyValue Pair where
382379-- > instance ToJSONKey Color where
383380-- > toJSONKey = ToJSONKeyText f g
384381-- > where f = Text.pack . show
385−-- > g = text . Text.pack . show
382+-- > g = text . Text.pack . show
386383-- > -- text function is from Data.Aeson.Encoding
387384--
388385-- The situation of needing to turning function @a -> Text@ into
@@ -391,7 +388,7 @@ instance KeyValue Pair where
391388--
392389-- > instance ToJSONKey Color where
393390-- > toJSONKey = toJSONKeyText (Text.pack . show)
394−--
391+--
395392-- The performance of the above instance can be improved by
396393-- not using 'String' as an intermediate step when converting to
397394-- 'Text'. One option for improving performance would be to use
@@ -400,7 +397,7 @@ instance KeyValue Pair where
400397-- builder) is generated by encoding the 'Text' to a 'ByteString',
401398-- an intermediate step that could be avoided. The fastest possible
402399-- implementation would be:
403−--
400+--
404401-- > -- Assuming that OverloadedStrings is enabled
405402-- > instance ToJSONKey Color where
406403-- > toJSONKey = ToJSONKeyText f g
@@ -417,23 +414,45 @@ class ToJSONKey a where
417414 -- | Strategy for rendering the key for a map-like container.
418415 toJSONKey :: ToJSONKeyFunction a
419416 default toJSONKey :: ToJSON a => ToJSONKeyFunction a
420− toJSONKey = ToJSONKeyValue (toJSON, toEncoding)
417+ toJSONKey = ToJSONKeyValue toJSON toEncoding
418+
421419 -- | This is similar in spirit to the 'showsList' method of 'Show'.
422420 -- It makes it possible to give 'String' keys special treatment
423421 -- without using @OverlappingInstances@. End users should always
424422 -- be able to use the default implementation of this method.
425423 toJSONKeyList :: ToJSONKeyFunction [a]
426424 default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
427− toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)
425+ toJSONKeyList = ToJSONKeyValue toJSON toEncoding
428426
429427data ToJSONKeyFunction a
430− = ToJSONKeyText (a -> Text, a -> Encoding) -- ^ key is encoded to string, produces object
431− | ToJSONKeyValue (a -> Value, a -> Encoding) -- ^ key is encoded to value, produces array
428+ = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)
429+ -- ^ key is encoded to string, produces object
430+ | ToJSONKeyValue !(a -> Value) !(a -> Encoding)
431+ -- ^ key is encoded to value, produces array
432432
433+-- | Helper for creating textual keys.
434+--
435+-- @
436+-- instance 'ToJSONKey' MyKey where
437+-- 'toJSONKey' = 'toJSONKeyText' myKeyToText
438+-- where
439+-- myKeyToText = Text.pack . show -- or showt from text-show
440+-- @
441+toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
442+toJSONKeyText f = ToJSONKeyText f (E.text . f)
443+
444+-- | TODO: should this be exported?
445+toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
446+toJSONKeyTextEnc e = ToJSONKeyText tot e
447+ where
448+ -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
449+ tot = T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . E.encodingToLazyByteString . e
450+
451+-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
433452contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
434453contramapToJSONKeyFunction h x = case x of
435− ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)
436− ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)
454+ ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
455+ ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
437456
438457-------------------------------------------------------------------------------
439458-- Lifings of FromJSON and ToJSON to unary and binary type constructors
@@ -676,7 +695,7 @@ instance ( AllNullary (a :+: b) allNullary
676695 -- 'allNullaryToStringTag' option is set they are encoded to
677696 -- strings. This distinction is made by 'sumToEncoding':
678697 gToEncoding opts pa te tel
679− = (unTagged :: Tagged allNullary Encoding -> Encoding)
698+ = (unTagged :: Tagged allNullary (Encoding) -> Encoding)
680699 . sumToEncoding opts pa te tel
681700
682701instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
@@ -728,7 +747,7 @@ nonAllNullarySumToJSON opts pa tj tjl =
728747class SumToEncoding arity f allNullary where
729748 sumToEncoding :: Options -> Proxy arity
730749 -> (a -> Encoding) -> ([a] -> Encoding)
731− -> f a -> Tagged allNullary Encoding
750+ -> f a -> Tagged allNullary (Encoding)
732751
733752instance ( GetConName f
734753 , TaggedObjectEnc arity f
@@ -822,29 +841,28 @@ instance ( IsRecord a isRecord
822841 , Constructor c
823842 ) => TaggedObjectEnc arity (C1 c a) where
824843 taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =
825− E.openCurly <>
826− (toEncoding tagFieldName <>
827− E.colon <>
828− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
829− ((unTagged :: Tagged isRecord Encoding -> Encoding) .
830− taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v) <>
831− E.closeCurly
844+ E.wrapObject $
845+ (E.string tagFieldName ><
846+ E.colon ><
847+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><
848+ ((unTagged :: Tagged isRecord (Encoding) -> Encoding) .
849+ taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v)
832850
833851class TaggedObjectEnc' arity f isRecord where
834852 taggedObjectEnc' :: Options -> Proxy arity
835853 -> String -> (a -> Encoding) -> ([a] -> Encoding)
836− -> f a -> Tagged isRecord Encoding
854+ -> f a -> Tagged isRecord (Encoding)
837855
838856instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
839− taggedObjectEnc' _ _ _ _ _ _ = Tagged mempty
857+ taggedObjectEnc' _ _ _ _ _ _ = Tagged E.empty
840858
841859instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
842− taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma <>) . fst
860+ taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma ><) . fst
843861 . recordToEncoding opts pa te tel
844862
845863instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
846864 taggedObjectEnc' opts pa contentsFieldName te tel =
847− Tagged . (\z -> E.comma <> toEncoding contentsFieldName <> E.colon <> z) .
865+ Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .
848866 gToEncoding opts pa te tel
849867
850868--------------------------------------------------------------------------------
@@ -946,13 +964,13 @@ class ConsToEncoding' arity f isRecord where
946964 consToEncoding' :: Options -> Proxy arity
947965 -> Bool -- ^ Are we a record with one field?
948966 -> (a -> Encoding) -> ([a] -> Encoding)
949− -> f a -> Tagged isRecord Encoding
967+ -> f a -> Tagged isRecord (Encoding)
950968
951969instance ( IsRecord f isRecord
952970 , ConsToEncoding' arity f isRecord
953971 ) => ConsToEncoding arity f where
954972 consToEncoding opts pa te tel =
955− (unTagged :: Tagged isRecord Encoding -> Encoding)
973+ (unTagged :: Tagged isRecord (Encoding) -> (Encoding))
956974 . consToEncoding' opts pa (isUnary (undefined :: f a)) te tel
957975
958976instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
@@ -1003,39 +1021,40 @@ class RecordToEncoding arity f where
10031021 -- of the field (without the key); 'Nothing' otherwise
10041022 recordToEncoding :: Options -> Proxy arity
10051023 -> (a -> Encoding) -> ([a] -> Encoding)
1006− -> f a -> (Encoding, Maybe Encoding)
1024+ -> f a -> (Encoding, Maybe (Encoding))
10071025
10081026instance ( RecordToEncoding arity a
10091027 , RecordToEncoding arity b
10101028 ) => RecordToEncoding arity (a :*: b) where
10111029 recordToEncoding opts pa te tel (a :*: b) | omitNothingFields opts =
1012− (mconcat $ intersperse E.comma $
1030+ (E.econcat $ intersperse E.comma $
10131031 filter (not . E.nullEncoding)
10141032 [ fst (recordToEncoding opts pa te tel a)
10151033 , fst (recordToEncoding opts pa te tel b) ]
10161034 , Nothing)
10171035 recordToEncoding opts pa te tel (a :*: b) =
1018− (fst (recordToEncoding opts pa te tel a) <> E.comma <>
1036+ (fst (recordToEncoding opts pa te tel a) >< E.comma ><
10191037 fst (recordToEncoding opts pa te tel b),
10201038 Nothing)
10211039
1040+
10221041instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
10231042 recordToEncoding = fieldToEncoding
10241043
10251044instance OVERLAPPING_ (Selector s, ToJSON a) =>
10261045 RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
10271046 recordToEncoding opts _ _ _ (M1 k1) | omitNothingFields opts
1028− , K1 Nothing <- k1 = (mempty, Nothing)
1047+ , K1 Nothing <- k1 = (E.empty, Nothing)
10291048 recordToEncoding opts pa te tel m1 = fieldToEncoding opts pa te tel m1
10301049
10311050fieldToEncoding :: (Selector s, GToEncoding arity a)
10321051 => Options -> Proxy arity
10331052 -> (p -> Encoding) -> ([p] -> Encoding)
1034− -> S1 s a p -> (Encoding, Maybe Encoding)
1053+ -> S1 s a p -> (Encoding, Maybe (Encoding))
10351054fieldToEncoding opts pa te tel m1 =
10361055 let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
10371056 valueBuilder = gToEncoding opts pa te tel (unM1 m1)
1038− in (keyBuilder <> E.colon <> valueBuilder, Just valueBuilder)
1057+ in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)
10391058
10401059--------------------------------------------------------------------------------
10411060
@@ -1070,21 +1089,20 @@ instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
10701089class EncodeProduct arity f where
10711090 encodeProduct :: Options -> Proxy arity
10721091 -> (a -> Encoding) -> ([a] -> Encoding)
1073− -> f a -> Encoding
1092+ -> f a -> Encoding' E.InArray
10741093
10751094instance ( EncodeProduct arity a
10761095 , EncodeProduct arity b
10771096 ) => EncodeProduct arity (a :*: b) where
10781097 encodeProduct opts pa te tel (a :*: b) | omitNothingFields opts =
1079− mconcat $ intersperse E.comma $
1098+ E.econcat $ intersperse E.comma $
10801099 filter (not . E.nullEncoding)
10811100 [encodeProduct opts pa te tel a, encodeProduct opts pa te tel b]
1082− encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a <>
1083− E.comma <>
1101+ encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a >*<
10841102 encodeProduct opts pa te tel b
10851103
10861104instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1087− encodeProduct opts = gToEncoding opts
1105+ encodeProduct opts pa te tel a = E.retagEncoding $ gToEncoding opts pa te tel a
10881106
10891107--------------------------------------------------------------------------------
10901108
@@ -1130,12 +1148,12 @@ instance ( GToEncoding arity a
11301148 , Constructor c
11311149 ) => ObjectWithSingleFieldEnc arity (C1 c a) where
11321150 objectWithSingleFieldEnc opts pa te tel v =
1133− E.openCurly <>
1151+ E.openCurly ><
11341152 toEncoding
11351153 (constructorTagModifier opts
1136− (conName (undefined :: t c a p))) <>
1137− E.colon <>
1138− gToEncoding opts pa te tel v <>
1154+ (conName (undefined :: t c a p))) ><
1155+ E.colon ><
1156+ gToEncoding opts pa te tel v ><
11391157 E.closeCurly
11401158
11411159-------------------------------------------------------------------------------
@@ -1146,21 +1164,6 @@ instance ( GToEncoding arity a
11461164-- base
11471165-------------------------------------------------------------------------------
11481166
1149−instance ToJSON1 Identity where
1150− liftToJSON t _ (Identity a) = t a
1151− {-# INLINE liftToJSON #-}
1152−
1153− liftToEncoding t _ (Identity a) = t a
1154− {-# INLINE liftToEncoding #-}
1155−
1156−instance (ToJSON a) => ToJSON (Identity a) where
1157− toJSON = toJSON1
1158− {-# INLINE toJSON #-}
1159−
1160− toEncoding = toEncoding1
1161− {-# INLINE toEncoding #-}
1162−
1163−
11641167instance ToJSON2 Const where
11651168 liftToJSON2 t _ _ _ (Const x) = t x
11661169 {-# INLINE liftToJSON2 #-}
@@ -1237,10 +1240,7 @@ instance ToJSON Bool where
12371240 {-# INLINE toEncoding #-}
12381241
12391242instance ToJSONKey Bool where
1240− toJSONKey = ToJSONKeyText
1241− ( (\x -> if x then "true" else "false")
1242− , (\x -> toEncoding $ if x then ("true" :: Text) else "false")
1243− )
1243+ toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
12441244
12451245
12461246instance ToJSON Ordering where
@@ -1485,9 +1485,10 @@ instance ToJSON Text where
14851485 {-# INLINE toEncoding #-}
14861486
14871487instance ToJSONKey Text where
1488− toJSONKey = ToJSONKeyText (id, toEncoding)
1488+ toJSONKey = toJSONKeyText id
14891489 {-# INLINE toJSONKey #-}
14901490
1491+
14911492instance ToJSON LT.Text where
14921493 toJSON = String . LT.toStrict
14931494 {-# INLINE toJSON #-}
@@ -1495,6 +1496,10 @@ instance ToJSON LT.Text where
14951496 toEncoding = E.lazyText
14961497 {-# INLINE toEncoding #-}
14971498
1499+instance ToJSONKey LT.Text where
1500+ toJSONKey = toJSONKeyText LT.toStrict
1501+
1502+
14981503instance ToJSON Version where
14991504 toJSON = toJSON . showVersion
15001505 {-# INLINE toJSON #-}
@@ -1502,6 +1507,9 @@ instance ToJSON Version where
15021507 toEncoding = toEncoding . showVersion
15031508 {-# INLINE toEncoding #-}
15041509
1510+instance ToJSONKey Version where
1511+ toJSONKey = toJSONKeyText (T.pack . showVersion)
1512+
15051513-------------------------------------------------------------------------------
15061514-- semigroups NonEmpty
15071515-------------------------------------------------------------------------------
@@ -1552,6 +1560,79 @@ instance (ToJSON a) => ToJSON (DList.DList a) where
15521560 toEncoding = toEncoding1
15531561 {-# INLINE toEncoding #-}
15541562
1563+-------------------------------------------------------------------------------
1564+-- transformers - Functors
1565+-------------------------------------------------------------------------------
1566+
1567+instance ToJSON1 Identity where
1568+ liftToJSON t _ (Identity a) = t a
1569+ {-# INLINE liftToJSON #-}
1570+
1571+ liftToJSONList _ tl xs = tl (map runIdentity xs)
1572+ {-# INLINE liftToJSONList #-}
1573+
1574+ liftToEncoding t _ (Identity a) = t a
1575+ {-# INLINE liftToEncoding #-}
1576+
1577+ liftToEncodingList _ tl xs = tl (map runIdentity xs)
1578+ {-# INLINE liftToEncodingList #-}
1579+
1580+instance (ToJSON a) => ToJSON (Identity a) where
1581+ toJSON = toJSON1
1582+ {-# INLINE toJSON #-}
1583+
1584+ toJSONList = liftToJSONList toJSON toJSONList
1585+ {-# INLINE toJSONList #-}
1586+
1587+ toEncoding = toEncoding1
1588+ {-# INLINE toEncoding #-}
1589+
1590+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1591+ {-# INLINE toEncodingList #-}
1592+
1593+instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1594+ toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1595+ toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1596+
1597+
1598+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
1599+ liftToJSON tv tvl (Compose x) = liftToJSON g gl x
1600+ where
1601+ g = liftToJSON tv tvl
1602+ gl = liftToJSONList tv tvl
1603+ {-# INLINE liftToJSON #-}
1604+
1605+ liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)
1606+ where
1607+ g = liftToJSON te tel
1608+ gl = liftToJSONList te tel
1609+ {-# INLINE liftToJSONList #-}
1610+
1611+ liftToEncoding te tel (Compose x) = liftToEncoding g gl x
1612+ where
1613+ g = liftToEncoding te tel
1614+ gl = liftToEncodingList te tel
1615+ {-# INLINE liftToEncoding #-}
1616+
1617+ liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)
1618+ where
1619+ g = liftToEncoding te tel
1620+ gl = liftToEncodingList te tel
1621+ {-# INLINE liftToEncodingList #-}
1622+
1623+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
1624+ toJSON = toJSON1
1625+ {-# INLINE toJSON #-}
1626+
1627+ toJSONList = liftToJSONList toJSON toJSONList
1628+ {-# INLINE toJSONList #-}
1629+
1630+ toEncoding = toEncoding1
1631+ {-# INLINE toEncoding #-}
1632+
1633+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1634+ {-# INLINE toEncodingList #-}
1635+
15551636-------------------------------------------------------------------------------
15561637-- containers
15571638-------------------------------------------------------------------------------
@@ -1617,14 +1698,14 @@ instance ToJSON a => ToJSON (IntMap.IntMap a) where
16171698
16181699instance ToJSONKey k => ToJSON1 (M.Map k) where
16191700 liftToJSON g _ = case toJSONKey of
1620− ToJSONKeyText (f,_) -> Object . mapHashKeyVal f g
1621− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . M.toList
1701+ ToJSONKeyText f _ -> Object . mapHashKeyVal f g
1702+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
16221703 {-# INLINE liftToJSON #-}
16231704
16241705 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
16251706 liftToEncoding g _ = case toJSONKey of
1626− ToJSONKeyText (_,f) -> dict f g M.foldrWithKey
1627− ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . M.toList
1707+ ToJSONKeyText _ f -> dict f g M.foldrWithKey
1708+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
16281709 where
16291710 -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
16301711 pairEncoding f (a, b) = tuple $ f a >*< g b
@@ -1736,14 +1817,14 @@ instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
17361817
17371818instance ToJSONKey k => ToJSON1 (H.HashMap k) where
17381819 liftToJSON g _ = case toJSONKey of
1739− ToJSONKeyText (f,_) -> Object . mapKeyVal f g
1740− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList
1820+ ToJSONKeyText f _ -> Object . mapKeyVal f g
1821+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList
17411822 {-# INLINE liftToJSON #-}
17421823
17431824 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
17441825 liftToEncoding g _ = case toJSONKey of
1745− ToJSONKeyText (_,f) -> dict f g H.foldrWithKey
1746− ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . H.toList
1826+ ToJSONKeyText _ f -> dict f g H.foldrWithKey
1827+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
17471828 where
17481829 -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
17491830 pairEncoding f (a, b) = tuple $ f a >*< g b
@@ -1823,13 +1904,12 @@ instance ToJSONKey UTCTime where
18231904 toJSONKey = toJSONKeyTextEnc E.utcTime
18241905
18251906-- | Encode something t a JSON string.
1826−stringEncoding :: Encoding -> Value
1907+stringEncoding :: Encoding' Text -> Value
18271908stringEncoding = String
18281909 . T.dropAround (== '"')
18291910 . T.decodeLatin1
18301911 . L.toStrict
1831− . B.toLazyByteString
1832− . fromEncoding
1912+ . E.encodingToLazyByteString
18331913{-# INLINE stringEncoding #-}
18341914
18351915instance ToJSON NominalDiffTime where
@@ -1922,29 +2002,17 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where
19222002-- Instances for converting t map keys
19232003-------------------------------------------------------------------------------
19242004
1925−-- | TODO: Move ToJSONKEyFunction to .Types(.Internal),
1926−-- export and document this function from there
1927−toJSONKeyTextEnc :: (a -> Encoding) -> ToJSONKeyFunction a
1928−toJSONKeyTextEnc e = ToJSONKeyText
1929− -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
1930− ( T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . B.toLazyByteString . fromEncoding . e
1931− , e
1932− )
1933−
19342005instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
19352006instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
19362007instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
19372008
19382009instance ToJSONKey Char where
1939− toJSONKey = ToJSONKeyText (T.singleton, toEncoding)
1940− toJSONKeyList = ToJSONKeyText (T.pack, toEncoding . T.pack)
2010+ toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
2011+ toJSONKeyList = toJSONKeyText T.pack
19412012
19422013instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
19432014 toJSONKey = toJSONKeyList
19442015
1945−instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1946− toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1947−
19482016-------------------------------------------------------------------------------
19492017-- Tuple instances, see tuple-instances-to.hs
19502018-------------------------------------------------------------------------------
aeson.cabal+15−8
@@ -63,18 +63,23 @@ library
6363
6464 exposed-modules:
6565 Data.Aeson
66− Data.Aeson.Encode
6766 Data.Aeson.Encoding
68− Data.Aeson.Encoding.Internal
69− Data.Aeson.Internal
70− Data.Aeson.Internal.Time
7167 Data.Aeson.Parser
68+ Data.Aeson.Text
7269 Data.Aeson.Types
7370 Data.Aeson.TH
7471
72+ Data.Aeson.Encoding.Internal
73+ Data.Aeson.Internal
74+ Data.Aeson.Internal.Time
75+
76+ -- Deprecated modules
77+ exposed-modules:
78+ Data.Aeson.Encode
79+
7580 other-modules:
76− Data.Aeson.Encode.Builder
77− Data.Aeson.Functions
81+ Data.Aeson.Encoding.Builder
82+ Data.Aeson.Internal.Functions
7883 Data.Aeson.Parser.Internal
7984 Data.Aeson.Parser.Time
8085 Data.Aeson.Types.FromJSON
@@ -155,7 +160,7 @@ test-suite tests
155160 dlist,
156161 generic-deriving >= 1.10 && < 1.11,
157162 ghc-prim >= 0.2,
158− hashable >= 1.1.2.0,
163+ hashable >= 1.2.4.0,
159164 tagged,
160165 template-haskell,
161166 test-framework,
@@ -169,7 +174,9 @@ test-suite tests
169174 quickcheck-instances >=0.3.12
170175
171176 if !impl(ghc >= 8.0)
172− build-depends: semigroups >= 0.16.1 && < 0.19
177+ build-depends:
178+ semigroups >= 0.16.1 && < 0.19,
179+ transformers >= 0.2.2.0
173180
174181 if !impl(ghc >= 7.10)
175182 build-depends: nats >=1 && <1.2
benchmarks/CompareWithJSON.hs+1−1
@@ -4,8 +4,8 @@ import Blaze.ByteString.Builder (toLazyByteString)
44import Blaze.ByteString.Builder.Char.Utf8 (fromString)
55import Control.DeepSeq (NFData(rnf))
66import Criterion.Main
7−import qualified Data.Aeson.Encode as A
87import qualified Data.Aeson as A
8+import qualified Data.Aeson.Text as A
99import qualified Data.ByteString.Lazy as BL
1010import qualified Text.JSON as J
1111import qualified Data.Text.Lazy as TL
benchmarks/Micro.hs+1−1
@@ -1,7 +1,7 @@
11module Main (main) where
22
33import Criterion.Main
4−import qualified Data.Aeson.Encode.Builder as AB
4+import qualified Data.Aeson.Encoding.Builder as AB
55import qualified Data.ByteString.Builder as B
66import qualified Data.Text as T
77
benchmarks/aeson-benchmarks.cabal+7−6
@@ -9,17 +9,18 @@ library
99
1010 exposed-modules:
1111 Data.Aeson
12− Data.Aeson.Encode
1312 Data.Aeson.Encoding
14− Data.Aeson.Encoding.Internal
15− Data.Aeson.Internal
16− Data.Aeson.Internal.Time
1713 Data.Aeson.Parser
14+ Data.Aeson.Text
1815 Data.Aeson.Types
1916 Data.Aeson.TH
2017
21− Data.Aeson.Encode.Builder
22− Data.Aeson.Functions
18+ Data.Aeson.Encoding.Internal
19+ Data.Aeson.Internal
20+ Data.Aeson.Internal.Time
21+
22+ Data.Aeson.Encoding.Builder
23+ Data.Aeson.Internal.Functions
2324 Data.Aeson.Parser.Internal
2425 Data.Aeson.Parser.Time
2526 Data.Aeson.Types.FromJSON
include/overlapping-compat.h−7
@@ -1,15 +1,8 @@
11#if __GLASGOW_HASKELL__ >= 710
22#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
33#define OVERLAPPING_ {-# OVERLAPPING #-}
4−#ifdef NEEDS_INCOHERENT
5−#define INCOHERENT_ {-# INCOHERENT #-}
6−#endif
74#else
85{-# LANGUAGE OverlappingInstances #-}
96#define OVERLAPPABLE_
107#define OVERLAPPING_
11−#ifdef NEEDS_INCOHERENT
12−{-# LANGUAGE IncoherentInstances #-}
13−#define INCOHERENT_
14−#endif
158#endif
tests/Instances.hs+24−1
@@ -1,5 +1,6 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE OverloadedStrings #-}
45{-# LANGUAGE RecordWildCards #-}
56{-# LANGUAGE StandaloneDeriving #-}
@@ -23,8 +24,11 @@ import Data.Aeson.Types
2324import Control.Applicative (Const(..), empty)
2425import Data.Tagged (Tagged(..))
2526import Data.Proxy (Proxy(..))
27+import Data.Functor.Identity (Identity (..))
28+import Data.Functor.Compose (Compose (..))
2629import Functions
2730import qualified Data.DList as DList
31+import qualified Data.HashMap.Strict as HM
2832
2933import Data.Orphans ()
3034import Test.QuickCheck.Instances ()
@@ -57,8 +61,20 @@ instance ApproxEq UTCTime where
5761instance ApproxEq DotNetTime where
5862 (=~) = (=~) `on` fromDotNetTime
5963
64+instance ApproxEq Float where
65+ a =~ b
66+ | isNaN a && isNaN b = True
67+ | otherwise = approxEq a b
68+
6069instance ApproxEq Double where
61− (=~) = approxEq
70+ a =~ b
71+ | isNaN a && isNaN b = True
72+ | otherwise = approxEq a b
73+
74+instance (ApproxEq k, Eq v) => ApproxEq (HM.HashMap k v) where
75+ a =~ b = and $ zipWith eq (HM.toList a) (HM.toList b)
76+ where
77+ eq (x,y) (u,v) = x =~ u && y == v
6278
6379-- Test-related types.
6480
@@ -180,3 +196,10 @@ instance Arbitrary a => Arbitrary (Const a b) where
180196
181197instance Arbitrary a => Arbitrary (DList.DList a) where
182198 arbitrary = DList.fromList <$> arbitrary
199+
200+-- would like to have -- https://github.com/nick8325/quickcheck/issues/73
201+instance Arbitrary a => Arbitrary (Identity a) where
202+ arbitrary = Identity <$> arbitrary
203+
204+instance Arbitrary (f (g a)) => Arbitrary (Compose f g a) where
205+ arbitrary = Compose <$> arbitrary
tests/Properties.hs+45−2
@@ -1,13 +1,15 @@
11{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables #-}
22
3+-- For Arbitrary Compose
4+{-# LANGUAGE FlexibleContexts #-}
5+
36module Properties where
47
58import Prelude ()
69import Prelude.Compat
710
811import Control.Applicative (Const)
9−import Data.Aeson (eitherDecode)
10−import Data.Aeson.Encode (encode)
12+import Data.Aeson (eitherDecode, encode)
1113import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)
1214import Data.Aeson.Parser (value)
1315import Data.Aeson.Types
@@ -17,6 +19,7 @@ import Data.Sequence (Seq)
1719import Data.DList (DList)
1820import Data.Hashable (Hashable)
1921import Data.HashMap.Strict (HashMap)
22+import Data.Functor.Compose (Compose (..))
2023import Data.Map (Map)
2124import Data.Ratio (Ratio)
2225import Data.List.NonEmpty (NonEmpty)
@@ -37,6 +40,7 @@ import qualified Data.ByteString.Lazy.Char8 as L
3740import qualified Data.HashMap.Strict as H
3841import qualified Data.Map as Map
3942import qualified Data.Text as T
43+import qualified Data.Text.Lazy as LT
4044import qualified Data.Vector as V
4145
4246encodeDouble :: Double -> Double -> Property
@@ -137,6 +141,7 @@ isObjectWithSingleField _ = False
137141
138142--------------------------------------------------------------------------------
139143
144+
140145tests :: Test
141146tests = testGroup "properties" [
142147 testGroup "encode" [
@@ -151,6 +156,7 @@ tests = testGroup "properties" [
151156 , testProperty "Integer" $ roundTripEq (1 :: Integer)
152157 , testProperty "String" $ roundTripEq ("" :: String)
153158 , testProperty "Text" $ roundTripEq T.empty
159+ , testProperty "Lazy Text" $ roundTripEq LT.empty
154160 , testProperty "Foo" $ roundTripEq (undefined :: Foo)
155161 , testProperty "Day" $ roundTripEq (undefined :: Day)
156162 , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)
@@ -168,6 +174,41 @@ tests = testGroup "properties" [
168174 , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)
169175 , testProperty "Rational" $ roundTripEq (undefined :: Rational)
170176 , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)
177+ , testGroup "functors"
178+ [ testProperty "Identity Char" $ roundTripEq (undefined :: I Int)
179+
180+ , testProperty "Identity Char" $ roundTripEq (undefined :: I Char)
181+ , testProperty "Identity [Char]" $ roundTripEq (undefined :: I [Char])
182+ , testProperty "[Identity Char]" $ roundTripEq (undefined :: [I Char])
183+
184+ , testProperty "Compose I I Int" $ roundTripEq (undefined :: Compose I I Int)
185+ , testProperty "Compose [] I Int" $ roundTripEq (undefined :: Compose [] I Int)
186+ , testProperty "Compose I [] Int" $ roundTripEq (undefined :: Compose I [] Int)
187+ , testProperty "Compose [] [] Int" $ roundTripEq (undefined :: Compose [] [] Int)
188+
189+ , testProperty "Compose I I Char" $ roundTripEq (undefined :: Compose I I Char)
190+ , testProperty "Compose [] I Char" $ roundTripEq (undefined :: Compose [] I Char)
191+ , testProperty "Compose I [] Char" $ roundTripEq (undefined :: Compose I [] Char)
192+ , testProperty "Compose [] [] Char" $ roundTripEq (undefined :: Compose [] [] Char)
193+
194+ , testProperty "Compose3 I I I Char" $ roundTripEq (undefined :: Compose3 I I I Char)
195+ , testProperty "Compose3 I [] I Char" $ roundTripEq (undefined :: Compose3 I [] I Char)
196+ , testProperty "Compose3 I I [] Char" $ roundTripEq (undefined :: Compose3 I I [] Char)
197+ , testProperty "Compose3 I [] [] Char" $ roundTripEq (undefined :: Compose3 I [] [] Char)
198+ , testProperty "Compose3 [] I I Char" $ roundTripEq (undefined :: Compose3 [] I I Char)
199+ , testProperty "Compose3 [] [] I Char" $ roundTripEq (undefined :: Compose3 [] [] I Char)
200+ , testProperty "Compose3 [] I [] Char" $ roundTripEq (undefined :: Compose3 [] I [] Char)
201+ , testProperty "Compose3 [] [] [] Char" $ roundTripEq (undefined :: Compose3 [] [] [] Char)
202+
203+ , testProperty "Compose3' I I I Char" $ roundTripEq (undefined :: Compose3' I I I Char)
204+ , testProperty "Compose3' I [] I Char" $ roundTripEq (undefined :: Compose3' I [] I Char)
205+ , testProperty "Compose3' I I [] Char" $ roundTripEq (undefined :: Compose3' I I [] Char)
206+ , testProperty "Compose3' I [] [] Char" $ roundTripEq (undefined :: Compose3' I [] [] Char)
207+ , testProperty "Compose3' [] I I Char" $ roundTripEq (undefined :: Compose3' [] I I Char)
208+ , testProperty "Compose3' [] [] I Char" $ roundTripEq (undefined :: Compose3' [] [] I Char)
209+ , testProperty "Compose3' [] I [] Char" $ roundTripEq (undefined :: Compose3' [] I [] Char)
210+ , testProperty "Compose3' [] [] [] Char" $ roundTripEq (undefined :: Compose3' [] [] [] Char)
211+ ]
171212 , testGroup "ghcGenerics" [
172213 testProperty "OneConstructor" $ roundTripEq OneConstructor
173214 , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)
@@ -192,6 +233,8 @@ tests = testGroup "properties" [
192233 , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)
193234 , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)
194235#endif
236+ , testProperty "Version" $ roundTripKey (undefined :: Version)
237+ , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)
195238 ]
196239 , testGroup "toFromJSON" [
197240 testProperty "Integer" (toFromJSON :: Integer -> Property)
tests/Types.hs+6
@@ -12,6 +12,12 @@ import Data.Data
1212import Data.Text
1313import GHC.Generics
1414import Test.QuickCheck (Property, counterexample)
15+import Data.Functor.Compose (Compose (..))
16+import Data.Functor.Identity (Identity (..))
17+
18+type I = Identity
19+type Compose3 f g h = Compose (Compose f g) h
20+type Compose3' f g h = Compose f (Compose g h)
1521
1622data Foo = Foo {
1723 fooInt :: Int
tests/UnitTests.hs+95−24
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, DeriveGeneric, OverloadedStrings, ScopedTypeVariables, TemplateHaskell, GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE CPP, GADTs, DeriveGeneric, OverloadedStrings, ScopedTypeVariables, TemplateHaskell, GeneralizedNewtypeDeriving #-}
22#if __GLASGOW_HASKELL__ >= 708
33{-# LANGUAGE DataKinds #-}
44#endif
@@ -10,16 +10,21 @@ module UnitTests (ioTests, tests) where
1010import Prelude ()
1111import Prelude.Compat
1212
13+import Types (I, Compose3, Compose3', Approx(..))
14+import Instances ()
15+
1316import Control.Applicative (Const(..))
1417import Control.Monad (forM)
1518import Data.Aeson (FromJSONKeyFunction(..), FromJSONKey(..), decode, eitherDecode, encode, genericToJSON, genericToEncoding, object, FromJSON(..), withObject, (.=), (.:), (.:?), (.:!))
16−import Data.Aeson.Encode (encodeToTextBuilder)
19+import Data.Aeson.Text (encodeToTextBuilder)
1720import Data.Aeson.Internal (JSONPathElement(..), formatError)
1821import Data.Aeson.TH (deriveJSON)
1922import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)
2023import Data.Char (toUpper)
2124import Data.Hashable (hash)
2225import Data.List.NonEmpty (NonEmpty(..))
26+import Data.Functor.Compose (Compose (..))
27+import Data.Functor.Identity (Identity (..))
2328import Data.Maybe (fromMaybe)
2429import Data.Proxy (Proxy(..))
2530import Data.Sequence (Seq)
@@ -42,6 +47,7 @@ import qualified Data.Text.Lazy.Encoding as LT
4247import qualified Data.Sequence as Seq
4348import qualified Data.DList as DList
4449import qualified Data.HashMap.Strict as HM
50+import qualified Data.Map as M
4551
4652tests :: Test
4753tests = testGroup "unit" [
@@ -70,6 +76,7 @@ tests = testGroup "unit" [
7076 , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
7177 , testGroup "To JSON representation" $ fmap (testCase "-") jsonEncoding
7278 , testGroup "From JSON representation" $ fmap (testCase "-") jsonDecoding
79+ , testGroup "To/From JSON representation" $ fmap assertJsonExample jsonExamples
7380 , testGroup "JSONPath" $ fmap (testCase "-") jsonPath
7481 , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws
7582 , testGroup "Issue #351" $ fmap (testCase "-") issue351
@@ -234,31 +241,96 @@ dotColonMark = [
234241-----------------------------------------------------------------------------
235242
236243jsonEncoding :: [Assertion]
237−jsonEncoding = [
238− assertEqual "Either Left" "{\"Left\":1}" $ encode (Left 1 :: Either Int Int)
239− , assertEqual "Either Right" "{\"Right\":1}" $ encode (Right 1 :: Either Int Int)
240− , assertEqual "Nothing" "null" $ encode (Nothing :: Maybe Int)
241− , assertEqual "Just" "1" $ encode (Just 1 :: Maybe Int)
242− , assertEqual "Just Nothing" "null" $ encode (Just Nothing :: Maybe (Maybe Int))
243− , assertEqual "Proxy Int" "null" $ encode (Proxy :: Proxy Int)
244− , assertEqual "Tagged Char Int" "1" $ encode (Tagged 1 :: Tagged Char Int)
244+jsonEncoding =
245+ [
246+ -- https://github.com/bos/aeson/issues/376
247+ assertEqual "Just Nothing" "null" $ encode (Just Nothing :: Maybe (Maybe Int))
248+ -- infinities cannot be recovered, null is decoded as NaN
249+ , assertEqual "inf :: Double" "null" $ encode (Approx $ 1/0 :: Approx Double)
250+ ]
251+
252+data Example where
253+ Example
254+ :: (Eq a, Show a, ToJSON a, FromJSON a)
255+ => String -> L.ByteString -> a -> Example
256+
257+assertJsonExample :: Example -> Test
258+assertJsonExample (Example name bs val) = testCase name $ do
259+ assertEqual "encode" bs (encode val)
260+ assertEqual "decode" (Just val) (decode bs)
261+
262+jsonExamples :: [Example]
263+jsonExamples =
264+ [
265+ Example "Either Left" "{\"Left\":1}" (Left 1 :: Either Int Int)
266+ , Example "Either Right" "{\"Right\":1}" (Right 1 :: Either Int Int)
267+ , Example "Nothing" "null" (Nothing :: Maybe Int)
268+ , Example "Just" "1" (Just 1 :: Maybe Int)
269+ , Example "Proxy Int" "null" (Proxy :: Proxy Int)
270+ , Example "Tagged Char Int" "1" (Tagged 1 :: Tagged Char Int)
245271#if __GLASGOW_HASKELL__ >= 708
246272 -- Test Tagged instance is polykinded
247− , assertEqual "Tagged 123 Int" "1" $ encode (Tagged 1 :: Tagged 123 Int)
273+ , Example "Tagged 123 Int" "1" (Tagged 1 :: Tagged 123 Int)
248274#endif
249− , assertEqual "Const Char Int" "\"c\"" $ encode (Const 'c' :: Const Char Int)
250− , assertEqual "Tuple" "[1,2]" $ encode ((1, 2) :: (Int, Int))
251− , assertEqual "NonEmpty" "[1,2,3]" $ encode (1 :| [2, 3] :: NonEmpty Int)
252− , assertEqual "Seq" "[1,2,3]" $ encode (Seq.fromList [1, 2, 3] :: Seq.Seq Int)
253− , assertEqual "DList" "[1,2,3]" $ encode (DList.fromList [1, 2, 3] :: DList.DList Int)
254− , assertEqual "()" "[]" $ encode ()
255− , assertEqual "HashMap Int Int" "{\"0\":1,\"2\":3}" $ encode (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)
256− , assertEqual "nan :: Double" "null" $ encode (0/0 :: Double)
257− , assertEqual "inf :: Double" "null" $ encode (1/0 :: Double)
275+ , Example "Const Char Int" "\"c\"" (Const 'c' :: Const Char Int)
276+ , Example "Tuple" "[1,2]" ((1, 2) :: (Int, Int))
277+ , Example "NonEmpty" "[1,2,3]" (1 :| [2, 3] :: NonEmpty Int)
278+ , Example "Seq" "[1,2,3]" (Seq.fromList [1, 2, 3] :: Seq.Seq Int)
279+ , Example "DList" "[1,2,3]" (DList.fromList [1, 2, 3] :: DList.DList Int)
280+ , Example "()" "[]" ()
281+
282+ , Example "HashMap Int Int" "{\"0\":1,\"2\":3}" (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)
283+ , Example "Map Int Int" "{\"0\":1,\"2\":3}" (M.fromList [(0,1),(2,3)] :: M.Map Int Int)
284+ , Example "Map (Tagged Int Int) Int" "{\"0\":1,\"2\":3}" (M.fromList [(Tagged 0,1),(Tagged 2,3)] :: M.Map (Tagged Int Int) Int)
285+ , Example "Map [Int] Int" "[[[0],1],[[2],3]]" (M.fromList [([0],1),([2],3)] :: M.Map [Int] Int)
286+ , Example "Map [Char] Int" "{\"ab\":1,\"cd\":3}" (M.fromList [("ab",1),("cd",3)] :: M.Map [Char] Int)
287+ , Example "Map [I Char] Int" "{\"ab\":1,\"cd\":3}" (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)
288+
289+ , Example "nan :: Double" "null" (Approx $ 0/0 :: Approx Double)
290+
258291 -- Three separate cases, as ordering in HashMap is not defined
259− , assertEqual "HashMap Float Int, NaN" "{\"NaN\":1}" $ encode (HM.singleton (0/0) 1 :: HM.HashMap Float Int)
260− , assertEqual "HashMap Float Int, Infinity" "{\"Infinity\":1}" $ encode (HM.singleton (1/0) 1 :: HM.HashMap Float Int)
261− , assertEqual "HashMap Float Int, +Infinity" "{\"-Infinity\":1}" $ encode (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)
292+ , Example "HashMap Float Int, NaN" "{\"NaN\":1}" (Approx $ HM.singleton (0/0) 1 :: Approx (HM.HashMap Float Int))
293+ , Example "HashMap Float Int, Infinity" "{\"Infinity\":1}" (HM.singleton (1/0) 1 :: HM.HashMap Float Int)
294+ , Example "HashMap Float Int, +Infinity" "{\"-Infinity\":1}" (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)
295+
296+ -- Functors
297+ , Example "Identity Int" "1" (pure 1 :: Identity Int)
298+
299+ , Example "Identity Char" "\"x\"" (pure 'x' :: Identity Char)
300+ , Example "Identity String" "\"foo\"" (pure "foo" :: Identity String)
301+ , Example "[Identity Char]" "\"xy\"" ([pure 'x', pure 'y'] :: [Identity Char])
302+
303+ , Example "Maybe Char" "\"x\"" (pure 'x' :: Maybe Char)
304+ , Example "Maybe String" "\"foo\"" (pure "foo" :: Maybe String)
305+ , Example "Maybe [Identity Char]" "\"xy\"" (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])
306+
307+ , Example "Compose I I Int" "1" (pure 1 :: Compose I I Int)
308+ , Example "Compose I [] Int" "[1]" (pure 1 :: Compose I [] Int)
309+ , Example "Compose [] I Int" "[1]" (pure 1 :: Compose [] I Int)
310+ , Example "Compose [] [] Int" "[[1]]" (pure 1 :: Compose [] [] Int)
311+
312+ , Example "Compose I I Char" "\"x\"" (pure 'x' :: Compose I I Char)
313+ , Example "Compose I [] Char" "\"x\"" (pure 'x' :: Compose I [] Char)
314+ , Example "Compose [] I Char" "\"x\"" (pure 'x' :: Compose [] I Char)
315+ , Example "Compose [] [] Char" "[\"x\"]" (pure 'x' :: Compose [] [] Char)
316+
317+ , Example "Compose3 I I I Char" "\"x\"" (pure 'x' :: Compose3 I I I Char)
318+ , Example "Compose3 I I [] Char" "\"x\"" (pure 'x' :: Compose3 I I [] Char)
319+ , Example "Compose3 I [] I Char" "\"x\"" (pure 'x' :: Compose3 I [] I Char)
320+ , Example "Compose3 I [] [] Char" "[\"x\"]" (pure 'x' :: Compose3 I [] [] Char)
321+ , Example "Compose3 [] I I Char" "\"x\"" (pure 'x' :: Compose3 [] I I Char)
322+ , Example "Compose3 [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3 [] I [] Char)
323+ , Example "Compose3 [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3 [] [] I Char)
324+ , Example "Compose3 [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3 [] [] [] Char)
325+
326+ , Example "Compose3' I I I Char" "\"x\"" (pure 'x' :: Compose3' I I I Char)
327+ , Example "Compose3' I I [] Char" "\"x\"" (pure 'x' :: Compose3' I I [] Char)
328+ , Example "Compose3' I [] I Char" "\"x\"" (pure 'x' :: Compose3' I [] I Char)
329+ , Example "Compose3' I [] [] Char" "[\"x\"]" (pure 'x' :: Compose3' I [] [] Char)
330+ , Example "Compose3' [] I I Char" "\"x\"" (pure 'x' :: Compose3' [] I I Char)
331+ , Example "Compose3' [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3' [] I [] Char)
332+ , Example "Compose3' [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3' [] [] I Char)
333+ , Example "Compose3' [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3' [] [] [] Char)
262334 ]
263335
264336jsonDecoding :: [Assertion]
@@ -322,7 +394,6 @@ fromJSONKeyAssertions =
322394 , assertIsCoerce "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text))
323395 , assertIsCoerce "MyText" (fromJSONKey :: FromJSONKeyFunction MyText)
324396
325−-- Why this doesn't work on older GHC?
326397#if __GLASGOW_HASKELL__ >= 710
327398 , assertIsCoerce' "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText')
328399#endif