722b577 · typeable/aeson

git.iko.soy/typeable/aeson

Merge pull request #407 from phadej/high-kind-strings

High kind strings

commit722b577cf88c97cb16d0f8b8ca79907c00922d32 authorAdam Bergmark <adam@bergmark.nl> dateThu 2 Jun 2016, 19:50 (10 years ago) parent0e35a32 df96e86

11 files changed+1911−972

compare with master

unifiedsplit

Data/Aeson.hs+11 Data/Aeson/Encode/Functions.hs+38−26 Data/Aeson/Types.hs+29−1 Data/Aeson/Types/Class.hs+213−1 Data/Aeson/Types/Instances.hs+538−942 Data/Aeson/Types/Instances/Tuple.hs+939 aeson.cabal+1 benchmarks/aeson-benchmarks.cabal+1 changelog.md+6 tests/UnitTests.hs+9−2 tuple-instances.hs+126

Data/Aeson.hs+11

@@ -62,6 +62,17 @@ module Data.Aeson

6262 , ToJSONKeyFunction(..)

6363 , FromJSONKey(..)

6464 , 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

6576 -- ** Generic JSON classes and options

6677 , GFromJSON(..)

6778 , GToJSON(..)

Data/Aeson/Encode/Functions.hs+38−26

@@ -4,12 +4,12 @@ module Data.Aeson.Encode.Functions

44 (

55 brackets

66 , builder

7+ , builder'

78 , char7

89 , encode

9− , foldable

1010 , list

11− , list'

12− , pairs

11+ , encodeMap

12+ , encodeWithKey

1313 ) where

1414

1515import Data.Aeson.Encode.Builder

@@ -17,6 +17,7 @@ import Data.Aeson.Types.Class

1717import Data.Aeson.Types.Internal

1818import Data.ByteString.Builder (Builder, char7)

1919import Data.ByteString.Builder.Prim (primBounded)

20+import Data.Foldable (toList)

2021import Data.Monoid ((<>))

2122import qualified Data.ByteString.Builder as B

2223import qualified Data.ByteString.Lazy as L

@@ -26,10 +27,17 @@ import Data.Foldable (Foldable, foldMap)

2627import Data.Monoid (mempty)

2728#endif

2829

30+list :: (a -> Encoding) -> [a] -> Encoding

31+list = listEncoding

32+

2933builder :: ToJSON a => a -> Builder

3034builder = fromEncoding . toEncoding

