git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #407 from phadej/high-kind-strings
722b577Adam Bergmark
Data/Aeson.hs+11
compare with master
unifiedsplit
@@ -62,6 +62,17 @@ module Data.Aeson
62 , ToJSONKeyFunction(..)
62 , ToJSONKeyFunction(..)
63 , FromJSONKey(..)
63 , FromJSONKey(..)
64 , FromJSONKeyFunction(..)
64 , FromJSONKeyFunction(..)
65+ -- ** Liftings to unary and binary type constructors
66+ , FromJSON1(..)
67+ , parseJSON1
68+ , FromJSON2(..)
69+ , parseJSON2
70+ , ToJSON1(..)
71+ , toJSON1
72+ , toEncoding1
73+ , ToJSON2(..)
74+ , toJSON2
75+ , toEncoding2
65 -- ** Generic JSON classes and options
76 -- ** Generic JSON classes and options
66 , GFromJSON(..)
77 , GFromJSON(..)
67 , GToJSON(..)
78 , GToJSON(..)
Data/Aeson/Encode/Functions.hs+38−26
@@ -4,12 +4,12 @@ module Data.Aeson.Encode.Functions
4 (
4 (
5 brackets
5 brackets
6 , builder
6 , builder
7+ , builder'
7 , char7
8 , char7
8 , encode
9 , encode
9− , foldable
10 , list
10 , list
11− , list'
11+ , encodeMap
12− , pairs
12+ , encodeWithKey
13 ) where
13 ) where
14
14
15import Data.Aeson.Encode.Builder
15import Data.Aeson.Encode.Builder
@@ -17,6 +17,7 @@ import Data.Aeson.Types.Class
17import Data.Aeson.Types.Internal
17import Data.Aeson.Types.Internal
18import Data.ByteString.Builder (Builder, char7)
18import Data.ByteString.Builder (Builder, char7)
19import Data.ByteString.Builder.Prim (primBounded)
19import Data.ByteString.Builder.Prim (primBounded)
20+import Data.Foldable (toList)
20import Data.Monoid ((<>))
21import Data.Monoid ((<>))
21import qualified Data.ByteString.Builder as B
22import qualified Data.ByteString.Builder as B
22import qualified Data.ByteString.Lazy as L
23import qualified Data.ByteString.Lazy as L
@@ -26,10 +27,17 @@ import Data.Foldable (Foldable, foldMap)
26import Data.Monoid (mempty)
27import Data.Monoid (mempty)
27#endif
28#endif
28
29
30+list :: (a -> Encoding) -> [a] -> Encoding
31+list = listEncoding
32+
29builder :: ToJSON a => a -> Builder
33builder :: ToJSON a => a -> Builder
30builder = fromEncoding . toEncoding
34builder = fromEncoding . toEncoding
31{-# INLINE builder #-}
35{-# INLINE builder #-}
32
36
37+builder' :: (a -> Encoding) -> a -> Builder
38+builder' f = fromEncoding . f
39+{-# INLINE builder' #-}
40+
33-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
41-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
34--
42--
35-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.
43-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.
@@ -37,31 +45,35 @@ encode :: ToJSON a => a -> L.ByteString
37encode = B.toLazyByteString . builder
45encode = B.toLazyByteString . builder
38{-# INLINE encode #-}
46{-# INLINE encode #-}
39
47
40−-- | Encode a 'Foldable' as a JSON array.
41−foldable :: (Foldable t, ToJSON a) => t a -> Encoding
42−foldable = brackets '[' ']' . foldMap (Value . toEncoding)
43−{-# INLINE foldable #-}
44−
45−list :: (ToJSON a) => [a] -> Encoding
46−list [] = emptyArray_
47−list (x:xs) = Encoding $
48− char7 '[' <> builder x <> commas xs <> char7 ']'
49− where commas = foldr (\v vs -> char7 ',' <> builder v <> vs) mempty
50−{-# INLINE list #-}
51−
52−list' :: (a -> Encoding) -> [a] -> Encoding
53−list' _ [] = emptyArray_
54−list' e (x:xs) = Encoding $
55− char7 '[' <> fromEncoding (e x) <> commas xs <> char7 ']'
56− where commas = foldr (\v vs -> char7 ',' <> fromEncoding (e v) <> vs) mempty
57−{-# INLINE list' #-}
58−
59brackets :: Char -> Char -> Series -> Encoding
48brackets :: Char -> Char -> Series -> Encoding
60brackets begin end (Value v) = Encoding $
49brackets begin end (Value v) = Encoding $
61 char7 begin <> fromEncoding v <> char7 end
50 char7 begin <> fromEncoding v <> char7 end
62brackets begin end Empty = Encoding (primBounded (ascii2 (begin,end)) ())
51brackets begin end Empty = Encoding (primBounded (ascii2 (begin,end)) ())
63
52
64−-- | Encode a series of key/value pairs, separated by commas.
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)
65−pairs :: Series -> Encoding
72+ -> m -> Encoding
66−pairs s = brackets '{' '}' s
73+encodeWithKey encodeKey encodeVal foldrWithKey = brackets '{' '}' . foldrWithKey go mempty
74+ where go k v c = Value (Encoding $ encodeKV encodeKey encodeVal k v) <> c
67−{-# INLINE pairs #-}
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/Types.hs+29−1
@@ -45,6 +45,18 @@ module Data.Aeson.Types
45 , fromJSONKeyCoerce
45 , fromJSONKeyCoerce
46 , coerceFromJSONKeyFunction
46 , coerceFromJSONKeyFunction
47
47
48+ -- ** Liftings to unary and binary type constructors
49+ , FromJSON1(..)
50+ , parseJSON1
51+ , FromJSON2(..)
52+ , parseJSON2
53+ , ToJSON1(..)
54+ , toJSON1
55+ , toEncoding1
56+ , ToJSON2(..)
57+ , toJSON2
58+ , toEncoding2
59+
48 -- ** Generic JSON classes
60 -- ** Generic JSON classes
49 , GFromJSON(..)
61 , GFromJSON(..)
50 , GToJSON(..)
62 , GToJSON(..)
@@ -69,6 +81,10 @@ module Data.Aeson.Types
69 , (.!=)
81 , (.!=)
70 , object
82 , object
71
83
84+ , listEncoding
85+ , listValue
86+ , listParser
87+
72 -- * Generic and TH encoding configuration
88 -- * Generic and TH encoding configuration
73 , Options(..)
89 , Options(..)
74 , SumEncoding(..)
90 , SumEncoding(..)
@@ -78,7 +94,19 @@ module Data.Aeson.Types
78 , defaultTaggedObject
94 , defaultTaggedObject
79 ) where
95 ) where
80
96
81−import Data.Aeson.Encode.Functions (foldable, pairs)
82import Data.Aeson.Types.Generic ()
97import Data.Aeson.Types.Generic ()
83import Data.Aeson.Types.Instances
98import Data.Aeson.Types.Instances
84import Data.Aeson.Types.Internal
99import Data.Aeson.Types.Internal
100+
101+import Data.Foldable (Foldable, toList)
102+import Data.Aeson.Encode.Functions (brackets)
103+
104+-- | Encode a 'Foldable' as a JSON array.
105+foldable :: (Foldable t, ToJSON a) => t a -> Encoding
106+foldable = toEncoding . toList
107+{-# INLINE foldable #-}
108+
109+-- | Encode a series of key/value pairs, separated by commas.
110+pairs :: Series -> Encoding
111+pairs = brackets '{' '}'
112+{-# INLINE pairs #-}
Data/Aeson/Types/Class.hs+213−1
@@ -17,6 +17,17 @@ module Data.Aeson.Types.Class
17 -- * Core JSON classes
17 -- * Core JSON classes
18 FromJSON(..)
18 FromJSON(..)
19 , ToJSON(..)
19 , ToJSON(..)
20+ -- * Liftings to unary and binary type constructors
21+ , FromJSON1(..)
22+ , parseJSON1
23+ , FromJSON2(..)
24+ , parseJSON2
25+ , ToJSON1(..)
26+ , toJSON1
27+ , toEncoding1
28+ , ToJSON2(..)
29+ , toJSON2
30+ , toEncoding2
20 -- * Generic JSON classes
31 -- * Generic JSON classes
21 , GFromJSON(..)
32 , GFromJSON(..)
22 , GToJSON(..)
33 , GToJSON(..)
@@ -25,25 +36,37 @@ module Data.Aeson.Types.Class
25 , genericToEncoding
36 , genericToEncoding
26 , genericParseJSON
37 , genericParseJSON
27 -- * Classes and types for map keys
38 -- * Classes and types for map keys
39+ , ToJSONKey(..)
28 , ToJSONKeyFunction(..)
40 , ToJSONKeyFunction(..)
41+ , contramapToJSONKeyFunction
42+ , FromJSONKey(..)
29 , FromJSONKeyFunction(..)
43 , FromJSONKeyFunction(..)
30 , fromJSONKeyCoerce
44 , fromJSONKeyCoerce
31 , coerceFromJSONKeyFunction
45 , coerceFromJSONKeyFunction
46+ , mapFromJSONKeyFunction
32 -- * Object key-value pairs
47 -- * Object key-value pairs
33 , KeyValue(..)
48 , KeyValue(..)
34 -- * Functions needed for documentation
49 -- * Functions needed for documentation
35 , typeMismatch
50 , typeMismatch
51+ -- * Encoding functions
52+ , listEncoding
53+ , listValue
54+ , listParser
36 ) where
55 ) where
37
56
38import Data.Aeson.Types.Internal
57import Data.Aeson.Types.Internal
58+import Data.Monoid ((<>))
39import Data.Text (Text)
59import Data.Text (Text)
40import GHC.Generics (Generic, Rep, from, to)
60import GHC.Generics (Generic, Rep, from, to)
41−import Data.Monoid ((<>))
42import Data.Aeson.Encode.Builder (emptyArray_)
61import Data.Aeson.Encode.Builder (emptyArray_)
43import qualified Data.ByteString.Builder as B
62import qualified Data.ByteString.Builder as B
44import qualified Data.Aeson.Encode.Builder as E
63import qualified Data.Aeson.Encode.Builder as E
45import qualified Data.Vector as V
64import qualified Data.Vector as V
46
65
66+#if !MIN_VERSION_base(4,8,0)
67+import Data.Monoid (mempty)
68+#endif
69+
47-- Coercible derivations aren't as powerful on GHC 7.8, though supported.
70-- Coercible derivations aren't as powerful on GHC 7.8, though supported.
48#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 709)
71#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 709)
49
72
@@ -188,6 +211,19 @@ class ToJSON a where
188 toEncoding = Encoding . E.encodeToBuilder . toJSON
211 toEncoding = Encoding . E.encodeToBuilder . toJSON
189 {-# INLINE toEncoding #-}
212 {-# INLINE toEncoding #-}
190
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+
191-- | A type that can be converted from JSON, with the possibility of
227-- | A type that can be converted from JSON, with the possibility of
192-- failure.
228-- failure.
193--
229--
@@ -268,11 +304,47 @@ class FromJSON a where
268 default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
304 default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
269 parseJSON = genericParseJSON defaultOptions
305 parseJSON = genericParseJSON defaultOptions
270
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+
271-- | A key-value pair for encoding a JSON object.
323-- | A key-value pair for encoding a JSON object.
272class KeyValue kv where
324class KeyValue kv where
273 (.=) :: ToJSON v => Text -> v -> kv
325 (.=) :: ToJSON v => Text -> v -> kv
274 infixr 8 .=
326 infixr 8 .=
275
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+
276data ToJSONKeyFunction a
348data ToJSONKeyFunction a
277 = ToJSONKeyText (a -> Text, a -> Encoding)
349 = ToJSONKeyText (a -> Text, a -> Encoding)
278 | ToJSONKeyValue (a -> Value, a -> Encoding)
350 | ToJSONKeyValue (a -> Value, a -> Encoding)
@@ -333,6 +405,18 @@ coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fma
333 #-}
405 #-}
334#endif
406#endif
335
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+
336-- | Fail parsing due to a type mismatch, with a descriptive message.
420-- | Fail parsing due to a type mismatch, with a descriptive message.
337--
421--
338-- Example usage:
422-- Example usage:
@@ -355,3 +439,131 @@ typeMismatch expected actual =
355 Number _ -> "Number"
439 Number _ -> "Number"
356 Bool _ -> "Boolean"
440 Bool _ -> "Boolean"
357 Null -> "Null"
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 #-}
562+
563+instance FromJSON1 [] where
564+ liftParseJSON _ p' = p'
565+ {-# INLINE liftParseJSON #-}
566+
567+instance (FromJSON a) => FromJSON [a] where
568+ parseJSON = parseJSON1
569+ {-# INLINE parseJSON #-}
Data/Aeson/Types/Instances.hs+538−942
@@ -9,9 +9,6 @@
9{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE PolyKinds #-}
10#endif
10#endif
11
11
12−#define NEEDS_INCOHERENT
13−#include "overlapping-compat.h"
14−
15{-# OPTIONS_GHC -fno-warn-orphans #-}
12{-# OPTIONS_GHC -fno-warn-orphans #-}
16
13
17-- TODO: Drop this when we remove support for Data.Attoparsec.Number
14-- TODO: Drop this when we remove support for Data.Attoparsec.Number
@@ -38,10 +35,23 @@ module Data.Aeson.Types.Instances
38 -- ** Keys for maps
35 -- ** Keys for maps
39 , ToJSONKey(..)
36 , ToJSONKey(..)
40 , ToJSONKeyFunction(..)
37 , ToJSONKeyFunction(..)
38+ , contramapToJSONKeyFunction
41 , FromJSONKey(..)
39 , FromJSONKey(..)
42 , FromJSONKeyFunction(..)
40 , FromJSONKeyFunction(..)
43 , fromJSONKeyCoerce
41 , fromJSONKeyCoerce
44 , coerceFromJSONKeyFunction
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
45 -- ** Generic JSON classes
55 -- ** Generic JSON classes
46 , GFromJSON(..)
56 , GFromJSON(..)
47 , GToJSON(..)
57 , GToJSON(..)
@@ -71,10 +81,16 @@ module Data.Aeson.Types.Instances
71 , tuple
81 , tuple
72 , (>*<)
82 , (>*<)
73 , typeMismatch
83 , typeMismatch
84+
85+ , listEncoding
86+ , listValue
87+ , listParser
74 ) where
88 ) where
75
89
90+import Data.Aeson.Types.Instances.Tuple (tuple, (>*<))
91+
76import Control.Applicative (Const(..))
92import Control.Applicative (Const(..))
77−import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, list, list')
93+import Data.Aeson.Encode.Functions (builder, builder', encode, list, encodeWithKey, encodeMap)
78import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)
94import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)
79import Data.Aeson.Types.Class
95import Data.Aeson.Types.Class
80import Data.Aeson.Types.Internal
96import Data.Aeson.Types.Internal
@@ -92,7 +108,7 @@ import Data.Proxy (Proxy(..))
92import Data.Ratio (Ratio, (%), numerator, denominator)
108import Data.Ratio (Ratio, (%), numerator, denominator)
93import Data.Scientific (Scientific)
109import Data.Scientific (Scientific)
94import Data.Tagged (Tagged(..))
110import Data.Tagged (Tagged(..))
95−import Data.Text (Text, pack, unpack)
111+import Data.Text (Text, unpack)
96import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,
112import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,
97 ZonedTime)
113 ZonedTime)
98import Data.Time.Format (FormatTime, formatTime, parseTime)
114import Data.Time.Format (FormatTime, formatTime, parseTime)
@@ -112,6 +128,7 @@ import qualified Data.HashMap.Strict as H
112import qualified Data.HashSet as HashSet
128import qualified Data.HashSet as HashSet
113import qualified Data.IntMap as IntMap
129import qualified Data.IntMap as IntMap
114import qualified Data.IntSet as IntSet
130import qualified Data.IntSet as IntSet
131+import qualified Data.List.NonEmpty as NE
115import qualified Data.Map as M
132import qualified Data.Map as M
116import qualified Data.Scientific as Scientific
133import qualified Data.Scientific as Scientific
117import qualified Data.Sequence as Seq
134import qualified Data.Sequence as Seq
@@ -125,10 +142,10 @@ import qualified Data.Text.Lazy.Builder.Int as LTBI
125import qualified Data.Tree as Tree
142import qualified Data.Tree as Tree
126import qualified Data.Vector as V
143import qualified Data.Vector as V
127import qualified Data.Vector.Generic as VG
144import qualified Data.Vector.Generic as VG
128−import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)
129import qualified Data.Vector.Primitive as VP
145import qualified Data.Vector.Primitive as VP
130import qualified Data.Vector.Storable as VS
146import qualified Data.Vector.Storable as VS
131import qualified Data.Vector.Unboxed as VU
147import qualified Data.Vector.Unboxed as VU
148+import qualified Data.Vector.Mutable as VM
132
149
133import Unsafe.Coerce (unsafeCoerce)
150import Unsafe.Coerce (unsafeCoerce)
134
151
@@ -145,77 +162,209 @@ import Data.Time.Format (defaultTimeLocale)
145import System.Locale (defaultTimeLocale)
162import System.Locale (defaultTimeLocale)
146#endif
163#endif
147
164
165+-------------------------------------------------------------------------------
166+-- Helpers
167+-------------------------------------------------------------------------------
168+
148−parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a
169+parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
149−parseIndexedJSON idx value = parseJSON value <?> Index idx
170+parseIndexedJSON p idx value = p value <?> Index idx
171+{-# INLINE parseIndexedJSON #-}
150
172
151−parseIndexedJSONPair :: FromJSON b => (Value -> Parser a) -> Int -> Value -> Parser (a, b)
173+parseIndexedJSONPair :: (Value -> Parser a) -> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
152−parseIndexedJSONPair keyParser idx value = p value <?> Index idx
174+parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx
153 where
175 where
154 p = withArray "(k,v)" $ \ab ->
176 p = withArray "(k,v)" $ \ab ->
155 let n = V.length ab
177 let n = V.length ab
156 in if n == 2
178 in if n == 2
157− then (,) <$> parseJSONElemAtIndex' keyParser 0 ab
179+ then (,) <$> parseJSONElemAtIndex keyParser 0 ab
158− <*> parseJSONElemAtIndex 1 ab
180+ <*> parseJSONElemAtIndex valParser 1 ab
159 else fail $ "cannot unpack array of length " ++
181 else fail $ "cannot unpack array of length " ++
160 show n ++ " into a pair"
182 show n ++ " into a pair"
161
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+
162−toJSONPair :: ToJSON b => (a -> Value) -> (a, b) -> Value
188+toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
163−toJSONPair keySerialiser (a, b) = Array $ V.create $ do
189+toJSONPair keySerialiser valSerializer (a, b) = Array $ V.create $ do
164 mv <- VM.unsafeNew 2
190 mv <- VM.unsafeNew 2
165 VM.unsafeWrite mv 0 (keySerialiser a)
191 VM.unsafeWrite mv 0 (keySerialiser a)
166− VM.unsafeWrite mv 1 (toJSON b)
192+ VM.unsafeWrite mv 1 (valSerializer b)
167 return mv
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 #-}
168
237
169instance (ToJSON a) => ToJSON (Identity a) where
238instance (ToJSON a) => ToJSON (Identity a) where
170− toJSON (Identity a) = toJSON a
239+ toJSON = toJSON1
171 {-# INLINE toJSON #-}
240 {-# INLINE toJSON #-}
172
241
173− toEncoding (Identity a) = toEncoding a
242+ toEncoding = toEncoding1
174 {-# INLINE toEncoding #-}
243 {-# INLINE toEncoding #-}
175
244
245+instance FromJSON1 Identity where
246+ liftParseJSON p _ a = Identity <$> p a
247+ {-# INLINE liftParseJSON #-}
248+
176instance (FromJSON a) => FromJSON (Identity a) where
249instance (FromJSON a) => FromJSON (Identity a) where
177− parseJSON a = Identity <$> parseJSON a
250+ parseJSON = parseJSON1
178 {-# INLINE parseJSON #-}
251 {-# INLINE parseJSON #-}
179
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+
180instance (ToJSON a) => ToJSON (Maybe a) where
297instance (ToJSON a) => ToJSON (Maybe a) where
181− toJSON (Just a) = toJSON a
298+ toJSON = toJSON1
182− toJSON Nothing = Null
183 {-# INLINE toJSON #-}
299 {-# INLINE toJSON #-}
184
300
185− toEncoding (Just a) = toEncoding a
301+ toEncoding = toEncoding1
186− toEncoding Nothing = Encoding E.null_
187 {-# INLINE toEncoding #-}
302 {-# INLINE toEncoding #-}
188
303
304+instance FromJSON1 Maybe where
305+ liftParseJSON _ _ Null = pure Nothing
306+ liftParseJSON p _ a = Just <$> p a
307+ {-# INLINE liftParseJSON #-}
308+
189instance (FromJSON a) => FromJSON (Maybe a) where
309instance (FromJSON a) => FromJSON (Maybe a) where
190− parseJSON Null = pure Nothing
310+ parseJSON = parseJSON1
191− parseJSON a = Just <$> parseJSON a
192 {-# INLINE parseJSON #-}
311 {-# INLINE parseJSON #-}
193
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+
194instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
337instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
195− toJSON (Left a) = object [left .= a]
338+ toJSON = toJSON2
196− toJSON (Right b) = object [right .= b]
197 {-# INLINE toJSON #-}
339 {-# INLINE toJSON #-}
198
340
199− toEncoding (Left a) = Encoding $
341+ toEncoding = toEncoding2
200− B.shortByteString "{\"Left\":" <> builder a <> B.char7 '}'
201− toEncoding (Right a) = Encoding $
202− B.shortByteString "{\"Right\":" <> builder a <> B.char7 '}'
203 {-# INLINE toEncoding #-}
342 {-# INLINE toEncoding #-}
204
343
205−instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where
344+instance FromJSON2 Either where
206− parseJSON (Object (H.toList -> [(key, value)]))
345+ liftParseJSON2 pA _ pB _ (Object (H.toList -> [(key, value)]))
207− | key == left = Left <$> parseJSON value <?> Key left
346+ | key == left = Left <$> pA value <?> Key left
208− | key == right = Right <$> parseJSON value <?> Key right
347+ | key == right = Right <$> pB value <?> Key right
209− parseJSON _ = fail $
348+
349+ liftParseJSON2 _ _ _ _ _ = fail $
210 "expected an object with a single property " ++
350 "expected an object with a single property " ++
211 "where the property key should be either " ++
351 "where the property key should be either " ++
212 "\"Left\" or \"Right\""
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
213 {-# INLINE parseJSON #-}
361 {-# INLINE parseJSON #-}
214
362
215left, right :: Text
363left, right :: Text
216left = "Left"
364left = "Left"
217right = "Right"
365right = "Right"
218
366
367+
219instance ToJSON Bool where
368instance ToJSON Bool where
220 toJSON = Bool
369 toJSON = Bool
221 {-# INLINE toJSON #-}
370 {-# INLINE toJSON #-}
@@ -259,24 +408,19 @@ instance FromJSON () where
259 else fail "Expected an empty array"
408 else fail "Expected an empty array"
260 {-# INLINE parseJSON #-}
409 {-# INLINE parseJSON #-}
261
410
262−instance INCOHERENT_ ToJSON [Char] where
263− toJSON = String . T.pack
264− {-# INLINE toJSON #-}
265−
266− toEncoding = Encoding . E.string
267− {-# INLINE toEncoding #-}
268−
269−instance INCOHERENT_ FromJSON [Char] where
270− parseJSON = withText "String" $ pure . T.unpack
271− {-# INLINE parseJSON #-}
272−
273instance ToJSON Char where
411instance ToJSON Char where
274 toJSON = String . T.singleton
412 toJSON = String . T.singleton
275 {-# INLINE toJSON #-}
413 {-# INLINE toJSON #-}
276
414
415+ toJSONList = String . T.pack
416+ {-# INLINE toJSONList #-}
417+
277 toEncoding = Encoding . E.string . (:[])
418 toEncoding = Encoding . E.string . (:[])
278 {-# INLINE toEncoding #-}
419 {-# INLINE toEncoding #-}
279
420
421+ toEncodingList = Encoding . E.string
422+ {-# INLINE toEncodingList #-}
423+
280instance FromJSON Char where
424instance FromJSON Char where
281 parseJSON = withText "Char" $ \t ->
425 parseJSON = withText "Char" $ \t ->
282 if T.compareLength t 1 == EQ
426 if T.compareLength t 1 == EQ
@@ -284,16 +428,8 @@ instance FromJSON Char where
284 else fail "Expected a string of length 1"
428 else fail "Expected a string of length 1"
285 {-# INLINE parseJSON #-}
429 {-# INLINE parseJSON #-}
286
430
287−instance ToJSON Scientific where
431+ parseJSONList = withText "String" $ pure . T.unpack
288− toJSON = Number
432+ {-# INLINE parseJSONList #-}
289− {-# INLINE toJSON #-}
290−
291− toEncoding = Encoding . E.number
292− {-# INLINE toEncoding #-}
293−
294−instance FromJSON Scientific where
295− parseJSON = withScientific "Scientific" pure
296− {-# INLINE parseJSON #-}
297
433
298instance ToJSON Double where
434instance ToJSON Double where
299 toJSON = realFloatToJSON
435 toJSON = realFloatToJSON
@@ -527,45 +663,253 @@ instance FromJSON LT.Text where
527 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
663 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
528 {-# INLINE parseJSON #-}
664 {-# INLINE parseJSON #-}
529
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+
530instance (ToJSON a) => ToJSON (NonEmpty a) where
692instance (ToJSON a) => ToJSON (NonEmpty a) where
531− toJSON = toJSON . toList
693+ toJSON = toJSON1
532 {-# INLINE toJSON #-}
694 {-# INLINE toJSON #-}
533
695
534− toEncoding = toEncoding . toList
696+ toEncoding = toEncoding1
535 {-# INLINE toEncoding #-}
697 {-# INLINE toEncoding #-}
536
698
537−instance (FromJSON a) => FromJSON (NonEmpty a) where
699+instance FromJSON1 NonEmpty where
538− parseJSON = withArray "NonEmpty a" $
700+ liftParseJSON p _ = withArray "NonEmpty a" $
539− (>>= ne) . Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList
701+ (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
540 where
702 where
541 ne [] = fail "Expected a NonEmpty but got an empty list"
703 ne [] = fail "Expected a NonEmpty but got an empty list"
542 ne (x:xs) = pure (x :| xs)
704 ne (x:xs) = pure (x :| xs)
705+ {-# INLINE liftParseJSON #-}
543
706
544−instance OVERLAPPABLE_ (ToJSON a) => ToJSON [a] where
707+instance (FromJSON a) => FromJSON (NonEmpty a) where
545− toJSON = Array . V.fromList . map toJSON
708+ parseJSON = parseJSON1
709+ {-# INLINE parseJSON #-}
710+
711+-------------------------------------------------------------------------------
712+-- scientific
713+-------------------------------------------------------------------------------
714+
715+instance ToJSON Scientific where
716+ toJSON = Number
546 {-# INLINE toJSON #-}
717 {-# INLINE toJSON #-}
547
718
548− toEncoding xs = list xs
719+ toEncoding = Encoding . E.number
549 {-# INLINE toEncoding #-}
720 {-# INLINE toEncoding #-}
550
721
551−instance OVERLAPPABLE_ (FromJSON a) => FromJSON [a] where
722+instance FromJSON Scientific where
552− parseJSON = withArray "[a]" $ Tr.sequence .
723+ parseJSON = withScientific "Scientific" pure
553− zipWith parseIndexedJSON [0..] . V.toList
554 {-# INLINE parseJSON #-}
724 {-# INLINE parseJSON #-}
555
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+
556instance (ToJSON a) => ToJSON (Seq.Seq a) where
737instance (ToJSON a) => ToJSON (Seq.Seq a) where
557− toJSON = toJSON . toList
738+ toJSON = toJSON1
558 {-# INLINE toJSON #-}
739 {-# INLINE toJSON #-}
559
740
560− toEncoding = foldable
741+ toEncoding = toEncoding1
561 {-# INLINE toEncoding #-}
742 {-# INLINE toEncoding #-}
562
743
563−instance (FromJSON a) => FromJSON (Seq.Seq a) where
744+instance FromJSON1 Seq.Seq where
564− parseJSON = withArray "Seq a" $
745+ liftParseJSON p _ = withArray "Seq a" $
565 fmap Seq.fromList .
746 fmap Seq.fromList .
566− Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList
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
567 {-# INLINE parseJSON #-}
855 {-# INLINE parseJSON #-}
568
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+
569instance (ToJSON a) => ToJSON (Vector a) where
913instance (ToJSON a) => ToJSON (Vector a) where
570 toJSON = Array . V.map toJSON
914 toJSON = Array . V.map toJSON
571 {-# INLINE toJSON #-}
915 {-# INLINE toJSON #-}
@@ -582,9 +926,13 @@ encodeVector xs
582 where go v b = B.char7 ',' <> builder v <> b
926 where go v b = B.char7 ',' <> builder v <> b
583{-# INLINE encodeVector #-}
927{-# INLINE encodeVector #-}
584
928
929+instance FromJSON1 Vector where
930+ liftParseJSON p _ = withArray "Vector a" $
931+ V.mapM (uncurry $ parseIndexedJSON p) . V.indexed
932+ {-# INLINE liftParseJSON #-}
933+
585instance (FromJSON a) => FromJSON (Vector a) where
934instance (FromJSON a) => FromJSON (Vector a) where
586− parseJSON = withArray "Vector a" $ V.mapM (uncurry parseIndexedJSON) .
935+ parseJSON = parseJSON1
587− V.indexed
588 {-# INLINE parseJSON #-}
936 {-# INLINE parseJSON #-}
589
937
590vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
938vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
@@ -592,7 +940,7 @@ vectorToJSON = Array . V.map toJSON . V.convert
592{-# INLINE vectorToJSON #-}
940{-# INLINE vectorToJSON #-}
593
941
594vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
942vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
595−vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry parseIndexedJSON) . V.indexed
943+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry $ parseIndexedJSON parseJSON) . V.indexed
596{-# INLINE vectorParseJSON #-}
944{-# INLINE vectorParseJSON #-}
597
945
598instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
946instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
@@ -627,154 +975,74 @@ instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where
627 parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"
975 parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"
628 {-# INLINE parseJSON #-}
976 {-# INLINE parseJSON #-}
629
977
630−instance (ToJSON a) => ToJSON (Set.Set a) where
978+-------------------------------------------------------------------------------
631− toJSON = toJSON . Set.toList
979+-- unordered-containers
632− {-# INLINE toJSON #-}
980+-------------------------------------------------------------------------------
633
981
634− toEncoding = encodeSet Set.minView Set.foldr
982+instance ToJSON1 HashSet.HashSet where
635− {-# INLINE toEncoding #-}
983+ liftToJSON to _ = listValue to . HashSet.toList
984+ {-# INLINE liftToJSON #-}
636
985
637−instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where
986+ liftToEncoding to _ = listEncoding to . HashSet.toList
638− parseJSON = fmap Set.fromList . parseJSON
987+ {-# INLINE liftToEncoding #-}
639− {-# INLINE parseJSON #-}
640
988
641instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
989instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
642− toJSON = toJSON . HashSet.toList
990+ toJSON = toJSON1
643 {-# INLINE toJSON #-}
991 {-# INLINE toJSON #-}
644
992
645− toEncoding = foldable
993+ toEncoding = toEncoding1
646 {-# INLINE toEncoding #-}
994 {-# INLINE toEncoding #-}
647
995
648instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where
996instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where
649 parseJSON = fmap HashSet.fromList . parseJSON
997 parseJSON = fmap HashSet.fromList . parseJSON
650 {-# INLINE parseJSON #-}
998 {-# INLINE parseJSON #-}
651
999
652−instance ToJSON IntSet.IntSet where
653− toJSON = toJSON . IntSet.toList
654− {-# INLINE toJSON #-}
655−
656− toEncoding = encodeSet IntSet.minView IntSet.foldr
657− {-# INLINE toEncoding #-}
658−
659−encodeSet :: (ToJSON a) =>
660− (s -> Maybe (a, s))
661− -> ((a -> B.Builder -> B.Builder) -> B.Builder -> s -> B.Builder)
662− -> s -> Encoding
663−encodeSet minView foldr xs =
664− case minView xs of
665− Nothing -> E.emptyArray_
666− Just (m,ys) -> Encoding $
667− B.char7 '[' <> builder m <> foldr go (B.char7 ']') ys
668− where go v b = B.char7 ',' <> builder v <> b
669−{-# INLINE encodeSet #-}
670−
671−instance FromJSON IntSet.IntSet where
672− parseJSON = fmap IntSet.fromList . parseJSON
673− {-# INLINE parseJSON #-}
674−
675−instance ToJSON a => ToJSON (IntMap.IntMap a) where
676− toJSON = toJSON . IntMap.toList
677− {-# INLINE toJSON #-}
678−
679− toEncoding = toEncoding . IntMap.toList
680− {-# INLINE toEncoding #-}
681
1000
682−instance FromJSON a => FromJSON (IntMap.IntMap a) where
1001+instance ToJSONKey k => ToJSON1 (H.HashMap k) where
683− parseJSON = fmap IntMap.fromList . parseJSON
684− {-# INLINE parseJSON #-}
685−
686−encodeMap :: (ToJSON v)
687− => (k -> Encoding)
688− -> (m -> Maybe ((k,v), m))
689− -> ((k -> v -> B.Builder -> B.Builder) -> B.Builder -> m -> B.Builder)
690− -> m -> Encoding
691−encodeMap encodeKey minViewWithKey foldrWithKey xs =
692− case minViewWithKey xs of
693− Nothing -> E.emptyObject_
694− Just ((k,v),ys) -> Encoding $
695− B.char7 '{' <> encodeKV encodeKey k v <>
696− foldrWithKey go (B.char7 '}') ys
697− where go k v b = B.char7 ',' <> encodeKV encodeKey k v <> b
698−{-# INLINE encodeMap #-}
699−
700−encodeWithKey :: (ToJSON v)
701− => (k -> Encoding)
702− -> ((k -> v -> Series -> Series) -> Series -> m -> Series)
703− -> m -> Encoding
704−encodeWithKey encodeKey foldrWithKey = brackets '{' '}' . foldrWithKey go mempty
705− where go k v c = Value (Encoding $ encodeKV encodeKey k v) <> c
706−{-# INLINE encodeWithKey #-}
707−
708−encodeKV :: (ToJSON v) => (k -> Encoding) -> k -> v -> B.Builder
709−encodeKV encodeKey k v = fromEncoding (encodeKey k) <> B.char7 ':' <> builder v
710−{-# INLINE encodeKV #-}
711−
712−instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where
713− toJSON = case toJSONKey of
1002+ liftToJSON g _ = case toJSONKey of
714− ToJSONKeyText (f,_) -> Object . mapHashKeyVal f toJSON
1003+ ToJSONKeyText (f,_) -> Object . mapKeyVal f g
715− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f) . M.toList
1004+ ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList
716− {-# INLINE toJSON #-}
1005+ {-# INLINE liftToJSON #-}
717−
718− toEncoding = case toJSONKey of
719− ToJSONKeyText (_,f) -> encodeMap f M.minViewWithKey M.foldrWithKey
720− ToJSONKeyValue (_,f) -> list' (pairEncoding f) . M.toList
721− where pairEncoding :: (k -> Encoding) -> (k, v) -> Encoding
722− pairEncoding f (a, b) = tuple $ fromEncoding (f a) >*< builder b
723− {-# INLINE toEncoding #-}
724
1006
725−instance (FromJSON v, FromJSONKey k, Ord k) => FromJSON (M.Map k v) where
1007+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
726− parseJSON = case fromJSONKey of
1008+ liftToEncoding g _ = case toJSONKey of
727− FromJSONKeyCoerce _-> withObject "Map k v" $
1009+ ToJSONKeyText (_,f) -> encodeWithKey f g H.foldrWithKey
728− fmap (H.foldrWithKey (M.insert . unsafeCoerce) M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
1010+ ToJSONKeyValue (_,f) -> list (pairEncoding f) . H.toList
729− FromJSONKeyText f -> withObject "Map k v" $
1011+ where
730− fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
1012+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
731− FromJSONKeyTextParser f -> withObject "Map k v" $
1013+ pairEncoding f (a, b) = tuple $ fromEncoding (f a) >*< builder' g b
732− H.foldrWithKey (\k v m -> M.insert <$> f k <*> (parseJSON v <?> Key k) <*> m) (pure M.empty)
1014+ {-# INLINE liftToEncoding #-}
733− FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
734− M.fromList <$> (Tr.sequence .
735− zipWith (parseIndexedJSONPair f) [0..] . V.toList $ arr)
736− {-# INLINE parseJSON #-}
737
1015
738instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1016instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
739− toJSON = case toJSONKey of
1017+ toJSON = toJSON1
740− ToJSONKeyText (f,_) -> Object . mapKeyVal f toJSON
741− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f) . H.toList
742 {-# INLINE toJSON #-}
1018 {-# INLINE toJSON #-}
743
1019
744− toEncoding = case toJSONKey of
1020+ toEncoding = toEncoding1
745− ToJSONKeyText (_,f) -> encodeWithKey f H.foldrWithKey
746− ToJSONKeyValue (_,f) -> list' (pairEncoding f) . H.toList
747− where pairEncoding :: (k -> Encoding) -> (k, v) -> Encoding
748− pairEncoding f (a, b) = tuple $ fromEncoding (f a) >*< builder b
749 {-# INLINE toEncoding #-}
1021 {-# INLINE toEncoding #-}
750
1022
751−instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where
1023+instance (FromJSONKey k, Eq k, Hashable k) => FromJSON1 (H.HashMap k) where
752− parseJSON = case fromJSONKey of
1024+ liftParseJSON p _ = case fromJSONKey of
753 FromJSONKeyCoerce _ -> withObject "HashMap ~Text v" $
1025 FromJSONKeyCoerce _ -> withObject "HashMap ~Text v" $
754− uc . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
1026+ uc . H.traverseWithKey (\k v -> p v <?> Key k)
755 FromJSONKeyText f -> withObject "HashMap k v" $
1027 FromJSONKeyText f -> withObject "HashMap k v" $
756− fmap (mapKey f) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
1028+ fmap (mapKey f) . H.traverseWithKey (\k v -> p v <?> Key k)
757 FromJSONKeyTextParser f -> withObject "HashMap k v" $
1029 FromJSONKeyTextParser f -> withObject "HashMap k v" $
758− H.foldrWithKey (\k v m -> H.insert <$> f k <*> (parseJSON v <?> Key k) <*> m) (pure H.empty)
1030+ H.foldrWithKey (\k v m -> H.insert <$> f k <*> (p v <?> Key k) <*> m) (pure H.empty)
759 FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
1031 FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
760 H.fromList <$> (Tr.sequence .
1032 H.fromList <$> (Tr.sequence .
761− zipWith (parseIndexedJSONPair f) [0..] . V.toList $ arr)
1033+ zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr)
762 where
1034 where
763 uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)
1035 uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)
764 uc = unsafeCoerce
1036 uc = unsafeCoerce
765− {-# INLINE parseJSON #-}
766−
767−instance (ToJSON v) => ToJSON (Tree.Tree v) where
768− toJSON (Tree.Node root branches) = toJSON (root,branches)
769− {-# INLINE toJSON #-}
770
1037
771− toEncoding (Tree.Node root branches) = toEncoding (root,branches)
772− {-# INLINE toEncoding #-}
773−
774−instance (FromJSON v) => FromJSON (Tree.Tree v) where
1038+instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where
775− parseJSON j = uncurry Tree.Node <$> parseJSON j
1039+ parseJSON = parseJSON1
776 {-# INLINE parseJSON #-}
1040 {-# INLINE parseJSON #-}
777
1041
1042+-------------------------------------------------------------------------------
1043+-- aeson
1044+-------------------------------------------------------------------------------
1045+
778instance ToJSON Value where
1046instance ToJSON Value where
779 toJSON a = a
1047 toJSON a = a
780 {-# INLINE toJSON #-}
1048 {-# INLINE toJSON #-}
@@ -783,7 +1051,7 @@ instance ToJSON Value where
783 {-# INLINE toEncoding #-}
1051 {-# INLINE toEncoding #-}
784
1052
785instance FromJSON Value where
1053instance FromJSON Value where
786− parseJSON a = pure a
1054+ parseJSON = pure
787 {-# INLINE parseJSON #-}
1055 {-# INLINE parseJSON #-}
788
1056
789instance ToJSON DotNetTime where
1057instance ToJSON DotNetTime where
@@ -804,6 +1072,10 @@ instance FromJSON DotNetTime where
804 _ -> fail "could not parse .NET time"
1072 _ -> fail "could not parse .NET time"
805 {-# INLINE parseJSON #-}
1073 {-# INLINE parseJSON #-}
806
1074
1075+-------------------------------------------------------------------------------
1076+-- time
1077+-------------------------------------------------------------------------------
1078+
807instance ToJSON Day where
1079instance ToJSON Day where
808 toJSON = stringEncoding
1080 toJSON = stringEncoding
809 toEncoding z = Encoding (E.quote $ E.day z)
1081 toEncoding z = Encoding (E.quote $ E.day z)
@@ -864,715 +1136,81 @@ instance FromJSON NominalDiffTime where
864 parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac
1136 parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac
865 {-# INLINE parseJSON #-}
1137 {-# INLINE parseJSON #-}
866
1138
867−parseJSONElemAtIndex :: FromJSON a => Int -> Vector Value -> Parser a
1139+-------------------------------------------------------------------------------
868−parseJSONElemAtIndex = parseJSONElemAtIndex' parseJSON
1140+-- base Monoid/Semigroup
869−
1141+-------------------------------------------------------------------------------
870−parseJSONElemAtIndex' :: (Value -> Parser a) -> Int -> Vector Value -> Parser a
871−parseJSONElemAtIndex' p idx ary = p (V.unsafeIndex ary idx) <?> Index idx
872−
873−tuple :: B.Builder -> Encoding
874−tuple b = Encoding (B.char7 '[' <> b <> B.char7 ']')
875−{-# INLINE tuple #-}
876−
877−(>*<) :: B.Builder -> B.Builder -> B.Builder
878−a >*< b = a <> B.char7 ',' <> b
879−{-# INLINE (>*<) #-}
880−infixr 6 >*<
881−
882−instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
883− toJSON (a,b) = Array $ V.create $ do
884− mv <- VM.unsafeNew 2
885− VM.unsafeWrite mv 0 (toJSON a)
886− VM.unsafeWrite mv 1 (toJSON b)
887− return mv
888− {-# INLINE toJSON #-}
889−
890− toEncoding (a,b) = tuple $
891− builder a >*< builder b
892− {-# INLINE toEncoding #-}
893−
894−instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
895− parseJSON = withArray "(a,b)" $ \ab ->
896− let n = V.length ab
897− in if n == 2
898− then (,) <$> parseJSONElemAtIndex 0 ab
899− <*> parseJSONElemAtIndex 1 ab
900− else fail $ "cannot unpack array of length " ++
901− show n ++ " into a pair"
902− {-# INLINE parseJSON #-}
903−
904−instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where
905− toJSON (a,b,c) = Array $ V.create $ do
906− mv <- VM.unsafeNew 3
907− VM.unsafeWrite mv 0 (toJSON a)
908− VM.unsafeWrite mv 1 (toJSON b)
909− VM.unsafeWrite mv 2 (toJSON c)
910− return mv
911− {-# INLINE toJSON #-}
912−
913− toEncoding (a,b,c) = tuple $
914− builder a >*<
915− builder b >*<
916− builder c
917− {-# INLINE toEncoding #-}
918−
919−instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
920− parseJSON = withArray "(a,b,c)" $ \abc ->
921− let n = V.length abc
922− in if n == 3
923− then (,,) <$> parseJSONElemAtIndex 0 abc
924− <*> parseJSONElemAtIndex 1 abc
925− <*> parseJSONElemAtIndex 2 abc
926− else fail $ "cannot unpack array of length " ++
927− show n ++ " into a 3-tuple"
928− {-# INLINE parseJSON #-}
929−
930−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where
931− toJSON (a,b,c,d) = Array $ V.create $ do
932− mv <- VM.unsafeNew 4
933− VM.unsafeWrite mv 0 (toJSON a)
934− VM.unsafeWrite mv 1 (toJSON b)
935− VM.unsafeWrite mv 2 (toJSON c)
936− VM.unsafeWrite mv 3 (toJSON d)
937− return mv
938− {-# INLINE toJSON #-}
939−
940− toEncoding (a,b,c,d) = tuple $
941− builder a >*<
942− builder b >*<
943− builder c >*<
944− builder d
945− {-# INLINE toEncoding #-}
946−
947−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>
948− FromJSON (a,b,c,d) where
949− parseJSON = withArray "(a,b,c,d)" $ \abcd ->
950− let n = V.length abcd
951− in if n == 4
952− then (,,,) <$> parseJSONElemAtIndex 0 abcd
953− <*> parseJSONElemAtIndex 1 abcd
954− <*> parseJSONElemAtIndex 2 abcd
955− <*> parseJSONElemAtIndex 3 abcd
956− else fail $ "cannot unpack array of length " ++
957− show n ++ " into a 4-tuple"
958− {-# INLINE parseJSON #-}
959−
960−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) =>
961− ToJSON (a,b,c,d,e) where
962− toJSON (a,b,c,d,e) = Array $ V.create $ do
963− mv <- VM.unsafeNew 5
964− VM.unsafeWrite mv 0 (toJSON a)
965− VM.unsafeWrite mv 1 (toJSON b)
966− VM.unsafeWrite mv 2 (toJSON c)
967− VM.unsafeWrite mv 3 (toJSON d)
968− VM.unsafeWrite mv 4 (toJSON e)
969− return mv
970− {-# INLINE toJSON #-}
971−
972− toEncoding (a,b,c,d,e) = tuple $
973− builder a >*<
974− builder b >*<
975− builder c >*<
976− builder d >*<
977− builder e
978− {-# INLINE toEncoding #-}
979−
980−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) =>
981− FromJSON (a,b,c,d,e) where
982− parseJSON = withArray "(a,b,c,d,e)" $ \abcde ->
983− let n = V.length abcde
984− in if n == 5
985− then (,,,,) <$> parseJSONElemAtIndex 0 abcde
986− <*> parseJSONElemAtIndex 1 abcde
987− <*> parseJSONElemAtIndex 2 abcde
988− <*> parseJSONElemAtIndex 3 abcde
989− <*> parseJSONElemAtIndex 4 abcde
990− else fail $ "cannot unpack array of length " ++
991− show n ++ " into a 5-tuple"
992− {-# INLINE parseJSON #-}
993−
994−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) =>
995− ToJSON (a,b,c,d,e,f) where
996− toJSON (a,b,c,d,e,f) = Array $ V.create $ do
997− mv <- VM.unsafeNew 6
998− VM.unsafeWrite mv 0 (toJSON a)
999− VM.unsafeWrite mv 1 (toJSON b)
1000− VM.unsafeWrite mv 2 (toJSON c)
1001− VM.unsafeWrite mv 3 (toJSON d)
1002− VM.unsafeWrite mv 4 (toJSON e)
1003− VM.unsafeWrite mv 5 (toJSON f)
1004− return mv
1005− {-# INLINE toJSON #-}
1006−
1007− toEncoding (a,b,c,d,e,f) = tuple $
1008− builder a >*<
1009− builder b >*<
1010− builder c >*<
1011− builder d >*<
1012− builder e >*<
1013− builder f
1014− {-# INLINE toEncoding #-}
1015−
1016−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1017− FromJSON f) => FromJSON (a,b,c,d,e,f) where
1018− parseJSON = withArray "(a,b,c,d,e,f)" $ \abcdef ->
1019− let n = V.length abcdef
1020− in if n == 6
1021− then (,,,,,) <$> parseJSONElemAtIndex 0 abcdef
1022− <*> parseJSONElemAtIndex 1 abcdef
1023− <*> parseJSONElemAtIndex 2 abcdef
1024− <*> parseJSONElemAtIndex 3 abcdef
1025− <*> parseJSONElemAtIndex 4 abcdef
1026− <*> parseJSONElemAtIndex 5 abcdef
1027− else fail $ "cannot unpack array of length " ++
1028− show n ++ " into a 6-tuple"
1029− {-# INLINE parseJSON #-}
1030−
1031−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1032− ToJSON g) => ToJSON (a,b,c,d,e,f,g) where
1033− toJSON (a,b,c,d,e,f,g) = Array $ V.create $ do
1034− mv <- VM.unsafeNew 7
1035− VM.unsafeWrite mv 0 (toJSON a)
1036− VM.unsafeWrite mv 1 (toJSON b)
1037− VM.unsafeWrite mv 2 (toJSON c)
1038− VM.unsafeWrite mv 3 (toJSON d)
1039− VM.unsafeWrite mv 4 (toJSON e)
1040− VM.unsafeWrite mv 5 (toJSON f)
1041− VM.unsafeWrite mv 6 (toJSON g)
1042− return mv
1043− {-# INLINE toJSON #-}
1044−
1045− toEncoding (a,b,c,d,e,f,g) = tuple $
1046− builder a >*<
1047− builder b >*<
1048− builder c >*<
1049− builder d >*<
1050− builder e >*<
1051− builder f >*<
1052− builder g
1053− {-# INLINE toEncoding #-}
1054−
1055−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1056− FromJSON f, FromJSON g) => FromJSON (a,b,c,d,e,f,g) where
1057− parseJSON = withArray "(a,b,c,d,e,f,g)" $ \abcdefg ->
1058− let n = V.length abcdefg
1059− in if n == 7
1060− then (,,,,,,) <$> parseJSONElemAtIndex 0 abcdefg
1061− <*> parseJSONElemAtIndex 1 abcdefg
1062− <*> parseJSONElemAtIndex 2 abcdefg
1063− <*> parseJSONElemAtIndex 3 abcdefg
1064− <*> parseJSONElemAtIndex 4 abcdefg
1065− <*> parseJSONElemAtIndex 5 abcdefg
1066− <*> parseJSONElemAtIndex 6 abcdefg
1067− else fail $ "cannot unpack array of length " ++
1068− show n ++ " into a 7-tuple"
1069− {-# INLINE parseJSON #-}
1070−
1071−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1072− ToJSON g, ToJSON h) => ToJSON (a,b,c,d,e,f,g,h) where
1073− toJSON (a,b,c,d,e,f,g,h) = Array $ V.create $ do
1074− mv <- VM.unsafeNew 8
1075− VM.unsafeWrite mv 0 (toJSON a)
1076− VM.unsafeWrite mv 1 (toJSON b)
1077− VM.unsafeWrite mv 2 (toJSON c)
1078− VM.unsafeWrite mv 3 (toJSON d)
1079− VM.unsafeWrite mv 4 (toJSON e)
1080− VM.unsafeWrite mv 5 (toJSON f)
1081− VM.unsafeWrite mv 6 (toJSON g)
1082− VM.unsafeWrite mv 7 (toJSON h)
1083− return mv
1084− {-# INLINE toJSON #-}
1085−
1086− toEncoding (a,b,c,d,e,f,g,h) = tuple $
1087− builder a >*<
1088− builder b >*<
1089− builder c >*<
1090− builder d >*<
1091− builder e >*<
1092− builder f >*<
1093− builder g >*<
1094− builder h
1095− {-# INLINE toEncoding #-}
1096−
1097−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1098− FromJSON f, FromJSON g, FromJSON h) =>
1099− FromJSON (a,b,c,d,e,f,g,h) where
1100− parseJSON = withArray "(a,b,c,d,e,f,g,h)" $ \ary ->
1101− let n = V.length ary
1102− in if n /= 8
1103− then fail $ "cannot unpack array of length " ++
1104− show n ++ " into an 8-tuple"
1105− else (,,,,,,,)
1106− <$> parseJSONElemAtIndex 0 ary
1107− <*> parseJSONElemAtIndex 1 ary
1108− <*> parseJSONElemAtIndex 2 ary
1109− <*> parseJSONElemAtIndex 3 ary
1110− <*> parseJSONElemAtIndex 4 ary
1111− <*> parseJSONElemAtIndex 5 ary
1112− <*> parseJSONElemAtIndex 6 ary
1113− <*> parseJSONElemAtIndex 7 ary
1114− {-# INLINE parseJSON #-}
1115−
1116−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1117− ToJSON g, ToJSON h, ToJSON i) => ToJSON (a,b,c,d,e,f,g,h,i) where
1118− toJSON (a,b,c,d,e,f,g,h,i) = Array $ V.create $ do
1119− mv <- VM.unsafeNew 9
1120− VM.unsafeWrite mv 0 (toJSON a)
1121− VM.unsafeWrite mv 1 (toJSON b)
1122− VM.unsafeWrite mv 2 (toJSON c)
1123− VM.unsafeWrite mv 3 (toJSON d)
1124− VM.unsafeWrite mv 4 (toJSON e)
1125− VM.unsafeWrite mv 5 (toJSON f)
1126− VM.unsafeWrite mv 6 (toJSON g)
1127− VM.unsafeWrite mv 7 (toJSON h)
1128− VM.unsafeWrite mv 8 (toJSON i)
1129− return mv
1130− {-# INLINE toJSON #-}
1131−
1132− toEncoding (a,b,c,d,e,f,g,h,i) = tuple $
1133− builder a >*<
1134− builder b >*<
1135− builder c >*<
1136− builder d >*<
1137− builder e >*<
1138− builder f >*<
1139− builder g >*<
1140− builder h >*<
1141− builder i
1142− {-# INLINE toEncoding #-}
1143−
1144−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1145− FromJSON f, FromJSON g, FromJSON h, FromJSON i) =>
1146− FromJSON (a,b,c,d,e,f,g,h,i) where
1147− parseJSON = withArray "(a,b,c,d,e,f,g,h,i)" $ \ary ->
1148− let n = V.length ary
1149− in if n /= 9
1150− then fail $ "cannot unpack array of length " ++
1151− show n ++ " into a 9-tuple"
1152− else (,,,,,,,,)
1153− <$> parseJSONElemAtIndex 0 ary
1154− <*> parseJSONElemAtIndex 1 ary
1155− <*> parseJSONElemAtIndex 2 ary
1156− <*> parseJSONElemAtIndex 3 ary
1157− <*> parseJSONElemAtIndex 4 ary
1158− <*> parseJSONElemAtIndex 5 ary
1159− <*> parseJSONElemAtIndex 6 ary
1160− <*> parseJSONElemAtIndex 7 ary
1161− <*> parseJSONElemAtIndex 8 ary
1162− {-# INLINE parseJSON #-}
1163−
1164−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1165− ToJSON g, ToJSON h, ToJSON i, ToJSON j) =>
1166− ToJSON (a,b,c,d,e,f,g,h,i,j) where
1167− toJSON (a,b,c,d,e,f,g,h,i,j) = Array $ V.create $ do
1168− mv <- VM.unsafeNew 10
1169− VM.unsafeWrite mv 0 (toJSON a)
1170− VM.unsafeWrite mv 1 (toJSON b)
1171− VM.unsafeWrite mv 2 (toJSON c)
1172− VM.unsafeWrite mv 3 (toJSON d)
1173− VM.unsafeWrite mv 4 (toJSON e)
1174− VM.unsafeWrite mv 5 (toJSON f)
1175− VM.unsafeWrite mv 6 (toJSON g)
1176− VM.unsafeWrite mv 7 (toJSON h)
1177− VM.unsafeWrite mv 8 (toJSON i)
1178− VM.unsafeWrite mv 9 (toJSON j)
1179− return mv
1180− {-# INLINE toJSON #-}
1181
1142
1182− toEncoding (a,b,c,d,e,f,g,h,i,j) = tuple $
1143+instance ToJSON1 Dual where
1183− builder a >*<
1144+ liftToJSON to _ = to . getDual
1184− builder b >*<
1145+ {-# INLINE liftToJSON #-}
1185− builder c >*<
1186− builder d >*<
1187− builder e >*<
1188− builder f >*<
1189− builder g >*<
1190− builder h >*<
1191− builder i >*<
1192− builder j
1193− {-# INLINE toEncoding #-}
1194
1146
1195−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1147+ liftToEncoding to _ = to . getDual
1196− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) =>
1148+ {-# INLINE liftToEncoding #-}
1197− FromJSON (a,b,c,d,e,f,g,h,i,j) where
1198− parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j)" $ \ary ->
1199− let n = V.length ary
1200− in if n /= 10
1201− then fail $ "cannot unpack array of length " ++
1202− show n ++ " into a 10-tuple"
1203− else (,,,,,,,,,)
1204− <$> parseJSONElemAtIndex 0 ary
1205− <*> parseJSONElemAtIndex 1 ary
1206− <*> parseJSONElemAtIndex 2 ary
1207− <*> parseJSONElemAtIndex 3 ary
1208− <*> parseJSONElemAtIndex 4 ary
1209− <*> parseJSONElemAtIndex 5 ary
1210− <*> parseJSONElemAtIndex 6 ary
1211− <*> parseJSONElemAtIndex 7 ary
1212− <*> parseJSONElemAtIndex 8 ary
1213− <*> parseJSONElemAtIndex 9 ary
1214− {-# INLINE parseJSON #-}
1215−
1216−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1217− ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) =>
1218− ToJSON (a,b,c,d,e,f,g,h,i,j,k) where
1219− toJSON (a,b,c,d,e,f,g,h,i,j,k) = Array $ V.create $ do
1220− mv <- VM.unsafeNew 11
1221− VM.unsafeWrite mv 0 (toJSON a)
1222− VM.unsafeWrite mv 1 (toJSON b)
1223− VM.unsafeWrite mv 2 (toJSON c)
1224− VM.unsafeWrite mv 3 (toJSON d)
1225− VM.unsafeWrite mv 4 (toJSON e)
1226− VM.unsafeWrite mv 5 (toJSON f)
1227− VM.unsafeWrite mv 6 (toJSON g)
1228− VM.unsafeWrite mv 7 (toJSON h)
1229− VM.unsafeWrite mv 8 (toJSON i)
1230− VM.unsafeWrite mv 9 (toJSON j)
1231− VM.unsafeWrite mv 10 (toJSON k)
1232− return mv
1233− {-# INLINE toJSON #-}
1234
1149
1235− toEncoding (a,b,c,d,e,f,g,h,i,j,k) = tuple $
1150+instance ToJSON a => ToJSON (Dual a) where
1236− builder a >*<
1151+ toJSON = toJSON1
1237− builder b >*<
1238− builder c >*<
1239− builder d >*<
1240− builder e >*<
1241− builder f >*<
1242− builder g >*<
1243− builder h >*<
1244− builder i >*<
1245− builder j >*<
1246− builder k
1247− {-# INLINE toEncoding #-}
1248−
1249−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1250− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1251− FromJSON k) =>
1252− FromJSON (a,b,c,d,e,f,g,h,i,j,k) where
1253− parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k)" $ \ary ->
1254− let n = V.length ary
1255− in if n /= 11
1256− then fail $ "cannot unpack array of length " ++
1257− show n ++ " into an 11-tuple"
1258− else (,,,,,,,,,,)
1259− <$> parseJSONElemAtIndex 0 ary
1260− <*> parseJSONElemAtIndex 1 ary
1261− <*> parseJSONElemAtIndex 2 ary
1262− <*> parseJSONElemAtIndex 3 ary
1263− <*> parseJSONElemAtIndex 4 ary
1264− <*> parseJSONElemAtIndex 5 ary
1265− <*> parseJSONElemAtIndex 6 ary
1266− <*> parseJSONElemAtIndex 7 ary
1267− <*> parseJSONElemAtIndex 8 ary
1268− <*> parseJSONElemAtIndex 9 ary
1269− <*> parseJSONElemAtIndex 10 ary
1270− {-# INLINE parseJSON #-}
1271−
1272−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1273− ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) =>
1274− ToJSON (a,b,c,d,e,f,g,h,i,j,k,l) where
1275− toJSON (a,b,c,d,e,f,g,h,i,j,k,l) = Array $ V.create $ do
1276− mv <- VM.unsafeNew 12
1277− VM.unsafeWrite mv 0 (toJSON a)
1278− VM.unsafeWrite mv 1 (toJSON b)
1279− VM.unsafeWrite mv 2 (toJSON c)
1280− VM.unsafeWrite mv 3 (toJSON d)
1281− VM.unsafeWrite mv 4 (toJSON e)
1282− VM.unsafeWrite mv 5 (toJSON f)
1283− VM.unsafeWrite mv 6 (toJSON g)
1284− VM.unsafeWrite mv 7 (toJSON h)
1285− VM.unsafeWrite mv 8 (toJSON i)
1286− VM.unsafeWrite mv 9 (toJSON j)
1287− VM.unsafeWrite mv 10 (toJSON k)
1288− VM.unsafeWrite mv 11 (toJSON l)
1289− return mv
1290 {-# INLINE toJSON #-}
1152 {-# INLINE toJSON #-}
1291
1153
1292− toEncoding (a,b,c,d,e,f,g,h,i,j,k,l) = tuple $
1154+ toEncoding = toEncoding1
1293− builder a >*<
1294− builder b >*<
1295− builder c >*<
1296− builder d >*<
1297− builder e >*<
1298− builder f >*<
1299− builder g >*<
1300− builder h >*<
1301− builder i >*<
1302− builder j >*<
1303− builder k >*<
1304− builder l
1305 {-# INLINE toEncoding #-}
1155 {-# INLINE toEncoding #-}
1306
1156
1307−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1157+instance FromJSON1 Dual where
1308− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1158+ liftParseJSON p _ = fmap Dual . p
1309− FromJSON k, FromJSON l) =>
1159+ {-# INLINE liftParseJSON #-}
1310− FromJSON (a,b,c,d,e,f,g,h,i,j,k,l) where
1311− parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l)" $ \ary ->
1312− let n = V.length ary
1313− in if n /= 12
1314− then fail $ "cannot unpack array of length " ++
1315− show n ++ " into a 12-tuple"
1316− else (,,,,,,,,,,,)
1317− <$> parseJSONElemAtIndex 0 ary
1318− <*> parseJSONElemAtIndex 1 ary
1319− <*> parseJSONElemAtIndex 2 ary
1320− <*> parseJSONElemAtIndex 3 ary
1321− <*> parseJSONElemAtIndex 4 ary
1322− <*> parseJSONElemAtIndex 5 ary
1323− <*> parseJSONElemAtIndex 6 ary
1324− <*> parseJSONElemAtIndex 7 ary
1325− <*> parseJSONElemAtIndex 8 ary
1326− <*> parseJSONElemAtIndex 9 ary
1327− <*> parseJSONElemAtIndex 10 ary
1328− <*> parseJSONElemAtIndex 11 ary
1329− {-# INLINE parseJSON #-}
1330−
1331−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1332− ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1333− ToJSON m) =>
1334− ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) where
1335− toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) = Array $ V.create $ do
1336− mv <- VM.unsafeNew 13
1337− VM.unsafeWrite mv 0 (toJSON a)
1338− VM.unsafeWrite mv 1 (toJSON b)
1339− VM.unsafeWrite mv 2 (toJSON c)
1340− VM.unsafeWrite mv 3 (toJSON d)
1341− VM.unsafeWrite mv 4 (toJSON e)
1342− VM.unsafeWrite mv 5 (toJSON f)
1343− VM.unsafeWrite mv 6 (toJSON g)
1344− VM.unsafeWrite mv 7 (toJSON h)
1345− VM.unsafeWrite mv 8 (toJSON i)
1346− VM.unsafeWrite mv 9 (toJSON j)
1347− VM.unsafeWrite mv 10 (toJSON k)
1348− VM.unsafeWrite mv 11 (toJSON l)
1349− VM.unsafeWrite mv 12 (toJSON m)
1350− return mv
1351− {-# INLINE toJSON #-}
1352−
1353− toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m) = tuple $
1354− builder a >*<
1355− builder b >*<
1356− builder c >*<
1357− builder d >*<
1358− builder e >*<
1359− builder f >*<
1360− builder g >*<
1361− builder h >*<
1362− builder i >*<
1363− builder j >*<
1364− builder k >*<
1365− builder l >*<
1366− builder m
1367− {-# INLINE toEncoding #-}
1368
1160
1369−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1370− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1371− FromJSON k, FromJSON l, FromJSON m) =>
1372− FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m) where
1161+instance FromJSON a => FromJSON (Dual a) where
1373− parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m)" $ \ary ->
1162+ parseJSON = parseJSON1
1374− let n = V.length ary
1375− in if n /= 13
1376− then fail $ "cannot unpack array of length " ++
1377− show n ++ " into a 13-tuple"
1378− else (,,,,,,,,,,,,)
1379− <$> parseJSONElemAtIndex 0 ary
1380− <*> parseJSONElemAtIndex 1 ary
1381− <*> parseJSONElemAtIndex 2 ary
1382− <*> parseJSONElemAtIndex 3 ary
1383− <*> parseJSONElemAtIndex 4 ary
1384− <*> parseJSONElemAtIndex 5 ary
1385− <*> parseJSONElemAtIndex 6 ary
1386− <*> parseJSONElemAtIndex 7 ary
1387− <*> parseJSONElemAtIndex 8 ary
1388− <*> parseJSONElemAtIndex 9 ary
1389− <*> parseJSONElemAtIndex 10 ary
1390− <*> parseJSONElemAtIndex 11 ary
1391− <*> parseJSONElemAtIndex 12 ary
1392 {-# INLINE parseJSON #-}
1163 {-# INLINE parseJSON #-}
1393
1164
1394−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1395− ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1396− ToJSON m, ToJSON n) =>
1397− ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
1398− toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = Array $ V.create $ do
1399− mv <- VM.unsafeNew 14
1400− VM.unsafeWrite mv 0 (toJSON a)
1401− VM.unsafeWrite mv 1 (toJSON b)
1402− VM.unsafeWrite mv 2 (toJSON c)
1403− VM.unsafeWrite mv 3 (toJSON d)
1404− VM.unsafeWrite mv 4 (toJSON e)
1405− VM.unsafeWrite mv 5 (toJSON f)
1406− VM.unsafeWrite mv 6 (toJSON g)
1407− VM.unsafeWrite mv 7 (toJSON h)
1408− VM.unsafeWrite mv 8 (toJSON i)
1409− VM.unsafeWrite mv 9 (toJSON j)
1410− VM.unsafeWrite mv 10 (toJSON k)
1411− VM.unsafeWrite mv 11 (toJSON l)
1412− VM.unsafeWrite mv 12 (toJSON m)
1413− VM.unsafeWrite mv 13 (toJSON n)
1414− return mv
1415− {-# INLINE toJSON #-}
1416
1165
1417− toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = tuple $
1166+instance ToJSON1 First where
1418− builder a >*<
1167+ liftToJSON to to' = liftToJSON to to' . getFirst
1419− builder b >*<
1168+ {-# INLINE liftToJSON #-}
1420− builder c >*<
1421− builder d >*<
1422− builder e >*<
1423− builder f >*<
1424− builder g >*<
1425− builder h >*<
1426− builder i >*<
1427− builder j >*<
1428− builder k >*<
1429− builder l >*<
1430− builder m >*<
1431− builder n
1432− {-# INLINE toEncoding #-}
1433
1169
1434−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1170+ liftToEncoding to to' = liftToEncoding to to' . getFirst
1435− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1171+ {-# INLINE liftToEncoding #-}
1436− FromJSON k, FromJSON l, FromJSON m, FromJSON n) =>
1437− FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
1438− parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m,n)" $ \ary ->
1439− let n = V.length ary
1440− in if n /= 14
1441− then fail $ "cannot unpack array of length " ++
1442− show n ++ " into a 14-tuple"
1443− else (,,,,,,,,,,,,,)
1444− <$> parseJSONElemAtIndex 0 ary
1445− <*> parseJSONElemAtIndex 1 ary
1446− <*> parseJSONElemAtIndex 2 ary
1447− <*> parseJSONElemAtIndex 3 ary
1448− <*> parseJSONElemAtIndex 4 ary
1449− <*> parseJSONElemAtIndex 5 ary
1450− <*> parseJSONElemAtIndex 6 ary
1451− <*> parseJSONElemAtIndex 7 ary
1452− <*> parseJSONElemAtIndex 8 ary
1453− <*> parseJSONElemAtIndex 9 ary
1454− <*> parseJSONElemAtIndex 10 ary
1455− <*> parseJSONElemAtIndex 11 ary
1456− <*> parseJSONElemAtIndex 12 ary
1457− <*> parseJSONElemAtIndex 13 ary
1458− {-# INLINE parseJSON #-}
1459
1172
1460−instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
1461− ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l,
1462− ToJSON m, ToJSON n, ToJSON o) =>
1463− ToJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
1173+instance ToJSON a => ToJSON (First a) where
1464− toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = Array $ V.create $ do
1174+ toJSON = toJSON1
1465− mv <- VM.unsafeNew 15
1466− VM.unsafeWrite mv 0 (toJSON a)
1467− VM.unsafeWrite mv 1 (toJSON b)
1468− VM.unsafeWrite mv 2 (toJSON c)
1469− VM.unsafeWrite mv 3 (toJSON d)
1470− VM.unsafeWrite mv 4 (toJSON e)
1471− VM.unsafeWrite mv 5 (toJSON f)
1472− VM.unsafeWrite mv 6 (toJSON g)
1473− VM.unsafeWrite mv 7 (toJSON h)
1474− VM.unsafeWrite mv 8 (toJSON i)
1475− VM.unsafeWrite mv 9 (toJSON j)
1476− VM.unsafeWrite mv 10 (toJSON k)
1477− VM.unsafeWrite mv 11 (toJSON l)
1478− VM.unsafeWrite mv 12 (toJSON m)
1479− VM.unsafeWrite mv 13 (toJSON n)
1480− VM.unsafeWrite mv 14 (toJSON o)
1481− return mv
1482 {-# INLINE toJSON #-}
1175 {-# INLINE toJSON #-}
1483
1176
1484− toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = tuple $
1177+ toEncoding = toEncoding1
1485− builder a >*<
1486− builder b >*<
1487− builder c >*<
1488− builder d >*<
1489− builder e >*<
1490− builder f >*<
1491− builder g >*<
1492− builder h >*<
1493− builder i >*<
1494− builder j >*<
1495− builder k >*<
1496− builder l >*<
1497− builder m >*<
1498− builder n >*<
1499− builder o
1500 {-# INLINE toEncoding #-}
1178 {-# INLINE toEncoding #-}
1501
1179
1502−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
1180+instance FromJSON1 First where
1503− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,
1181+ liftParseJSON p p' = fmap First . liftParseJSON p p'
1504− FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) =>
1182+ {-# INLINE liftParseJSON #-}
1505− FromJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
1506− parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)" $ \ary ->
1507− let n = V.length ary
1508− in if n /= 15
1509− then fail $ "cannot unpack array of length " ++
1510− show n ++ " into a 15-tuple"
1511− else (,,,,,,,,,,,,,,)
1512− <$> parseJSONElemAtIndex 0 ary
1513− <*> parseJSONElemAtIndex 1 ary
1514− <*> parseJSONElemAtIndex 2 ary
1515− <*> parseJSONElemAtIndex 3 ary
1516− <*> parseJSONElemAtIndex 4 ary
1517− <*> parseJSONElemAtIndex 5 ary
1518− <*> parseJSONElemAtIndex 6 ary
1519− <*> parseJSONElemAtIndex 7 ary
1520− <*> parseJSONElemAtIndex 8 ary
1521− <*> parseJSONElemAtIndex 9 ary
1522− <*> parseJSONElemAtIndex 10 ary
1523− <*> parseJSONElemAtIndex 11 ary
1524− <*> parseJSONElemAtIndex 12 ary
1525− <*> parseJSONElemAtIndex 13 ary
1526− <*> parseJSONElemAtIndex 14 ary
1527− {-# INLINE parseJSON #-}
1528−
1529−instance ToJSON a => ToJSON (Dual a) where
1530− toJSON = toJSON . getDual
1531− {-# INLINE toJSON #-}
1532−
1533− toEncoding = toEncoding . getDual
1534− {-# INLINE toEncoding #-}
1535
1183
1536−instance FromJSON a => FromJSON (Dual a) where
1184+instance FromJSON a => FromJSON (First a) where
1537− parseJSON = fmap Dual . parseJSON
1185+ parseJSON = parseJSON1
1538 {-# INLINE parseJSON #-}
1186 {-# INLINE parseJSON #-}
1539
1187
1540−instance ToJSON a => ToJSON (First a) where
1541− toJSON = toJSON . getFirst
1542− {-# INLINE toJSON #-}
1543
1188
1544− toEncoding = toEncoding . getFirst
1189+instance ToJSON1 Last where
1545− {-# INLINE toEncoding #-}
1190+ liftToJSON to to' = liftToJSON to to' . getLast
1191+ {-# INLINE liftToJSON #-}
1546
1192
1547−instance FromJSON a => FromJSON (First a) where
1193+ liftToEncoding to to' = liftToEncoding to to' . getLast
1548− parseJSON = fmap First . parseJSON
1194+ {-# INLINE liftToEncoding #-}
1549− {-# INLINE parseJSON #-}
1550
1195
1551instance ToJSON a => ToJSON (Last a) where
1196instance ToJSON a => ToJSON (Last a) where
1552− toJSON = toJSON . getLast
1197+ toJSON = toJSON1
1553 {-# INLINE toJSON #-}
1198 {-# INLINE toJSON #-}
1554
1199
1555− toEncoding = toEncoding . getLast
1200+ toEncoding = toEncoding1
1556 {-# INLINE toEncoding #-}
1201 {-# INLINE toEncoding #-}
1557
1202
1203+instance FromJSON1 Last where
1204+ liftParseJSON p p' = fmap Last . liftParseJSON p p'
1205+ {-# INLINE liftParseJSON #-}
1206+
1558instance FromJSON a => FromJSON (Last a) where
1207instance FromJSON a => FromJSON (Last a) where
1559− parseJSON = fmap Last . parseJSON
1208+ parseJSON = parseJSON1
1560 {-# INLINE parseJSON #-}
1209 {-# INLINE parseJSON #-}
1561
1210
1562−instance ToJSON Version where
1211+-------------------------------------------------------------------------------
1563− toJSON = toJSON . showVersion
1212+-- tagged
1564− {-# INLINE toJSON #-}
1213+-------------------------------------------------------------------------------
1565−
1566− toEncoding = toEncoding . showVersion
1567− {-# INLINE toEncoding #-}
1568−
1569−instance FromJSON Version where
1570− {-# INLINE parseJSON #-}
1571− parseJSON = withText "Version" $ go . readP_to_S parseVersion . unpack
1572− where
1573− go [(v,[])] = return v
1574− go (_ : xs) = go xs
1575− go _ = fail $ "could not parse Version"
1576
1214
1577instance ToJSON (Proxy a) where
1215instance ToJSON (Proxy a) where
1578 toJSON _ = Null
1216 toJSON _ = Null
@@ -1586,46 +1224,42 @@ instance FromJSON (Proxy a) where
1586 parseJSON Null = pure Proxy
1224 parseJSON Null = pure Proxy
1587 parseJSON v = typeMismatch "Proxy" v
1225 parseJSON v = typeMismatch "Proxy" v
1588
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+
1589instance ToJSON b => ToJSON (Tagged a b) where
1235instance ToJSON b => ToJSON (Tagged a b) where
1590− toJSON (Tagged x) = toJSON x
1236+ toJSON = toJSON1
1591 {-# INLINE toJSON #-}
1237 {-# INLINE toJSON #-}
1592
1238
1593− toEncoding (Tagged x) = toEncoding x
1239+ toEncoding = toEncoding1
1594 {-# INLINE toEncoding #-}
1240 {-# INLINE toEncoding #-}
1595
1241
1242+instance FromJSON1 (Tagged a) where
1243+ liftParseJSON p _ = fmap Tagged . p
1244+ {-# INLINE liftParseJSON #-}
1245+
1596instance FromJSON b => FromJSON (Tagged a b) where
1246instance FromJSON b => FromJSON (Tagged a b) where
1247+ parseJSON = parseJSON1
1597 {-# INLINE parseJSON #-}
1248 {-# INLINE parseJSON #-}
1598− parseJSON = fmap Tagged . parseJSON
1599
1249
1600−instance ToJSON a => ToJSON (Const a b) where
1250+instance FromJSONKey b => FromJSONKey (Tagged a b) where
1601− toJSON (Const x) = toJSON x
1251+ fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)
1602− {-# INLINE toJSON #-}
1252+ fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList
1603−
1604− toEncoding (Const x) = toEncoding x
1605− {-# INLINE toEncoding #-}
1606
1253
1607−instance FromJSON a => FromJSON (Const a b) where
1254+instance ToJSONKey b => ToJSONKey (Tagged a b) where
1608− {-# INLINE parseJSON #-}
1255+ toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
1609− parseJSON = fmap Const . parseJSON
1256+ toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
1610
1257
1611−--------------------------------------------
1258+-------------------------------------------------------------------------------
1612-- Instances for converting to/from map keys
1259-- Instances for converting to/from map keys
1613−--------------------------------------------
1260+-------------------------------------------------------------------------------
1614−class ToJSONKey a where
1261+
1615− toJSONKey :: ToJSONKeyFunction a
1262+
1616− default toJSONKey :: ToJSON a => ToJSONKeyFunction a
1617− toJSONKey = ToJSONKeyValue (toJSON, toEncoding)
1618− toJSONKeyList :: ToJSONKeyFunction [a]
1619− default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
1620− toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)
1621−
1622−class FromJSONKey a where
1623− fromJSONKey :: FromJSONKeyFunction a
1624− default fromJSONKey :: FromJSON a => FromJSONKeyFunction a
1625− fromJSONKey = FromJSONKeyValue parseJSON
1626− fromJSONKeyList :: FromJSONKeyFunction [a]
1627− default fromJSONKeyList :: FromJSON a => FromJSONKeyFunction [a]
1628− fromJSONKeyList = FromJSONKeyValue parseJSON
1629
1263
1630instance ToJSONKey Text where
1264instance ToJSONKey Text where
1631 toJSONKey = ToJSONKeyText (id,toEncoding)
1265 toJSONKey = ToJSONKeyText (id,toEncoding)
@@ -1633,10 +1267,7 @@ instance ToJSONKey Text where
1633instance FromJSONKey Text where
1267instance FromJSONKey Text where
1634 fromJSONKey = fromJSONKeyCoerce
1268 fromJSONKey = fromJSONKeyCoerce
1635
1269
1636−-- | TODO: where ToJSONKey instance
1270+
1637−instance FromJSONKey b => FromJSONKey (Tagged a b) where
1638− fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)
1639− fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList
1640
1271
1641instance ToJSONKey Bool where
1272instance ToJSONKey Bool where
1642 toJSONKey = ToJSONKeyText
1273 toJSONKey = ToJSONKeyText
@@ -1690,13 +1321,9 @@ instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1690instance (FromJSONKey a, FromJSON a) => FromJSONKey (Identity a) where
1321instance (FromJSONKey a, FromJSON a) => FromJSONKey (Identity a) where
1691 fromJSONKey = mapFromJSONKeyFunction Identity fromJSONKey
1322 fromJSONKey = mapFromJSONKeyFunction Identity fromJSONKey
1692
1323
1693−contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
1324+-------------------------------------------------------------------------------
1694−contramapToJSONKeyFunction h x = case x of
1325+-- Functions
1695− ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)
1326+-------------------------------------------------------------------------------
1696− ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)
1697−
1698−mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
1699−mapFromJSONKeyFunction = fmap
1700
1327
1701-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@
1328-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@
1702-- and fails using @'typeMismatch' expected@ otherwise.
1329-- and fails using @'typeMismatch' expected@ otherwise.
@@ -1819,34 +1446,3 @@ obj .:! key = case H.lookup key obj of
1819(.!=) :: Parser (Maybe a) -> a -> Parser a
1446(.!=) :: Parser (Maybe a) -> a -> Parser a
1820pmval .!= val = fromMaybe val <$> pmval
1447pmval .!= val = fromMaybe val <$> pmval
1821{-# INLINE (.!=) #-}
1448{-# INLINE (.!=) #-}
1822−
1823−realFloatToJSON :: RealFloat a => a -> Value
1824−realFloatToJSON d
1825− | isNaN d || isInfinite d = Null
1826− | otherwise = Number $ Scientific.fromFloatDigits d
1827−{-# INLINE realFloatToJSON #-}
1828−
1829−realFloatToEncoding :: RealFloat a => a -> Encoding
1830−realFloatToEncoding d
1831− | isNaN d || isInfinite d = Encoding E.null_
1832− | otherwise = toEncoding (Scientific.fromFloatDigits d)
1833−{-# INLINE realFloatToEncoding #-}
1834−
1835−scientificToNumber :: Scientific -> Number
1836−scientificToNumber s
1837− | e < 0 = D $ Scientific.toRealFloat s
1838− | otherwise = I $ c * 10 ^ e
1839− where
1840− e = Scientific.base10Exponent s
1841− c = Scientific.coefficient s
1842−{-# INLINE scientificToNumber #-}
1843−
1844−parseRealFloat :: RealFloat a => String -> Value -> Parser a
1845−parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
1846−parseRealFloat _ Null = pure (0/0)
1847−parseRealFloat expected v = typeMismatch expected v
1848−{-# INLINE parseRealFloat #-}
1849−
1850−parseIntegral :: Integral a => String -> Value -> Parser a
1851−parseIntegral expected = withScientific expected $ pure . truncate
1852−{-# INLINE parseIntegral #-}
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+
aeson.cabal+1
@@ -85,6 +85,7 @@ library
85 Data.Aeson.Types.Class
85 Data.Aeson.Types.Class
86 Data.Aeson.Types.Generic
86 Data.Aeson.Types.Generic
87 Data.Aeson.Types.Instances
87 Data.Aeson.Types.Instances
88+ Data.Aeson.Types.Instances.Tuple
88 Data.Aeson.Types.Internal
89 Data.Aeson.Types.Internal
89
90
90 build-depends:
91 build-depends:
benchmarks/aeson-benchmarks.cabal+1
@@ -30,6 +30,7 @@ library
30 Data.Aeson.Types.Generic
30 Data.Aeson.Types.Generic
31 Data.Aeson.Types.Instances
31 Data.Aeson.Types.Instances
32 Data.Aeson.Types.Internal
32 Data.Aeson.Types.Internal
33+ Data.Aeson.Types.Instances.Tuple
33
34
34 build-depends:
35 build-depends:
35 attoparsec >= 0.13.0.1,
36 attoparsec >= 0.13.0.1,
changelog.md+6
@@ -2,6 +2,12 @@ For the latest version of this document, please see [https://github.com/bos/aeso
2
2
3# 0.12.0.0
3# 0.12.0.0
4
4
5+* Added list specific members to `ToJSON` and `FromJSON` classes. In the same
6+ way `Read` / `Show` handle lists specifically. This removes need for
7+ overlapping instances to handle `String`.
8+
9+* Added higher rank classes: `ToJSON1`, `ToJSON2`, `FromJSON1`, and `FromJSON2`
10+
5* Modified instances for `Map` and `HashMap`. Introduced new `FromJSONKey` and
11* Modified instances for `Map` and `HashMap`. Introduced new `FromJSONKey` and
6 `ToJSONKey` type classes.
12 `ToJSONKey` type classes.
7
13
tests/UnitTests.hs+9−2
@@ -1,4 +1,7 @@
1{-# LANGUAGE CPP, DeriveGeneric, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
1{-# LANGUAGE CPP, DeriveGeneric, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
2+#if __GLASGOW_HASKELL__ >= 708
3+{-# LANGUAGE DataKinds #-}
4+#endif
2
5
3{-# OPTIONS_GHC -fno-warn-deprecations #-}
6{-# OPTIONS_GHC -fno-warn-deprecations #-}
4
7
@@ -233,6 +236,10 @@ jsonEncoding = [
233 , assertEqual "Just Nothing" "null" $ encode (Just Nothing :: Maybe (Maybe Int))
236 , assertEqual "Just Nothing" "null" $ encode (Just Nothing :: Maybe (Maybe Int))
234 , assertEqual "Proxy Int" "null" $ encode (Proxy :: Proxy Int)
237 , assertEqual "Proxy Int" "null" $ encode (Proxy :: Proxy Int)
235 , assertEqual "Tagged Char Int" "1" $ encode (Tagged 1 :: Tagged Char Int)
238 , assertEqual "Tagged Char Int" "1" $ encode (Tagged 1 :: Tagged Char Int)
239+#if __GLASGOW_HASKELL__ >= 708
240+ -- Test Tagged instance is polykinded
241+ , assertEqual "Tagged 123 Int" "1" $ encode (Tagged 1 :: Tagged 123 Int)
242+#endif
236 , assertEqual "Const Char Int" "\"c\"" $ encode (Const 'c' :: Const Char Int)
243 , assertEqual "Const Char Int" "\"c\"" $ encode (Const 'c' :: Const Char Int)
237 , assertEqual "Tuple" "[1,2]" $ encode ((1, 2) :: (Int, Int))
244 , assertEqual "Tuple" "[1,2]" $ encode ((1, 2) :: (Int, Int))
238 , assertEqual "NonEmpty" "[1,2,3]" $ encode (1 :| [2, 3] :: NonEmpty Int)
245 , assertEqual "NonEmpty" "[1,2,3]" $ encode (1 :| [2, 3] :: NonEmpty Int)
@@ -288,8 +295,8 @@ overlappingRegression bs = fromMaybe [] $ decode bs
288issue351 :: [Assertion]
295issue351 :: [Assertion]
289issue351 = [
296issue351 = [
290 assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"
297 assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"
298+ , assertEqual "Char" ("abc" :: String) $ overlappingRegression "\"abc\""
291− , assertEqual "Char" ("" :: String) $ overlappingRegression "\"abc\""
299+ , assertEqual "Char" ("" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
292− , assertEqual "Char" ("abc" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
293 ]
300 ]
294
301
295------------------------------------------------------------------------------
302------------------------------------------------------------------------------
tuple-instances.hsnew file+126
@@ -0,0 +1,126 @@
1+#!/usr/bin/env stack
2+{- stack --resolver=lts-5.9 runghc
3+ --package mtl
4+ --package dlist
5+-}
6+
7+import Control.Monad (forM_)
8+import Control.Monad.State.Strict
9+import Control.Monad.Writer (MonadWriter (..))
10+import Data.Char (toUpper)
11+import Data.Foldable (fold, traverse_)
12+import Data.List (intercalate)
13+import Data.Semigroup ((<>))
14+
15+import qualified Data.DList as DList
16+
17+variables :: [String]
18+variables = map (:[]) $ ['a'..'z']
19+
20+t :: [String] -> State (DList.DList String) ()
21+t xs = traverse_ f xs *> f "\n"
22+ where
23+ f :: String -> State (DList.DList String) ()
24+ f x = state (\s -> ((), mappend s $ DList.singleton x))
25+
26+commaSep :: [String] -> String
27+commaSep vs = "(" <> intercalate ", " vs <> ")"
28+
29+tuple :: Int -> String
30+tuple n = fold $ flip execState DList.empty $ do
31+ -- ToJSON2
32+ t ["instance ", toJsonContext2, "ToJSON2 (", tupleConstr, " ", vs2, ") where" ]
33+ t [" liftToJSON2 ", toPrev, " _ ", toLast, " _ ", vs', " = Array $ V.create $ do" ]
34+ t [" mv <- VM.unsafeNew ", show n ]
35+ forM_ (zip [0..] vs) $ \(i, v) ->
36+ let to = case i of
37+ _ | i == n - 1 -> toLast
38+ | i == n - 2 -> toPrev
39+ | otherwise -> "toJSON"
40+ in t [ " VM.unsafeWrite mv ", show i, " (", to, " ", v, ")" ]
41+ t [" return mv" ]
42+ t [" {-# INLINE liftToJSON2 #-}" ]
43+ t []
44+
45+ t [" liftToEncoding2 ", toPrev, " _ ", toLast, " _ ", vs', " = tuple $" ]
46+ forM_ (zip [0..] vs) $ \(i, v) -> t . (" " :) $ case i of
47+
48+ _ | i == n - 1 -> [ "fromEncoding (", toLast, " ", v, ")" ]
49+ _ | i == n - 2 -> [ "fromEncoding (", toPrev, " ", v, ") >*<" ]
50+ _ | otherwise -> [ "builder ", v, " >*<" ]
51+ t [" {-# INLINE liftToEncoding2 #-}" ]
52+ t []
53+
54+ -- ToJSON1
55+ t ["instance ", toJsonContext1, "ToJSON1 (", tupleConstr, " ", vs1, ") where" ]
56+ t [" liftToJSON = liftToJSON2 toJSON toJSONList" ]
57+ t [" {-# INLINE liftToJSON #-}" ]
58+ t [" liftToEncoding = liftToEncoding2 toEncoding toEncodingList" ]
59+ t [" {-# INLINE liftToEncoding #-}" ]
60+ t []
61+
62+ -- ToJSON
63+ t [ "instance ", toJsonContext, " => ToJSON ", vs', " where" ]
64+ t [ " toJSON = toJSON2" ]
65+ t [ " {-# INLINE toJSON #-}" ]
66+ t [ " toEncoding = toEncoding2" ]
67+ t [ " {-# INLINE toEncoding #-}" ]
68+ t []
69+
70+ -- FromJSON2
71+ t ["instance ", fromJsonContext2, "FromJSON2 (", tupleConstr, " ", vs2, ") where" ]
72+ t [" liftParseJSON2 ", pPrev, " _ ", pLast, " _ = withArray \"", vs', "\" $ \\t -> " ]
73+ t [" let n = V.length t" ]
74+ t [" in if n == ", show n ]
75+ t [" then ", tupleConstr ]
76+ forM_ (zip [0..] vs) $ \(i, v) -> do
77+ let op = if i == 0 then "<$>" else "<*>"
78+ let p = case i of
79+ _ | i == n - 1 -> pLast
80+ | i == n - 2 -> pPrev
81+ | otherwise -> "parseJSON"
82+ t [" ", op, " parseJSONElemAtIndex ", p, " ", show i, " t" ]
83+ t [" else fail $ \"cannot unpack array of length \" ++ show n ++ \" into a tuple of length ", show n, "\"" ]
84+ t [" {-# INLINE liftParseJSON2 #-}" ]
85+ t []
86+
87+ -- FromJSON1
88+ t ["instance ", fromJsonContext1, "FromJSON1 (", tupleConstr, " ", vs1, ") where" ]
89+ t [" liftParseJSON = liftParseJSON2 parseJSON parseJSONList" ]
90+ t [" {-# INLINE liftParseJSON #-}" ]
91+ t []
92+
93+ -- FeomJSON
94+ t [ "instance ", fromJsonContext, " => FromJSON ", vs', " where" ]
95+ t [ " parseJSON = parseJSON2" ]
96+ t [ " {-# INLINE parseJSON #-}" ]
97+ t []
98+
99+ t []
100+ where
101+ vs = take n variables
102+ vs' = commaSep vs
103+ toJsonContext = commaSep $ map ("ToJSON " <>) vs
104+ fromJsonContext = commaSep $ map ("FromJSON " <>) vs
105+
106+ toJsonContext2
107+ | n <= 2 = ""
108+ | otherwise = (commaSep $ map ("ToJSON " <>) $ take (n - 2) vs) <> " => "
109+ fromJsonContext2
110+ | n <= 2 = ""
111+ | otherwise = (commaSep $ map ("FromJSON " <>) $ take (n - 2) vs) <> " => "
112+ vs2 = intercalate " " $ take (n - 2) vs
113+
114+ toJsonContext1 = (commaSep $ map ("ToJSON " <>) $ take (n - 1) vs) <> " => "
115+ fromJsonContext1 = (commaSep $ map ("FromJSON " <>) $ take (n - 1) vs) <> " => "
116+ vs1 = intercalate " " $ take (n - 1) vs
117+
118+ toLast = "to" <> map toUpper (vs !! (n - 1))
119+ toPrev = "to" <> map toUpper (vs !! (n - 2))
120+ pLast = "p" <> map toUpper (vs !! (n - 1))
121+ pPrev = "p" <> map toUpper (vs !! (n - 2))
122+
123+ tupleConstr = "(" <> intercalate "," (replicate n "") <> ")"
124+
125+main :: IO ()
126+main = forM_ [2..15] $ putStr . tuple