@@ -5,19 +5,16 @@
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE GADTs #-}
6{-# LANGUAGE GADTs #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE NamedFieldPuns #-}
9{-# LANGUAGE NoImplicitPrelude #-}
8{-# LANGUAGE NoImplicitPrelude #-}
10{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE PolyKinds #-}
11{-# LANGUAGE RecordWildCards #-}
11{-# LANGUAGE RecordWildCards #-}
12{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE TypeOperators #-}
14+{-# LANGUAGE TupleSections #-}
14{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE ViewPatterns #-}
16{-# LANGUAGE ViewPatterns #-}
17−#if __GLASGOW_HASKELL__ >= 706
18−{-# LANGUAGE PolyKinds #-}
21#include "incoherent-compat.h"
18#include "incoherent-compat.h"
22#include "overlapping-compat.h"
19#include "overlapping-compat.h"
@@ -121,9 +118,9 @@ import GHC.Generics
121import Numeric.Natural (Natural)
118import Numeric.Natural (Natural)
122import Text.ParserCombinators.ReadP (readP_to_S)
119import Text.ParserCombinators.ReadP (readP_to_S)
123import Unsafe.Coerce (unsafeCoerce)
120import Unsafe.Coerce (unsafeCoerce)
124−import qualified Data.Aeson.Compat as Compat
125import qualified Data.Aeson.Parser.Time as Time
121import qualified Data.Aeson.Parser.Time as Time
126import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
122import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
123+import qualified Data.ByteString.Lazy as L
127import qualified Data.DList as DList
124import qualified Data.DList as DList
128import qualified Data.HashMap.Strict as H
125import qualified Data.HashMap.Strict as H
129import qualified Data.HashSet as HashSet
126import qualified Data.HashSet as HashSet
@@ -158,18 +155,8 @@ import qualified Data.Primitive.UnliftedArray as PM
158import qualified Data.Primitive.PrimArray as PM
155import qualified Data.Primitive.PrimArray as PM
161−#ifndef HAS_COERCIBLE
162−#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)
166import Data.Coerce (Coercible, coerce)
159import Data.Coerce (Coercible, coerce)
167−coerce' :: Coercible a b => a -> b
171−coerce' = unsafeCoerce
174parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
161parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
175parseIndexedJSON p idx value = p value <?> Index idx
162parseIndexedJSON p idx value = p value <?> Index idx
@@ -441,11 +428,7 @@ class FromJSONKey a where
441-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'
428-- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'
442-- can be inspected, but cannot be constructed.
429-- can be inspected, but cannot be constructed.
443data CoerceText a where
430data CoerceText a where
445 CoerceText :: Coercible Text a => CoerceText a
431 CoerceText :: Coercible Text a => CoerceText a
447− CoerceText :: CoerceText a
450-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the
433-- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the
451-- 'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'
434-- 'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'
@@ -465,7 +448,7 @@ data FromJSONKeyFunction a
466-- | Only law abiding up to interpretation
449-- | Only law abiding up to interpretation
467instance Functor FromJSONKeyFunction where
450instance Functor FromJSONKeyFunction where
468− fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce')
451+ fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce)
469 fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)
452 fmap h (FromJSONKeyText f) = FromJSONKeyText (h . f)
470 fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)
453 fmap h (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap h . f)
471 fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)
454 fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f)
@@ -479,9 +462,7 @@ instance Functor FromJSONKeyFunction where
480-- On pre GHC 7.8 this is unconstrainted function.
463-- On pre GHC 7.8 this is unconstrainted function.
481fromJSONKeyCoerce ::
464fromJSONKeyCoerce ::
483 Coercible Text a =>
465 Coercible Text a =>
485 FromJSONKeyFunction a
466 FromJSONKeyFunction a
486fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
467fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
@@ -489,29 +470,18 @@ fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
490-- See note on 'fromJSONKeyCoerce'.
471-- See note on 'fromJSONKeyCoerce'.
491coerceFromJSONKeyFunction ::
472coerceFromJSONKeyFunction ::
493 Coercible a b =>
473 Coercible a b =>
495 FromJSONKeyFunction a -> FromJSONKeyFunction b
474 FromJSONKeyFunction a -> FromJSONKeyFunction b
497coerceFromJSONKeyFunction = coerce
475coerceFromJSONKeyFunction = coerce
499−coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText
500−coerceFromJSONKeyFunction (FromJSONKeyText f) = FromJSONKeyText (coerce' . f)
501−coerceFromJSONKeyFunction (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap coerce' . f)
502−coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fmap coerce' . f)
506 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).
478 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).
507 fmap id x = x
479 fmap id x = x
511 "FromJSONKeyCoerce: fmap coerce" forall x .
482 "FromJSONKeyCoerce: fmap coerce" forall x .
512 fmap coerce x = coerceFromJSONKeyFunction x
483 fmap coerce x = coerceFromJSONKeyFunction x
516-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.
486-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.
517mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
487mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
@@ -798,13 +768,13 @@ withBoundedScientific' f v = withBoundedScientific_ id f v
798-- | A variant of 'withBoundedScientific_' parameterized by a function to apply
768-- | A variant of 'withBoundedScientific_' parameterized by a function to apply
799-- to the 'Parser' in case of failure.
769-- to the 'Parser' in case of failure.
800withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
770withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
801−withBoundedScientific_ whenFail f v@(Number scientific) =
771+withBoundedScientific_ whenFail f (Number scientific) =
802− if exponent > 1024
772+ if exp10 > 1024
803 then whenFail (fail msg)
773 then whenFail (fail msg)
804 else f scientific
774 else f scientific
806− exponent = base10Exponent scientific
776+ exp10 = base10Exponent scientific
807− msg = "found a number with exponent " ++ show exponent ++ ", but it must not be greater than 1024"
777+ msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024"
808withBoundedScientific_ whenFail _ v =
778withBoundedScientific_ whenFail _ v =
809 whenFail (typeMismatch "Number" v)
779 whenFail (typeMismatch "Number" v)
810{-# INLINE withBoundedScientific_ #-}
780{-# INLINE withBoundedScientific_ #-}
@@ -824,7 +794,7 @@ withBool name _ v = prependContext name (typeMismatch "Boolean" v)
824-- | Decode a nested JSON-encoded string.
794-- | Decode a nested JSON-encoded string.
825withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
795withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
826withEmbeddedJSON _ innerParser (String txt) =
796withEmbeddedJSON _ innerParser (String txt) =
827− either fail innerParser $ eitherDecode (Compat.fromStrict $ T.encodeUtf8 txt)
797+ either fail innerParser $ eitherDecode (L.fromStrict $ T.encodeUtf8 txt)
829 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
799 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
830 eitherFormatError = either (Left . uncurry formatError) Right
800 eitherFormatError = either (Left . uncurry formatError) Right
@@ -893,7 +863,7 @@ parseFieldMaybe' = (.:!)
893-- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@
863-- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@
894explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
864explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
895explicitParseField p obj key = case H.lookup key obj of
865explicitParseField p obj key = case H.lookup key obj of
896− Nothing -> fail $ "key " ++ show key ++ " not present"
866+ Nothing -> fail $ "key " ++ show key ++ " not found"
897 Just v -> p v <?> Key key
867 Just v -> p v <?> Key key
898{-# INLINE explicitParseField #-}
868{-# INLINE explicitParseField #-}
@@ -952,6 +922,16 @@ type ConName = String
952contextType :: TypeName -> Parser a -> Parser a
922contextType :: TypeName -> Parser a -> Parser a
953contextType = prependContext
923contextType = prependContext
925+-- | Add the tagKey that will be looked up while building an ADT
926+-- | Produce the error equivalent to
927+-- | Left "Error in $: parsing T failed, expected an object with keys "tag" and
928+-- | "contents", where "tag" i-- |s associated to one of ["Foo", "Bar"],
929+-- | The parser returned error was: could not find key "tag"
930+contextTag :: Text -> [String] -> Parser a -> Parser a
931+contextTag tagKey cnames = prependFailure
932+ ("expected Object with key \"" ++ unpack tagKey ++ "\"" ++
933+ " containing one of " ++ show cnames ++ ", ")
955-- | Add the name of the constructor being parsed to a parser's error messages.
935-- | Add the name of the constructor being parsed to a parser's error messages.
956contextCons :: ConName -> TypeName -> Parser a -> Parser a
936contextCons :: ConName -> TypeName -> Parser a -> Parser a
957contextCons cname tname = prependContext (showCons cname tname)
937contextCons cname tname = prependContext (showCons cname tname)
@@ -1130,8 +1110,8 @@ instance ConstructorNames a => ConstructorNames (D1 d a) where
1130 retag (Tagged2 x) = Tagged2 x
1110 retag (Tagged2 x) = Tagged2 x
1132--------------------------------------------------------------------------------
1112--------------------------------------------------------------------------------
1134−parseNonAllNullarySum :: ( FromPair arity f
1113+parseNonAllNullarySum :: forall f c arity.
1135 , FromTaggedObject arity f
1115 , FromTaggedObject arity f
1136 , FromUntaggedValue arity f
1116 , FromUntaggedValue arity f
1137 , ConstructorNames f
1117 , ConstructorNames f
@@ -1141,7 +1121,7 @@ parseNonAllNullarySum p@(tname :* opts :* _) =
1141 case sumEncoding opts of
1121 case sumEncoding opts of
1142 TaggedObject{..} ->
1122 TaggedObject{..} ->
1143 withObject tname $ \obj -> do
1123 withObject tname $ \obj -> do
1144− tag <- contextType tname $ obj .: tagKey
1124+ tag <- contextType tname . contextTag tagKey cnames_ $ obj .: tagKey
1145 fromMaybe (badTag tag <?> Key tagKey) $
1125 fromMaybe (badTag tag <?> Key tagKey) $
1146 parseFromTaggedObject (tag :* contentsFieldName :* p) obj
1126 parseFromTaggedObject (tag :* contentsFieldName :* p) obj
@@ -1149,6 +1129,7 @@ parseNonAllNullarySum p@(tname :* opts :* _) =
1149 badTag tag = failWith_ $ \cnames ->
1129 badTag tag = failWith_ $ \cnames ->
1150 "expected tag field to be one of " ++ show cnames ++
1130 "expected tag field to be one of " ++ show cnames ++
1151 ", but found tag " ++ show tag
1131 ", but found tag " ++ show tag
1132+ cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String])
1153 ObjectWithSingleField ->
1134 ObjectWithSingleField ->
1154 withObject tname $ \obj -> case H.toList obj of
1135 withObject tname $ \obj -> case H.toList obj of
@@ -1220,9 +1201,9 @@ class FromTaggedObject' arity f isRecord where
1220 :: String :* ConName :* TypeName :* Options :* FromArgs arity a
1201 :: String :* ConName :* TypeName :* Options :* FromArgs arity a
1221 -> Object -> Tagged isRecord (Parser (f a))
1202 -> Object -> Tagged isRecord (Parser (f a))
1223−instance (RecordFromJSON arity f) => FromTaggedObject' arity f True where
1204+instance (RecordFromJSON arity f, FieldNames f) => FromTaggedObject' arity f True where
1224 -- Records are unpacked in the tagged object
1205 -- Records are unpacked in the tagged object
1225− parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON p
1206+ parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON (True :* p)
1227instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where
1208instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where
1228 -- Nonnullary nonrecords are encoded in the contents field
1209 -- Nonnullary nonrecords are encoded in the contents field
@@ -1263,11 +1244,11 @@ instance OVERLAPPING_
1263 ) => ConsFromJSON' arity (S1 s a) True where
1244 ) => ConsFromJSON' arity (S1 s a) True where
1264 consParseJSON' p@(cname :* tname :* opts :* fargs)
1245 consParseJSON' p@(cname :* tname :* opts :* fargs)
1265 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs
1246 | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs
1266− | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON p)
1247+ | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))
1268instance RecordFromJSON arity f => ConsFromJSON' arity f True where
1249instance RecordFromJSON arity f => ConsFromJSON' arity f True where
1269 consParseJSON' p@(cname :* tname :* _) =
1250 consParseJSON' p@(cname :* tname :* _) =
1270− Tagged . withObject (showCons cname tname) (recordParseJSON p)
1251+ Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))
1272instance OVERLAPPING_
1253instance OVERLAPPING_
1273 ConsFromJSON' arity U1 False where
1254 ConsFromJSON' arity U1 False where
@@ -1293,21 +1274,55 @@ instance (ProductFromJSON arity f, ProductSize f
1294--------------------------------------------------------------------------------
1275--------------------------------------------------------------------------------
1277+class FieldNames f where
1278+ fieldNames :: f a -> [Text] -> [Text]
1280+instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where
1282+ fieldNames (undefined :: a x) .
1283+ fieldNames (undefined :: b y)
1285+instance (Selector s) => FieldNames (S1 s f) where
1286+ fieldNames _ = (pack (selName (undefined :: M1 _i s _f _p)) :)
1296class RecordFromJSON arity f where
1288class RecordFromJSON arity f where
1297 recordParseJSON
1289 recordParseJSON
1290+ :: Bool :* ConName :* TypeName :* Options :* FromArgs arity a
1291+ -> Object -> Parser (f a)
1293+instance ( FieldNames f
1294+ , RecordFromJSON' arity f
1295+ ) => RecordFromJSON arity f where
1296+ recordParseJSON (fromTaggedSum :* p@(cname :* tname :* opts :* _)) =
1297+ \obj -> checkUnknown obj >> recordParseJSON' p obj
1299+ knownFields :: H.HashMap Text ()
1300+ knownFields = H.fromList $ map (,()) $
1301+ fieldNames (undefined :: f a)
1302+ [pack (tagFieldName (sumEncoding opts)) | fromTaggedSum]
1304+ if not (rejectUnknownFields opts)
1305+ then \_ -> return ()
1306+ else \obj -> case H.keys (H.difference obj knownFields) of
1308+ unknownFields -> contextCons cname tname $
1309+ fail ("unknown fields: " ++ show unknownFields)
1311+class RecordFromJSON' arity f where
1298 :: ConName :* TypeName :* Options :* FromArgs arity a
1313 :: ConName :* TypeName :* Options :* FromArgs arity a
1299 -> Object -> Parser (f a)
1314 -> Object -> Parser (f a)
1301−instance ( RecordFromJSON arity a
1316+instance ( RecordFromJSON' arity a
1302− , RecordFromJSON arity b
1317+ , RecordFromJSON' arity b
1303− ) => RecordFromJSON arity (a :*: b) where
1318+ ) => RecordFromJSON' arity (a :*: b) where
1304− recordParseJSON p obj =
1319+ recordParseJSON' p obj =
1305− (:*:) <$> recordParseJSON p obj
1320+ (:*:) <$> recordParseJSON' p obj
1306− <*> recordParseJSON p obj
1321+ <*> recordParseJSON' p obj
1308instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
1323instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
1309− RecordFromJSON arity (S1 s a) where
1324+ RecordFromJSON' arity (S1 s a) where
1310− recordParseJSON (cname :* tname :* opts :* fargs) obj = do
1325+ recordParseJSON' (cname :* tname :* opts :* fargs) obj = do
1311 fv <- contextCons cname tname (obj .: label)
1326 fv <- contextCons cname tname (obj .: label)
1312 M1 <$> gParseJSON opts fargs fv <?> Key label
1327 M1 <$> gParseJSON opts fargs fv <?> Key label
@@ -1315,16 +1330,16 @@ instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
1315 sname = selName (undefined :: M1 _i s _f _p)
1330 sname = selName (undefined :: M1 _i s _f _p)
1317instance INCOHERENT_ (Selector s, FromJSON a) =>
1332instance INCOHERENT_ (Selector s, FromJSON a) =>
1318− RecordFromJSON arity (S1 s (K1 i (Maybe a))) where
1333+ RecordFromJSON' arity (S1 s (K1 i (Maybe a))) where
1319− recordParseJSON (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label
1334+ recordParseJSON' (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label
1321 label = fieldLabelModifier opts sname
1336 label = fieldLabelModifier opts sname
1322 sname = selName (undefined :: M1 _i s _f _p)
1337 sname = selName (undefined :: M1 _i s _f _p)
1324-- Parse an Option like a Maybe.
1339-- Parse an Option like a Maybe.
1325instance INCOHERENT_ (Selector s, FromJSON a) =>
1340instance INCOHERENT_ (Selector s, FromJSON a) =>
1326− RecordFromJSON arity (S1 s (K1 i (Semigroup.Option a))) where
1341+ RecordFromJSON' arity (S1 s (K1 i (Semigroup.Option a))) where
1327− recordParseJSON p obj = wrap <$> recordParseJSON p obj
1342+ recordParseJSON' p obj = wrap <$> recordParseJSON' p obj
1329 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p
1344 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p
1330 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))
1345 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))
@@ -1561,12 +1576,22 @@ instance FromJSONKey Float where
1561 _ -> Scientific.toRealFloat <$> parseScientificText t
1576 _ -> Scientific.toRealFloat <$> parseScientificText t
1563instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
1578instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
1579+ parseJSON (Number x)
1581+ , exp10 >= -1024 = return $! realToFrac x
1582+ | otherwise = prependContext "Ratio" $ fail msg
1584+ exp10 = base10Exponent x
1585+ msg = "found a number with exponent " ++ show exp10
1586+ ++ ", but it must not be greater than 1024 or less than -1024"
1587+ parseJSON o = objParser o
1564− parseJSON = withObject "Rational" $ \obj -> do
1589+ objParser = withObject "Rational" $ \obj -> do
1565− numerator <- obj .: "numerator"
1590+ numerator <- obj .: "numerator"
1566− denominator <- obj .: "denominator"
1591+ denominator <- obj .: "denominator"
1567− if denominator == 0
1592+ if denominator == 0
1568− then fail "Ratio denominator was 0"
1593+ then fail "Ratio denominator was 0"
1569− else pure $ numerator % denominator
1594+ else pure $ numerator % denominator
1570 {-# INLINE parseJSON #-}
1595 {-# INLINE parseJSON #-}
1572-- | This instance includes a bounds check to prevent maliciously
1597-- | This instance includes a bounds check to prevent maliciously
@@ -1981,7 +2006,6 @@ instance FromJSON DotNetTime where
1981-- primitive
2006-- primitive
1982-------------------------------------------------------------------------------
2007-------------------------------------------------------------------------------
1984−#if MIN_VERSION_base(4,7,0)
1985instance FromJSON a => FromJSON (PM.Array a) where
2009instance FromJSON a => FromJSON (PM.Array a) where
1986 -- note: we could do better than this if vector exposed the data
2010 -- note: we could do better than this if vector exposed the data
1987 -- constructor in Data.Vector.
2011 -- constructor in Data.Vector.
@@ -1999,7 +2023,6 @@ instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where
1999 parseJSON = fmap Exts.fromList . parseJSON
2023 parseJSON = fmap Exts.fromList . parseJSON
2004-------------------------------------------------------------------------------
2027-------------------------------------------------------------------------------