3135{-# INLINE builder #-}

3236

37+builder' :: (a -> Encoding) -> a -> Builder

38+builder' f = fromEncoding . f

39+{-# INLINE builder' #-}

40+

3341-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.

3442--

3543-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.

@@ -37,31 +45,35 @@ encode :: ToJSON a => a -> L.ByteString

3745encode = B.toLazyByteString . builder

3846{-# INLINE encode #-}

3947

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−

5948brackets :: Char -> Char -> Series -> Encoding

6049brackets begin end (Value v) = Encoding $

6150 char7 begin <> fromEncoding v <> char7 end

6251brackets begin end Empty = Encoding (primBounded (ascii2 (begin,end)) ())

6352

64−-- | Encode a series of key/value pairs, separated by commas.

65−pairs :: Series -> Encoding

66−pairs s = brackets '{' '}' s

67−{-# INLINE pairs #-}

53+

54+

55+encodeMap :: (k -> Encoding)

56+ -> (v -> Encoding)

57+ -> (m -> Maybe ((k,v), m))

58+ -> ((k -> v -> B.Builder -> B.Builder) -> B.Builder -> m -> B.Builder)

59+ -> m -> Encoding

60+encodeMap encodeKey encodeVal minViewWithKey foldrWithKey xs =

61+ case minViewWithKey xs of

62+ Nothing -> Encoding $ primBounded (ascii2 ('{', '}')) ()

63+ Just ((k,v),ys) -> Encoding $

64+ B.char7 '{' <> encodeKV encodeKey encodeVal k v <>

65+ foldrWithKey go (B.char7 '}') ys

66+ where go k v b = B.char7 ',' <> encodeKV encodeKey encodeVal k v <> b

67+{-# INLINE encodeMap #-}

68+

69+encodeWithKey :: (k -> Encoding)

70+ -> (v -> Encoding)

71+ -> ((k -> v -> Series -> Series) -> Series -> m -> Series)

72+ -> m -> Encoding

73+encodeWithKey encodeKey encodeVal foldrWithKey = brackets '{' '}' . foldrWithKey go mempty

74+ where go k v c = Value (Encoding $ encodeKV encodeKey encodeVal k v) <> c

75+{-# INLINE encodeWithKey #-}

76+

77+encodeKV :: (k -> Encoding) -> (v -> Encoding) -> k -> v -> B.Builder

78+encodeKV encodeKey encodeVal k v = fromEncoding (encodeKey k) <> B.char7 ':' <> builder' encodeVal v

79+{-# INLINE encodeKV #-}

Data/Aeson/Types.hs+29−1

@@ -45,6 +45,18 @@ module Data.Aeson.Types

4545 , fromJSONKeyCoerce

4646 , coerceFromJSONKeyFunction

4747

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+

4860 -- ** Generic JSON classes

4961 , GFromJSON(..)

5062 , GToJSON(..)

@@ -69,6 +81,10 @@ module Data.Aeson.Types

6981 , (.!=)

7082 , object

7183

84+ , listEncoding

85+ , listValue

86+ , listParser

87+

7288 -- * Generic and TH encoding configuration

7389 , Options(..)

7490 , SumEncoding(..)

@@ -78,7 +94,19 @@ module Data.Aeson.Types

7894 , defaultTaggedObject

7995 ) where

8096

81−import Data.Aeson.Encode.Functions (foldable, pairs)

8297import Data.Aeson.Types.Generic ()

8398import Data.Aeson.Types.Instances

8499import 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

1717 -- * Core JSON classes

1818 FromJSON(..)

1919 , 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

2031 -- * Generic JSON classes

2132 , GFromJSON(..)

2233 , GToJSON(..)

@@ -25,25 +36,37 @@ module Data.Aeson.Types.Class

2536 , genericToEncoding

2637 , genericParseJSON

2738 -- * Classes and types for map keys

39+ , ToJSONKey(..)

2840 , ToJSONKeyFunction(..)

41+ , contramapToJSONKeyFunction

42+ , FromJSONKey(..)

2943 , FromJSONKeyFunction(..)

3044 , fromJSONKeyCoerce

3145 , coerceFromJSONKeyFunction

46+ , mapFromJSONKeyFunction

3247 -- * Object key-value pairs

3348 , KeyValue(..)

3449 -- * Functions needed for documentation

3550 , typeMismatch

51+ -- * Encoding functions

52+ , listEncoding

53+ , listValue

54+ , listParser

3655 ) where

3756

3857import Data.Aeson.Types.Internal

58+import Data.Monoid ((<>))

3959import Data.Text (Text)

4060import GHC.Generics (Generic, Rep, from, to)

41−import Data.Monoid ((<>))

4261import Data.Aeson.Encode.Builder (emptyArray_)

4362import qualified Data.ByteString.Builder as B

4463import qualified Data.Aeson.Encode.Builder as E

4564import qualified Data.Vector as V

4665

66+#if !MIN_VERSION_base(4,8,0)

67+import Data.Monoid (mempty)

68+#endif

69+

4770-- Coercible derivations aren't as powerful on GHC 7.8, though supported.

4871#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 709)

4972

@@ -188,6 +211,19 @@ class ToJSON a where

188211 toEncoding = Encoding . E.encodeToBuilder . toJSON

189212 {-# INLINE toEncoding #-}

190213

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+

191227-- | A type that can be converted from JSON, with the possibility of

192228-- failure.

193229--

@@ -268,11 +304,47 @@ class FromJSON a where

268304 default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a

269305 parseJSON = genericParseJSON defaultOptions

270306

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+

271323-- | A key-value pair for encoding a JSON object.

272324class KeyValue kv where

273325 (.=) :: ToJSON v => Text -> v -> kv

274326 infixr 8 .=

275327

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+

276348data ToJSONKeyFunction a

277349 = ToJSONKeyText (a -> Text, a -> Encoding)

278350 | ToJSONKeyValue (a -> Value, a -> Encoding)

@@ -333,6 +405,18 @@ coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fma

333405 #-}

334406#endif

335407

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+

336420-- | Fail parsing due to a type mismatch, with a descriptive message.

337421--

338422-- Example usage:

@@ -355,3 +439,131 @@ typeMismatch expected actual =

355439 Number _ -> "Number"

356440 Bool _ -> "Boolean"

357441 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 @@

99{-# LANGUAGE PolyKinds #-}

1010#endif

1111

12−#define NEEDS_INCOHERENT

13−#include "overlapping-compat.h"

14−

1512{-# OPTIONS_GHC -fno-warn-orphans #-}

1613

1714-- TODO: Drop this when we remove support for Data.Attoparsec.Number

@@ -38,10 +35,23 @@ module Data.Aeson.Types.Instances

3835 -- ** Keys for maps

3936 , ToJSONKey(..)

4037 , ToJSONKeyFunction(..)

38+ , contramapToJSONKeyFunction

4139 , FromJSONKey(..)

4240 , FromJSONKeyFunction(..)

4341 , fromJSONKeyCoerce

4442 , 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

4555 -- ** Generic JSON classes

4656 , GFromJSON(..)

4757 , GToJSON(..)

@@ -71,10 +81,16 @@ module Data.Aeson.Types.Instances

7181 , tuple

7282 , (>*<)

7383 , typeMismatch

84+

85+ , listEncoding

86+ , listValue

87+ , listParser

7488 ) where

7589

90+import Data.Aeson.Types.Instances.Tuple (tuple, (>*<))

91+

7692import 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)

7894import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)

7995import Data.Aeson.Types.Class

8096import Data.Aeson.Types.Internal

@@ -92,7 +108,7 @@ import Data.Proxy (Proxy(..))

92108import Data.Ratio (Ratio, (%), numerator, denominator)

93109import Data.Scientific (Scientific)

94110import Data.Tagged (Tagged(..))

95−import Data.Text (Text, pack, unpack)

111+import Data.Text (Text, unpack)

96112import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,

97113 ZonedTime)

98114import Data.Time.Format (FormatTime, formatTime, parseTime)

@@ -112,6 +128,7 @@ import qualified Data.HashMap.Strict as H

112128import qualified Data.HashSet as HashSet

113129import qualified Data.IntMap as IntMap

114130import qualified Data.IntSet as IntSet

131+import qualified Data.List.NonEmpty as NE

115132import qualified Data.Map as M

116133import qualified Data.Scientific as Scientific

117134import qualified Data.Sequence as Seq

@@ -125,10 +142,10 @@ import qualified Data.Text.Lazy.Builder.Int as LTBI

125142import qualified Data.Tree as Tree

126143import qualified Data.Vector as V

127144import qualified Data.Vector.Generic as VG

128−import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)

129145import qualified Data.Vector.Primitive as VP

130146import qualified Data.Vector.Storable as VS

131147import qualified Data.Vector.Unboxed as VU

148+import qualified Data.Vector.Mutable as VM

132149

133150import Unsafe.Coerce (unsafeCoerce)

134151

@@ -145,77 +162,209 @@ import Data.Time.Format (defaultTimeLocale)

145162import System.Locale (defaultTimeLocale)

146163#endif

147164

148−parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a

149−parseIndexedJSON idx value = parseJSON value <?> Index idx

165+-------------------------------------------------------------------------------

166+-- Helpers

167+-------------------------------------------------------------------------------

168+

169+parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a

170+parseIndexedJSON p idx value = p value <?> Index idx

171+{-# INLINE parseIndexedJSON #-}

150172

151−parseIndexedJSONPair :: FromJSON b => (Value -> Parser a) -> Int -> Value -> Parser (a, b)

152−parseIndexedJSONPair keyParser idx value = p value <?> Index idx

173+parseIndexedJSONPair :: (Value -> Parser a) -> (Value -> Parser b) -> Int -> Value -> Parser (a, b)

174+parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx

153175 where

154176 p = withArray "(k,v)" $ \ab ->

155177 let n = V.length ab

156178 in if n == 2

157− then (,) <$> parseJSONElemAtIndex' keyParser 0 ab

158− <*> parseJSONElemAtIndex 1 ab

179+ then (,) <$> parseJSONElemAtIndex keyParser 0 ab

180+ <*> parseJSONElemAtIndex valParser 1 ab

159181 else fail $ "cannot unpack array of length " ++

160182 show n ++ " into a pair"

161183

162−toJSONPair :: ToJSON b => (a -> Value) -> (a, b) -> Value

163−toJSONPair keySerialiser (a, b) = Array $ V.create $ do

184+ parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> Vector Value -> Parser a

185+ parseJSONElemAtIndex p' idx' ary = p' (V.unsafeIndex ary idx') <?> Index idx'

186+{-# INLINE parseIndexedJSONPair #-}

187+

188+toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value

189+toJSONPair keySerialiser valSerializer (a, b) = Array $ V.create $ do

164190 mv <- VM.unsafeNew 2

165191 VM.unsafeWrite mv 0 (keySerialiser a)

166− VM.unsafeWrite mv 1 (toJSON b)

192+ VM.unsafeWrite mv 1 (valSerializer b)

167193 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 #-}

168237

169238instance (ToJSON a) => ToJSON (Identity a) where

170− toJSON (Identity a) = toJSON a

239+ toJSON = toJSON1

171240 {-# INLINE toJSON #-}

172241

173− toEncoding (Identity a) = toEncoding a

242+ toEncoding = toEncoding1

174243 {-# INLINE toEncoding #-}

175244

245+instance FromJSON1 Identity where

246+ liftParseJSON p _ a = Identity <$> p a

247+ {-# INLINE liftParseJSON #-}

248+

176249instance (FromJSON a) => FromJSON (Identity a) where

177− parseJSON a = Identity <$> parseJSON a

250+ parseJSON = parseJSON1

178251 {-# INLINE parseJSON #-}

179252

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+

180297instance (ToJSON a) => ToJSON (Maybe a) where

181− toJSON (Just a) = toJSON a

182− toJSON Nothing = Null

298+ toJSON = toJSON1

183299 {-# INLINE toJSON #-}

184300

185− toEncoding (Just a) = toEncoding a

186− toEncoding Nothing = Encoding E.null_

301+ toEncoding = toEncoding1

187302 {-# INLINE toEncoding #-}

188303

304+instance FromJSON1 Maybe where

305+ liftParseJSON _ _ Null = pure Nothing

306+ liftParseJSON p _ a = Just <$> p a

307+ {-# INLINE liftParseJSON #-}

308+

189309instance (FromJSON a) => FromJSON (Maybe a) where

190− parseJSON Null = pure Nothing

191− parseJSON a = Just <$> parseJSON a

310+ parseJSON = parseJSON1

192311 {-# INLINE parseJSON #-}

193312

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+

194337instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where

195− toJSON (Left a) = object [left .= a]

196− toJSON (Right b) = object [right .= b]

338+ toJSON = toJSON2

197339 {-# INLINE toJSON #-}

198340

199− toEncoding (Left a) = Encoding $

200− B.shortByteString "{\"Left\":" <> builder a <> B.char7 '}'

201− toEncoding (Right a) = Encoding $

202− B.shortByteString "{\"Right\":" <> builder a <> B.char7 '}'

341+ toEncoding = toEncoding2

203342 {-# INLINE toEncoding #-}

204343

205−instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where

206− parseJSON (Object (H.toList -> [(key, value)]))

207− | key == left = Left <$> parseJSON value <?> Key left

208− | key == right = Right <$> parseJSON value <?> Key right

209− parseJSON _ = fail $

344+instance FromJSON2 Either where

345+ liftParseJSON2 pA _ pB _ (Object (H.toList -> [(key, value)]))

346+ | key == left = Left <$> pA value <?> Key left

347+ | key == right = Right <$> pB value <?> Key right

348+

349+ liftParseJSON2 _ _ _ _ _ = fail $

210350 "expected an object with a single property " ++

211351 "where the property key should be either " ++

212352 "\"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

213361 {-# INLINE parseJSON #-}

214362

215363left, right :: Text

216364left = "Left"

217365right = "Right"

218366

367+

219368instance ToJSON Bool where

220369 toJSON = Bool

221370 {-# INLINE toJSON #-}

@@ -259,24 +408,19 @@ instance FromJSON () where

259408 else fail "Expected an empty array"

260409 {-# INLINE parseJSON #-}

261410

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−

273411instance ToJSON Char where

274412 toJSON = String . T.singleton

275413 {-# INLINE toJSON #-}

276414

415+ toJSONList = String . T.pack

416+ {-# INLINE toJSONList #-}

417+

277418 toEncoding = Encoding . E.string . (:[])

278419 {-# INLINE toEncoding #-}

279420

421+ toEncodingList = Encoding . E.string

422+ {-# INLINE toEncodingList #-}

423+

280424instance FromJSON Char where

281425 parseJSON = withText "Char" $ \t ->

282426 if T.compareLength t 1 == EQ

@@ -284,16 +428,8 @@ instance FromJSON Char where

284428 else fail "Expected a string of length 1"

285429 {-# INLINE parseJSON #-}

286430

287−instance ToJSON Scientific where

288− toJSON = Number

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 #-}

431+ parseJSONList = withText "String" $ pure . T.unpack

432+ {-# INLINE parseJSONList #-}

297433

298434instance ToJSON Double where

299435 toJSON = realFloatToJSON

@@ -527,45 +663,253 @@ instance FromJSON LT.Text where

527663 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict

528664 {-# INLINE parseJSON #-}

529665

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+

530692instance (ToJSON a) => ToJSON (NonEmpty a) where

531− toJSON = toJSON . toList

693+ toJSON = toJSON1

532694 {-# INLINE toJSON #-}

533695

534− toEncoding = toEncoding . toList

696+ toEncoding = toEncoding1

535697 {-# INLINE toEncoding #-}

536698

537−instance (FromJSON a) => FromJSON (NonEmpty a) where

538− parseJSON = withArray "NonEmpty a" $

539− (>>= ne) . Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList

699+instance FromJSON1 NonEmpty where

700+ liftParseJSON p _ = withArray "NonEmpty a" $

701+ (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList

540702 where

541703 ne [] = fail "Expected a NonEmpty but got an empty list"

542704 ne (x:xs) = pure (x :| xs)

705+ {-# INLINE liftParseJSON #-}

543706

544−instance OVERLAPPABLE_ (ToJSON a) => ToJSON [a] where

545− toJSON = Array . V.fromList . map toJSON

707+instance (FromJSON a) => FromJSON (NonEmpty a) where

708+ parseJSON = parseJSON1

709+ {-# INLINE parseJSON #-}

710+

711+-------------------------------------------------------------------------------

712+-- scientific

713+-------------------------------------------------------------------------------

714+

715+instance ToJSON Scientific where

716+ toJSON = Number

546717 {-# INLINE toJSON #-}

547718

548− toEncoding xs = list xs

719+ toEncoding = Encoding . E.number

549720 {-# INLINE toEncoding #-}

550721

551−instance OVERLAPPABLE_ (FromJSON a) => FromJSON [a] where

552− parseJSON = withArray "[a]" $ Tr.sequence .

553− zipWith parseIndexedJSON [0..] . V.toList

722+instance FromJSON Scientific where

723+ parseJSON = withScientific "Scientific" pure

554724 {-# INLINE parseJSON #-}

555725

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+

556737instance (ToJSON a) => ToJSON (Seq.Seq a) where

557− toJSON = toJSON . toList

738+ toJSON = toJSON1

558739 {-# INLINE toJSON #-}

559740

560− toEncoding = foldable

741+ toEncoding = toEncoding1

561742 {-# INLINE toEncoding #-}

562743

563−instance (FromJSON a) => FromJSON (Seq.Seq a) where

564− parseJSON = withArray "Seq a" $

744+instance FromJSON1 Seq.Seq where

745+ liftParseJSON p _ = withArray "Seq a" $

565746 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

567855 {-# INLINE parseJSON #-}

568856

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+

569913instance (ToJSON a) => ToJSON (Vector a) where

570914 toJSON = Array . V.map toJSON

571915 {-# INLINE toJSON #-}

@@ -582,9 +926,13 @@ encodeVector xs

582926 where go v b = B.char7 ',' <> builder v <> b

583927{-# INLINE encodeVector #-}

584928

929+instance FromJSON1 Vector where

930+ liftParseJSON p _ = withArray "Vector a" $

931+ V.mapM (uncurry $ parseIndexedJSON p) . V.indexed

932+ {-# INLINE liftParseJSON #-}

933+

585934instance (FromJSON a) => FromJSON (Vector a) where

586− parseJSON = withArray "Vector a" $ V.mapM (uncurry parseIndexedJSON) .

587− V.indexed

935+ parseJSON = parseJSON1

588936 {-# INLINE parseJSON #-}

589937

590938vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value

@@ -592,7 +940,7 @@ vectorToJSON = Array . V.map toJSON . V.convert

592940{-# INLINE vectorToJSON #-}

593941

594942vectorParseJSON :: (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

596944{-# INLINE vectorParseJSON #-}

597945

598946instance (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

627975 parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"

628976 {-# INLINE parseJSON #-}

629977

630−instance (ToJSON a) => ToJSON (Set.Set a) where

631− toJSON = toJSON . Set.toList

632− {-# INLINE toJSON #-}

978+-------------------------------------------------------------------------------

979+-- unordered-containers

980+-------------------------------------------------------------------------------

633981

634− toEncoding = encodeSet Set.minView Set.foldr

635− {-# INLINE toEncoding #-}

982+instance ToJSON1 HashSet.HashSet where

983+ liftToJSON to _ = listValue to . HashSet.toList

984+ {-# INLINE liftToJSON #-}

636985

637−instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where

638− parseJSON = fmap Set.fromList . parseJSON

639− {-# INLINE parseJSON #-}

986+ liftToEncoding to _ = listEncoding to . HashSet.toList

987+ {-# INLINE liftToEncoding #-}

640988

641989instance (ToJSON a) => ToJSON (HashSet.HashSet a) where

642− toJSON = toJSON . HashSet.toList

990+ toJSON = toJSON1

643991 {-# INLINE toJSON #-}

644992

645− toEncoding = foldable

993+ toEncoding = toEncoding1

646994 {-# INLINE toEncoding #-}

647995

648996instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where

649997 parseJSON = fmap HashSet.fromList . parseJSON

650998 {-# INLINE parseJSON #-}

651999

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 #-}

6811000

682−instance FromJSON a => FromJSON (IntMap.IntMap a) 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

714− ToJSONKeyText (f,_) -> Object . mapHashKeyVal f toJSON

715− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f) . M.toList

716− {-# INLINE toJSON #-}

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 #-}

1001+instance ToJSONKey k => ToJSON1 (H.HashMap k) where

1002+ liftToJSON g _ = case toJSONKey of

1003+ ToJSONKeyText (f,_) -> Object . mapKeyVal f g

1004+ ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList

1005+ {-# INLINE liftToJSON #-}

7241006

725−instance (FromJSON v, FromJSONKey k, Ord k) => FromJSON (M.Map k v) where

726− parseJSON = case fromJSONKey of

727− FromJSONKeyCoerce _-> withObject "Map k v" $

728− fmap (H.foldrWithKey (M.insert . unsafeCoerce) M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

729− FromJSONKeyText f -> withObject "Map k v" $

730− fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

731− FromJSONKeyTextParser f -> withObject "Map k v" $

732− H.foldrWithKey (\k v m -> M.insert <$> f k <*> (parseJSON v <?> Key k) <*> m) (pure M.empty)

733− FromJSONKeyValue f -> withArray "Map k v" $ \arr ->

734− M.fromList <$> (Tr.sequence .

735− zipWith (parseIndexedJSONPair f) [0..] . V.toList $ arr)

736− {-# INLINE parseJSON #-}

1007+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding

1008+ liftToEncoding g _ = case toJSONKey of

1009+ ToJSONKeyText (_,f) -> encodeWithKey f g H.foldrWithKey

1010+ ToJSONKeyValue (_,f) -> list (pairEncoding f) . H.toList

1011+ where

1012+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding

1013+ pairEncoding f (a, b) = tuple $ fromEncoding (f a) >*< builder' g b

1014+ {-# INLINE liftToEncoding #-}

7371015

7381016instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where

739− toJSON = case toJSONKey of

740− ToJSONKeyText (f,_) -> Object . mapKeyVal f toJSON

741− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f) . H.toList

1017+ toJSON = toJSON1

7421018 {-# INLINE toJSON #-}

7431019

744− toEncoding = case toJSONKey of

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

1020+ toEncoding = toEncoding1

7491021 {-# INLINE toEncoding #-}

7501022

751−instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where

752− parseJSON = case fromJSONKey of

1023+instance (FromJSONKey k, Eq k, Hashable k) => FromJSON1 (H.HashMap k) where

1024+ liftParseJSON p _ = case fromJSONKey of

7531025 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)

7551027 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)

7571029 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)

7591031 FromJSONKeyValue f -> withArray "Map k v" $ \arr ->

7601032 H.fromList <$> (Tr.sequence .

761− zipWith (parseIndexedJSONPair f) [0..] . V.toList $ arr)

1033+ zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr)

7621034 where

7631035 uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)

7641036 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 #-}

7701037

771− toEncoding (Tree.Node root branches) = toEncoding (root,branches)

772− {-# INLINE toEncoding #-}

773−

774−instance (FromJSON v) => FromJSON (Tree.Tree v) where

775− parseJSON j = uncurry Tree.Node <$> parseJSON j

1038+instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where

1039+ parseJSON = parseJSON1

7761040 {-# INLINE parseJSON #-}

7771041

1042+-------------------------------------------------------------------------------

1043+-- aeson

1044+-------------------------------------------------------------------------------

1045+

7781046instance ToJSON Value where

7791047 toJSON a = a

7801048 {-# INLINE toJSON #-}

@@ -783,7 +1051,7 @@ instance ToJSON Value where

7831051 {-# INLINE toEncoding #-}

7841052

7851053instance FromJSON Value where

786− parseJSON a = pure a

1054+ parseJSON = pure

7871055 {-# INLINE parseJSON #-}

7881056

7891057instance ToJSON DotNetTime where

@@ -804,6 +1072,10 @@ instance FromJSON DotNetTime where

8041072 _ -> fail "could not parse .NET time"

8051073 {-# INLINE parseJSON #-}

8061074

1075+-------------------------------------------------------------------------------

1076+-- time

1077+-------------------------------------------------------------------------------

1078+

8071079instance ToJSON Day where

8081080 toJSON = stringEncoding

8091081 toEncoding z = Encoding (E.quote $ E.day z)

@@ -864,715 +1136,81 @@ instance FromJSON NominalDiffTime where

8641136 parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac

8651137 {-# INLINE parseJSON #-}

8661138

867−parseJSONElemAtIndex :: FromJSON a => Int -> Vector Value -> Parser a

868−parseJSONElemAtIndex = parseJSONElemAtIndex' parseJSON

869−

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 #-}

1139+-------------------------------------------------------------------------------

1140+-- base Monoid/Semigroup

1141+-------------------------------------------------------------------------------

11811142

1182− toEncoding (a,b,c,d,e,f,g,h,i,j) = tuple $

1183− builder a >*<

1184− builder b >*<

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 #-}

1143+instance ToJSON1 Dual where

1144+ liftToJSON to _ = to . getDual

1145+ {-# INLINE liftToJSON #-}

11941146

1195−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1196− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) =>

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 #-}

1147+ liftToEncoding to _ = to . getDual

1148+ {-# INLINE liftToEncoding #-}

12341149

1235− toEncoding (a,b,c,d,e,f,g,h,i,j,k) = tuple $

1236− builder a >*<

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

1150+instance ToJSON a => ToJSON (Dual a) where

1151+ toJSON = toJSON1

12901152 {-# INLINE toJSON #-}

12911153

1292− toEncoding (a,b,c,d,e,f,g,h,i,j,k,l) = tuple $

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

1154+ toEncoding = toEncoding1

13051155 {-# INLINE toEncoding #-}

13061156

1307−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1308− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

1309− FromJSON k, FromJSON l) =>

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 #-}

1157+instance FromJSON1 Dual where

1158+ liftParseJSON p _ = fmap Dual . p

1159+ {-# INLINE liftParseJSON #-}

13681160

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

1373− parseJSON = withArray "(a,b,c,d,e,f,g,h,i,j,k,l,m)" $ \ary ->

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

1161+instance FromJSON a => FromJSON (Dual a) where

1162+ parseJSON = parseJSON1

13921163 {-# INLINE parseJSON #-}

13931164

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 #-}

14161165

1417− toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = tuple $

1418− builder a >*<

1419− builder b >*<

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 #-}

1166+instance ToJSON1 First where

1167+ liftToJSON to to' = liftToJSON to to' . getFirst

1168+ {-# INLINE liftToJSON #-}

14331169

1434−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1435− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

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 #-}

1170+ liftToEncoding to to' = liftToEncoding to to' . getFirst

1171+ {-# INLINE liftToEncoding #-}

14591172

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

1464− toJSON (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = Array $ V.create $ do

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

1173+instance ToJSON a => ToJSON (First a) where

1174+ toJSON = toJSON1

14821175 {-# INLINE toJSON #-}

14831176

1484− toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = tuple $

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

1177+ toEncoding = toEncoding1

15001178 {-# INLINE toEncoding #-}

15011179

1502−instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1503− FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

1504− FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) =>

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 #-}

1180+instance FromJSON1 First where

1181+ liftParseJSON p p' = fmap First . liftParseJSON p p'

1182+ {-# INLINE liftParseJSON #-}

15351183

1536−instance FromJSON a => FromJSON (Dual a) where

1537− parseJSON = fmap Dual . parseJSON

1184+instance FromJSON a => FromJSON (First a) where

1185+ parseJSON = parseJSON1

15381186 {-# INLINE parseJSON #-}

15391187

1540−instance ToJSON a => ToJSON (First a) where

1541− toJSON = toJSON . getFirst

1542− {-# INLINE toJSON #-}

15431188

1544− toEncoding = toEncoding . getFirst

1545− {-# INLINE toEncoding #-}

1189+instance ToJSON1 Last where

1190+ liftToJSON to to' = liftToJSON to to' . getLast

1191+ {-# INLINE liftToJSON #-}

15461192

1547−instance FromJSON a => FromJSON (First a) where

1548− parseJSON = fmap First . parseJSON

1549− {-# INLINE parseJSON #-}

1193+ liftToEncoding to to' = liftToEncoding to to' . getLast

1194+ {-# INLINE liftToEncoding #-}

15501195

15511196instance ToJSON a => ToJSON (Last a) where

1552− toJSON = toJSON . getLast

1197+ toJSON = toJSON1

15531198 {-# INLINE toJSON #-}

15541199

1555− toEncoding = toEncoding . getLast

1200+ toEncoding = toEncoding1

15561201 {-# INLINE toEncoding #-}

15571202

1203+instance FromJSON1 Last where

1204+ liftParseJSON p p' = fmap Last . liftParseJSON p p'

1205+ {-# INLINE liftParseJSON #-}

1206+

15581207instance FromJSON a => FromJSON (Last a) where

1559− parseJSON = fmap Last . parseJSON

1208+ parseJSON = parseJSON1

15601209 {-# INLINE parseJSON #-}

15611210

1562−instance ToJSON Version where

1563− toJSON = toJSON . showVersion

1564− {-# INLINE toJSON #-}

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"

1211+-------------------------------------------------------------------------------

1212+-- tagged

1213+-------------------------------------------------------------------------------

15761214

15771215instance ToJSON (Proxy a) where

15781216 toJSON _ = Null

@@ -1586,46 +1224,42 @@ instance FromJSON (Proxy a) where

15861224 parseJSON Null = pure Proxy

15871225 parseJSON v = typeMismatch "Proxy" v

15881226

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+

15891235instance ToJSON b => ToJSON (Tagged a b) where

1590− toJSON (Tagged x) = toJSON x

1236+ toJSON = toJSON1

15911237 {-# INLINE toJSON #-}

15921238

1593− toEncoding (Tagged x) = toEncoding x

1239+ toEncoding = toEncoding1

15941240 {-# INLINE toEncoding #-}

15951241

1242+instance FromJSON1 (Tagged a) where

1243+ liftParseJSON p _ = fmap Tagged . p

1244+ {-# INLINE liftParseJSON #-}

1245+

15961246instance FromJSON b => FromJSON (Tagged a b) where

1247+ parseJSON = parseJSON1

15971248 {-# INLINE parseJSON #-}

1598− parseJSON = fmap Tagged . parseJSON

15991249

1600−instance ToJSON a => ToJSON (Const a b) where

1601− toJSON (Const x) = toJSON x

1602− {-# INLINE toJSON #-}

1603−

1604− toEncoding (Const x) = toEncoding x

1605− {-# INLINE toEncoding #-}

1250+instance FromJSONKey b => FromJSONKey (Tagged a b) where

1251+ fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)

1252+ fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList

16061253

1607−instance FromJSON a => FromJSON (Const a b) where

1608− {-# INLINE parseJSON #-}

1609− parseJSON = fmap Const . parseJSON

1254+instance ToJSONKey b => ToJSONKey (Tagged a b) where

1255+ toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey

1256+ toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList

16101257

1611−--------------------------------------------

1258+-------------------------------------------------------------------------------

16121259-- Instances for converting to/from map keys

1613−--------------------------------------------

1614−class ToJSONKey a where

1615− toJSONKey :: ToJSONKeyFunction a

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

1260+-------------------------------------------------------------------------------

1261+

1262+

16291263

16301264instance ToJSONKey Text where

16311265 toJSONKey = ToJSONKeyText (id,toEncoding)

@@ -1633,10 +1267,7 @@ instance ToJSONKey Text where

16331267instance FromJSONKey Text where

16341268 fromJSONKey = fromJSONKeyCoerce

16351269

1636−-- | TODO: where ToJSONKey instance

1637−instance FromJSONKey b => FromJSONKey (Tagged a b) where

1638− fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)

1639− fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList

1270+

16401271

16411272instance ToJSONKey Bool where

16421273 toJSONKey = ToJSONKeyText

@@ -1690,13 +1321,9 @@ instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where

16901321instance (FromJSONKey a, FromJSON a) => FromJSONKey (Identity a) where

16911322 fromJSONKey = mapFromJSONKeyFunction Identity fromJSONKey

16921323

1693−contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b

1694−contramapToJSONKeyFunction h x = case x of

1695− ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)

1696− ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)

1697−

1698−mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b

1699−mapFromJSONKeyFunction = fmap

1324+-------------------------------------------------------------------------------

1325+-- Functions

1326+-------------------------------------------------------------------------------

17001327

17011328-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@

17021329-- and fails using @'typeMismatch' expected@ otherwise.

@@ -1819,34 +1446,3 @@ obj .:! key = case H.lookup key obj of

18191446(.!=) :: Parser (Maybe a) -> a -> Parser a

18201447pmval .!= val = fromMaybe val <$> pmval

18211448{-# 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

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

8585 Data.Aeson.Types.Class

8686 Data.Aeson.Types.Generic

8787 Data.Aeson.Types.Instances

88+ Data.Aeson.Types.Instances.Tuple

8889 Data.Aeson.Types.Internal

8990

9091 build-depends:

benchmarks/aeson-benchmarks.cabal+1

@@ -30,6 +30,7 @@ library

3030 Data.Aeson.Types.Generic

3131 Data.Aeson.Types.Instances

3232 Data.Aeson.Types.Internal

33+ Data.Aeson.Types.Instances.Tuple

3334

3435 build-depends:

3536 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

33# 0.12.0.0

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`.

9+* Added higher rank classes: `ToJSON1`, `ToJSON2`, `FromJSON1`, and `FromJSON2`

10+

511* Modified instances for `Map` and `HashMap`. Introduced new `FromJSONKey` and

612 `ToJSONKey` type classes.

713

tests/UnitTests.hs+9−2

@@ -1,4 +1,7 @@

11{-# LANGUAGE CPP, DeriveGeneric, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}

2+#if __GLASGOW_HASKELL__ >= 708

3+{-# LANGUAGE DataKinds #-}

4+#endif

36{-# OPTIONS_GHC -fno-warn-deprecations #-}

@@ -233,6 +236,10 @@ jsonEncoding = [

233236 , assertEqual "Just Nothing" "null" $ encode (Just Nothing :: Maybe (Maybe Int))

234237 , assertEqual "Proxy Int" "null" $ encode (Proxy :: Proxy Int)

235238 , 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

236243 , assertEqual "Const Char Int" "\"c\"" $ encode (Const 'c' :: Const Char Int)

237244 , assertEqual "Tuple" "[1,2]" $ encode ((1, 2) :: (Int, Int))

238245 , assertEqual "NonEmpty" "[1,2,3]" $ encode (1 :| [2, 3] :: NonEmpty Int)

@@ -288,8 +295,8 @@ overlappingRegression bs = fromMaybe [] $ decode bs

288295issue351 :: [Assertion]

289296issue351 = [

290297 assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"

291− , assertEqual "Char" ("" :: String) $ overlappingRegression "\"abc\""

292− , assertEqual "Char" ("abc" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"

298+ , assertEqual "Char" ("abc" :: String) $ overlappingRegression "\"abc\""

299+ , assertEqual "Char" ("" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"

293300 ]

294301

295302------------------------------------------------------------------------------

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+-}

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