@@ -61,6 +61,7 @@ module Data.Aeson.Types.FromJSON
6161 , fromJSON
6262 , ifromJSON
6363 , typeMismatch
64+ , unexpected
6465 , parseField
6566 , parseFieldMaybe
6667 , parseFieldMaybe'
@@ -170,7 +171,7 @@ parseIndexedJSON p idx value = p value <?> Index idx
170171parseIndexedJSONPair :: (Value -> Parser a) -> (Value -> Parser b) -> Int -> Value -> Parser (a, b)
171172parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx
172173 where
173− p = withArray "(k,v)" $ \ab ->
174+ p = withArray "(k, v)" $ \ab ->
174175 let n = V.length ab
175176 in if n == 2
176177 then (,) <$> parseJSONElemAtIndex keyParser 0 ab
@@ -183,33 +184,33 @@ parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
183184parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx
184185
185186parseRealFloat :: RealFloat a => String -> Value -> Parser a
186−parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
187−parseRealFloat _ Null = pure (0/0)
188−parseRealFloat expected v = typeMismatch expected v
187+parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
188+parseRealFloat _ Null = pure (0/0)
189+parseRealFloat name v = prependContext name (unexpected v)
189190{-# INLINE parseRealFloat #-}
190191
191−parseIntegralFromScientific :: forall a. Integral a => String -> Scientific -> Parser a
192−parseIntegralFromScientific expected s =
192+parseIntegralFromScientific :: forall a. Integral a => Scientific -> Parser a
193+parseIntegralFromScientific s =
193194 case Scientific.floatingOrInteger s :: Either Double a of
194195 Right x -> pure x
195− Left _ -> fail $ "expected " ++ expected ++ ", encountered floating number " ++ show s
196+ Left _ -> fail $ "unexpected floating number " ++ show s
196197{-# INLINE parseIntegralFromScientific #-}
197198
198199parseIntegral :: Integral a => String -> Value -> Parser a
199−parseIntegral expected =
200− withBoundedScientific expected $ parseIntegralFromScientific expected
200+parseIntegral name =
201+ prependContext name . withBoundedScientific' parseIntegralFromScientific
201202{-# INLINE parseIntegral #-}
202203
203−parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => String -> Scientific -> Parser a
204−parseBoundedIntegralFromScientific expected s = maybe
205− (fail $ expected ++ " is either floating or will cause over or underflow: " ++ show s)
204+parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => Scientific -> Parser a
205+parseBoundedIntegralFromScientific s = maybe
206+ (fail $ "value is either floating or will cause over or underflow " ++ show s)
206207 pure
207208 (Scientific.toBoundedInteger s)
208209{-# INLINE parseBoundedIntegralFromScientific #-}
209210
210211parseBoundedIntegral :: (Bounded a, Integral a) => String -> Value -> Parser a
211−parseBoundedIntegral expected =
212− withScientific expected $ parseBoundedIntegralFromScientific expected
212+parseBoundedIntegral name =
213+ prependContext name . withScientific' parseBoundedIntegralFromScientific
213214{-# INLINE parseBoundedIntegral #-}
214215
215216parseScientificText :: Text -> Parser Scientific
@@ -219,18 +220,20 @@ parseScientificText
219220 . T.encodeUtf8
220221
221222parseIntegralText :: Integral a => String -> Text -> Parser a
222−parseIntegralText expected t
223− = parseScientificText t
224− >>= rejectLargeExponent
225− >>= parseIntegralFromScientific expected
223+parseIntegralText name t =
224+ prependContext name $
225+ parseScientificText t
226+ >>= rejectLargeExponent
227+ >>= parseIntegralFromScientific
226228 where
227229 rejectLargeExponent :: Scientific -> Parser Scientific
228− rejectLargeExponent s = withBoundedScientific expected pure (Number s)
230+ rejectLargeExponent s = withBoundedScientific' pure (Number s)
229231{-# INLINE parseIntegralText #-}
230232
231233parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a
232−parseBoundedIntegralText expected t =
233− parseScientificText t >>= parseBoundedIntegralFromScientific expected
234+parseBoundedIntegralText name t =
235+ prependContext name $
236+ parseScientificText t >>= parseBoundedIntegralFromScientific
234237
235238parseOptionalFieldWith :: (Value -> Parser (Maybe a))
236239 -> Object -> Text -> Parser (Maybe a)
@@ -317,7 +320,7 @@ genericLiftParseJSON opts pj pjl = fmap to1 . gParseJSON opts (From1Args pj pjl)
317320-- @
318321--
319322-- For this common case of only being concerned with a single
320−-- type of JSON value, the functions 'withObject', 'withNumber', etc.
323+-- type of JSON value, the functions 'withObject', 'withScientific', etc.
321324-- are provided. Their use is to be preferred when possible, since
322325-- they are more terse. Using 'withObject', we can rewrite the above instance
323326-- (assuming the same language extension and data type) as:
@@ -374,13 +377,11 @@ class FromJSON a where
374377 parseJSON = genericParseJSON defaultOptions
375378
376379 parseJSONList :: Value -> Parser [a]
377− parseJSONList (Array a)
378− = zipWithM (parseIndexedJSON parseJSON) [0..]
380+ parseJSONList = withArray "[]" $ \a ->
381+ zipWithM (parseIndexedJSON parseJSON) [0..]
379382 . V.toList
380383 $ a
381384
382− parseJSONList v = typeMismatch "[a]" v
383−
384385-------------------------------------------------------------------------------
385386-- Classes and types for map keys
386387-------------------------------------------------------------------------------
@@ -496,26 +497,39 @@ mapFromJSONKeyFunction = fmap
496497
497498-- | Fail parsing due to a type mismatch, with a descriptive message.
498499--
499−-- Example usage:
500+-- The following wrappers should generally be prefered:
501+-- 'withObject', 'withArray', 'withText', 'withBool'.
500502--
501−-- @
502−-- instance FromJSON Coord where
503−-- parseJSON ('Object' v) = {- type matches, life is good -}
504−-- parseJSON wat = 'typeMismatch' \"Coord\" wat
505−-- @
506−typeMismatch :: String -- ^ The name of the type you are trying to parse.
503+-- ==== Error message example
504+--
505+-- > typeMismatch "Object" (String "oops")
506+-- > -- Error: "expected Object, but encountered String"
507+typeMismatch :: String -- ^ The name of the JSON type being parsed
508+ -- (@\"Object\"@, @\"Array\"@, @\"String\"@, @\"Number\"@,
509+ -- @\"Boolean\"@, or @\"Null\"@).
507510 -> Value -- ^ The actual value encountered.
508511 -> Parser a
509512typeMismatch expected actual =
510− fail $ "expected " ++ expected ++ ", encountered " ++ name
511− where
512− name = case actual of
513− Object _ -> "Object"
514− Array _ -> "Array"
515− String _ -> "String"
516− Number _ -> "Number"
517− Bool _ -> "Boolean"
518− Null -> "Null"
513+ fail $ "expected " ++ expected ++ ", but encountered " ++ typeOf actual
514+
515+-- | Fail parsing due to a type mismatch, when the expected types are implicit.
516+--
517+-- ==== Error message example
518+--
519+-- > unexpected (String "oops")
520+-- > -- Error: "unexpected String"
521+unexpected :: Value -> Parser a
522+unexpected actual = fail $ "unexpected " ++ typeOf actual
523+
524+-- | JSON type of a value, name of the head constructor.
525+typeOf :: Value -> String
526+typeOf v = case v of
527+ Object _ -> "Object"
528+ Array _ -> "Array"
529+ String _ -> "String"
530+ Number _ -> "Number"
531+ Bool _ -> "Boolean"
532+ Null -> "Null"
519533
520534-------------------------------------------------------------------------------
521535-- Lifings of FromJSON and ToJSON to unary and binary type constructors
@@ -596,9 +610,8 @@ class FromJSON2 f where
596610 -> (Value -> Parser b)
597611 -> (Value -> Parser [b])
598612 -> Value -> Parser [f a b]
599− liftParseJSONList2 fa ga fb gb v = case v of
600− Array vals -> fmap V.toList (V.mapM (liftParseJSON2 fa ga fb gb) vals)
601− _ -> typeMismatch "[a]" v
613+ liftParseJSONList2 fa ga fb gb = withArray "[]" $ \vals ->
614+ fmap V.toList (V.mapM (liftParseJSON2 fa ga fb gb) vals)
602615
603616-- | Lift the standard 'parseJSON' function through the type constructor.
604617parseJSON2 :: (FromJSON2 f, FromJSON a, FromJSON b) => Value -> Parser (f a b)
@@ -612,7 +625,7 @@ parseJSON2 = liftParseJSON2 parseJSON parseJSONList parseJSON parseJSONList
612625-- | Helper function to use with 'liftParseJSON'. See 'Data.Aeson.ToJSON.listEncoding'.
613626listParser :: (Value -> Parser a) -> Value -> Parser [a]
614627listParser f (Array xs) = fmap V.toList (V.mapM f xs)
615−listParser _ v = typeMismatch "[a]" v
628+listParser _ v = typeMismatch "Array" v
616629{-# INLINE listParser #-}
617630
618631-------------------------------------------------------------------------------
@@ -630,59 +643,127 @@ instance (FromJSON a) => FromJSON [a] where
630643-- Functions
631644-------------------------------------------------------------------------------
632645
633−-- | @'withObject' expected f value@ applies @f@ to the 'Object' when @value@
634−-- is an 'Object' and fails using @'typeMismatch' expected@ otherwise.
646+-- | Add context to a failure message, indicating the name of the structure
647+-- being parsed.
648+--
649+-- > prependContext "MyType" (fail "[error message]")
650+-- > -- Error: "parsing MyType failed, [error message]"
651+prependContext :: String -> Parser a -> Parser a
652+prependContext name = prependFailure ("parsing " ++ name ++ " failed, ")
653+
654+-- | @'withObject' name f value@ applies @f@ to the 'Object' when @value@
655+-- is an 'Data.Aeson.Object' and fails otherwise.
656+--
657+-- ==== Error message example
658+--
659+-- > withObject "MyType" f (String "oops")
660+-- > -- Error: "parsing MyType failed, expected Object, but encountered String"
635661withObject :: String -> (Object -> Parser a) -> Value -> Parser a
636−withObject _ f (Object obj) = f obj
637−withObject expected _ v = typeMismatch expected v
662+withObject _ f (Object obj) = f obj
663+withObject name _ v = prependContext name (typeMismatch "Object" v)
638664{-# INLINE withObject #-}
639665
640−-- | @'withText' expected f value@ applies @f@ to the 'Text' when @value@ is a
641−-- 'String' and fails using @'typeMismatch' expected@ otherwise.
666+-- | @'withText' name f value@ applies @f@ to the 'Text' when @value@ is a
667+-- 'Data.Aeson.String' and fails otherwise.
668+--
669+-- ==== Error message example
670+--
671+-- > withText "MyType" f Null
672+-- > -- Error: "parsing MyType failed, expected String, but encountered Null"
642673withText :: String -> (Text -> Parser a) -> Value -> Parser a
643−withText _ f (String txt) = f txt
644−withText expected _ v = typeMismatch expected v
674+withText _ f (String txt) = f txt
675+withText name _ v = prependContext name (typeMismatch "String" v)
645676{-# INLINE withText #-}
646677
647678-- | @'withArray' expected f value@ applies @f@ to the 'Array' when @value@ is
648−-- an 'Array' and fails using @'typeMismatch' expected@ otherwise.
679+-- an 'Data.Aeson.Array' and fails otherwise.
680+--
681+-- ==== Error message example
682+--
683+-- > withArray "MyType" f (String "oops")
684+-- > -- Error: "parsing MyType failed, expected Array, but encountered String"
649685withArray :: String -> (Array -> Parser a) -> Value -> Parser a
650−withArray _ f (Array arr) = f arr
651−withArray expected _ v = typeMismatch expected v
686+withArray _ f (Array arr) = f arr
687+withArray name _ v = prependContext name (typeMismatch "Array" v)
652688{-# INLINE withArray #-}
653689
654−-- | @'withScientific' expected f value@ applies @f@ to the 'Scientific' number
655−-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@
690+-- | @'withScientific' name f value@ applies @f@ to the 'Scientific' number
691+-- when @value@ is a 'Data.Aeson.Number' and fails using 'typeMismatch'
656692-- otherwise.
657−-- .
693+--
658694-- /Warning/: If you are converting from a scientific to an unbounded
659695-- type such as 'Integer' you may want to add a restriction on the
660696-- size of the exponent (see 'withBoundedScientific') to prevent
661697-- malicious input from filling up the memory of the target system.
698+--
699+-- ==== Error message example
700+--
701+-- > withScientific "MyType" f (String "oops")
702+-- > -- Error: "parsing MyType failed, expected Number, but encountered String"
662703withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
663−withScientific _ f (Number scientific) = f scientific
664−withScientific expected _ v = typeMismatch expected v
704+withScientific _ f (Number scientific) = f scientific
705+withScientific name _ v = prependContext name (typeMismatch "Number" v)
665706{-# INLINE withScientific #-}
666707
667−-- | @'withBoundedScientific' expected f value@ applies @f@ to the 'Scientific' number
668−-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@
669−-- otherwise.
708+-- | A variant of 'withScientific' which doesn't use 'prependContext', so that
709+-- such context can be added separately in a way that also applies when the
710+-- continuation @f :: Scientific -> Parser a@ fails.
711+--
712+-- /Warning/: If you are converting from a scientific to an unbounded
713+-- type such as 'Integer' you may want to add a restriction on the
714+-- size of the exponent (see 'withBoundedScientific') to prevent
715+-- malicious input from filling up the memory of the target system.
716+--
717+-- ==== Error message examples
670718--
671−-- The conversion will also fail with a @'typeMismatch' if the
672−-- 'Scientific' exponent is larger than 1024.
719+-- > withScientific' f (String "oops")
720+-- > -- Error: "unexpected String"
721+-- >
722+-- > prependContext "MyType" (withScientific' f (String "oops"))
723+-- > -- Error: "parsing MyType failed, unexpected String"
724+withScientific' :: (Scientific -> Parser a) -> Value -> Parser a
725+withScientific' f v = case v of
726+ Number n -> f n
727+ _ -> typeMismatch "Number" v
728+{-# INLINE withScientific' #-}
729+
730+-- | @'withBoundedScientific' name f value@ applies @f@ to the 'Scientific' number
731+-- when @value@ is a 'Number' with exponent less than or equal to 1024.
673732withBoundedScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
674−withBoundedScientific _ f v@(Number scientific) =
675− if base10Exponent scientific > 1024
676− then typeMismatch "a number with exponent <= 1024" v
677− else f scientific
678−withBoundedScientific expected _ v = typeMismatch expected v
733+withBoundedScientific name f v = withBoundedScientific_ (prependContext name) f v
679734{-# INLINE withBoundedScientific #-}
680735
736+-- | A variant of 'withBoundedScientific' which doesn't use 'prependContext',
737+-- so that such context can be added separately in a way that also applies
738+-- when the continuation @f :: Scientific -> Parser a@ fails.
739+withBoundedScientific' :: (Scientific -> Parser a) -> Value -> Parser a
740+withBoundedScientific' f v = withBoundedScientific_ id f v
741+{-# INLINE withBoundedScientific' #-}
742+
743+-- | A variant of 'withBoundedScientific_' parameterized by a function to apply
744+-- to the 'Parser' in case of failure.
745+withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
746+withBoundedScientific_ whenFail f v@(Number scientific) =
747+ if exponent > 1024
748+ then whenFail (fail msg)
749+ else f scientific
750+ where
751+ exponent = base10Exponent scientific
752+ msg = "found a number with exponent " ++ show exponent ++ ", but it must not be greater than 1024"
753+withBoundedScientific_ whenFail _ v =
754+ whenFail (typeMismatch "Number" v)
755+{-# INLINE withBoundedScientific_ #-}
756+
681757-- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a
682−-- 'Bool' and fails using @'typeMismatch' expected@ otherwise.
758+-- 'Boolean' and fails otherwise.
759+--
760+-- ==== Error message example
761+--
762+-- > withBool "MyType" f (String "oops")
763+-- > -- Error: "parsing MyType failed, expected Boolean, but encountered String"
683764withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
684−withBool _ f (Bool arr) = f arr
685−withBool expected _ v = typeMismatch expected v
765+withBool _ f (Bool arr) = f arr
766+withBool name _ v = prependContext name (typeMismatch "Boolean" v)
686767{-# INLINE withBool #-}
687768
688769-- | Decode a nested JSON-encoded string.
@@ -692,7 +773,7 @@ withEmbeddedJSON _ innerParser (String txt) =
692773 where
693774 eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
694775 eitherFormatError = either (Left . uncurry formatError) Right
695−withEmbeddedJSON name _ v = typeMismatch name v
776+withEmbeddedJSON name _ v = prependContext name (typeMismatch "String" v)
696777{-# INLINE withEmbeddedJSON #-}
697778
698779-- | Convert a value from JSON, failing if the types do not match.
@@ -1219,14 +1300,15 @@ instance FromJSON Void where
12191300 {-# INLINE parseJSON #-}
12201301
12211302instance FromJSON Bool where
1222− parseJSON = withBool "Bool" pure
1303+ parseJSON (Bool b) = pure b
1304+ parseJSON v = typeMismatch "Bool" v
12231305 {-# INLINE parseJSON #-}
12241306
12251307instance FromJSONKey Bool where
12261308 fromJSONKey = FromJSONKeyTextParser $ \t -> case t of
12271309 "true" -> pure True
12281310 "false" -> pure False
1229− _ -> fail $ "Cannot parse key into Bool: " ++ T.unpack t
1311+ _ -> fail $ "cannot parse key " ++ show t ++ " into Bool"
12301312
12311313instance FromJSON Ordering where
12321314 parseJSON = withText "Ordering" $ \s ->
@@ -1234,25 +1316,30 @@ instance FromJSON Ordering where
12341316 "LT" -> return LT
12351317 "EQ" -> return EQ
12361318 "GT" -> return GT
1237− _ -> fail "Parsing Ordering value failed: expected \"LT\", \"EQ\", or \"GT\""
1319+ _ -> fail $ "parsing Ordering failed, unexpected " ++ show s ++
1320+ " (expected \"LT\", \"EQ\", or \"GT\")"
12381321
12391322instance FromJSON () where
12401323 parseJSON = withArray "()" $ \v ->
12411324 if V.null v
12421325 then pure ()
1243− else fail "Expected an empty array"
1326+ else prependContext "()" $ fail "expected an empty array"
12441327 {-# INLINE parseJSON #-}
12451328
12461329instance FromJSON Char where
1247− parseJSON = withText "Char" $ \t ->
1248− if T.compareLength t 1 == EQ
1249− then pure $ T.head t
1250− else fail "Expected a string of length 1"
1330+ parseJSON = withText "Char" parseChar
12511331 {-# INLINE parseJSON #-}
12521332
1253− parseJSONList = withText "String" $ pure . T.unpack
1333+ parseJSONList (String s) = pure (T.unpack s)
1334+ parseJSONList v = typeMismatch "String" v
12541335 {-# INLINE parseJSONList #-}
12551336
1337+parseChar :: Text -> Parser Char
1338+parseChar t =
1339+ if T.compareLength t 1 == EQ
1340+ then pure $ T.head t
1341+ else prependContext "Char" $ fail "expected a string of length 1"
1342+
12561343instance FromJSON Double where
12571344 parseJSON = parseRealFloat "Double"
12581345 {-# INLINE parseJSON #-}
@@ -1289,7 +1376,7 @@ instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
12891376-- newtype 'Scientific' and provide your own instance using
12901377-- 'withScientific' if you want to allow larger inputs.
12911378instance HasResolution a => FromJSON (Fixed a) where
1292− parseJSON = withBoundedScientific "Fixed" $ pure . realToFrac
1379+ parseJSON = prependContext "Fixed" . withBoundedScientific' (pure . realToFrac)
12931380 {-# INLINE parseJSON #-}
12941381
12951382instance FromJSON Int where
@@ -1312,19 +1399,20 @@ instance FromJSONKey Integer where
13121399
13131400instance FromJSON Natural where
13141401 parseJSON value = do
1315− integer :: Integer <- parseIntegral "Natural" value
1316− if integer < 0 then
1317− fail $ "expected Natural, encountered negative number " <> show integer
1318− else
1319− pure $ fromIntegral integer
1402+ integer <- parseIntegral "Natural" value
1403+ parseNatural integer
13201404
13211405instance FromJSONKey Natural where
13221406 fromJSONKey = FromJSONKeyTextParser $ \text -> do
1323− integer :: Integer <- parseIntegralText "Natural" text
1324− if integer < 0 then
1325− fail $ "expected Natural, encountered negative number " <> show integer
1326− else
1327− pure $ fromIntegral integer
1407+ integer <- parseIntegralText "Natural" text
1408+ parseNatural integer
1409+
1410+parseNatural :: Integer -> Parser Natural
1411+parseNatural integer =
1412+ if integer < 0 then
1413+ fail $ "parsing Natural failed, unexpected negative number " <> show integer
1414+ else
1415+ pure $ fromIntegral integer
13281416
13291417instance FromJSON Int8 where
13301418 parseJSON = parseBoundedIntegral "Int8"
@@ -1421,17 +1509,17 @@ parseVersionText = go . readP_to_S parseVersion . unpack
14211509 where
14221510 go [(v,[])] = return v
14231511 go (_ : xs) = go xs
1424− go _ = fail "could not parse Version"
1512+ go _ = fail "parsing Version failed"
14251513
14261514-------------------------------------------------------------------------------
14271515-- semigroups NonEmpty
14281516-------------------------------------------------------------------------------
14291517
14301518instance FromJSON1 NonEmpty where
1431− liftParseJSON p _ = withArray "NonEmpty a" $
1519+ liftParseJSON p _ = withArray "NonEmpty" $
14321520 (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
14331521 where
1434− ne [] = fail "Expected a NonEmpty but got an empty list"
1522+ ne [] = fail "parsing NonEmpty failed, unpexpected empty list"
14351523 ne (x:xs) = pure (x :| xs)
14361524 {-# INLINE liftParseJSON #-}
14371525
@@ -1452,7 +1540,7 @@ instance FromJSON Scientific where
14521540-------------------------------------------------------------------------------
14531541
14541542instance FromJSON1 DList.DList where
1455− liftParseJSON p _ = withArray "DList a" $
1543+ liftParseJSON p _ = withArray "DList" $
14561544 fmap DList.fromList .
14571545 Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
14581546 {-# INLINE liftParseJSON #-}
@@ -1529,7 +1617,7 @@ instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Sum f g) where
15291617 inr = "InR"
15301618
15311619 liftParseJSON _ _ _ = fail $
1532− "expected an object with a single property " ++
1620+ "parsing Sum failed, expected an object with a single property " ++
15331621 "where the property key should be either " ++
15341622 "\"InL\" or \"InR\""
15351623 {-# INLINE liftParseJSON #-}
@@ -1543,7 +1631,7 @@ instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Sum f g a) where
15431631-------------------------------------------------------------------------------
15441632
15451633instance FromJSON1 Seq.Seq where
1546− liftParseJSON p _ = withArray "Seq a" $
1634+ liftParseJSON p _ = withArray "Seq" $
15471635 fmap Seq.fromList .
15481636 Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
15491637 {-# INLINE liftParseJSON #-}
@@ -1577,13 +1665,13 @@ instance FromJSON a => FromJSON (IntMap.IntMap a) where
15771665
15781666instance (FromJSONKey k, Ord k) => FromJSON1 (M.Map k) where
15791667 liftParseJSON p _ = case fromJSONKey of
1580− FromJSONKeyCoerce _-> withObject "Map k v" $
1668+ FromJSONKeyCoerce _ -> withObject "Map" $
15811669 fmap (H.foldrWithKey (M.insert . unsafeCoerce) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)
1582− FromJSONKeyText f -> withObject "Map k v" $
1670+ FromJSONKeyText f -> withObject "Map" $
15831671 fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)
1584− FromJSONKeyTextParser f -> withObject "Map k v" $
1672+ FromJSONKeyTextParser f -> withObject "Map" $
15851673 H.foldrWithKey (\k v m -> M.insert <$> f k <?> Key k <*> p v <?> Key k <*> m) (pure M.empty)
1586− FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
1674+ FromJSONKeyValue f -> withArray "Map" $ \arr ->
15871675 fmap M.fromList . Tr.sequence .
15881676 zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr
15891677 {-# INLINE liftParseJSON #-}
@@ -1611,18 +1699,18 @@ instance (FromJSON v) => FromJSON (Tree.Tree v) where
16111699
16121700instance FromJSON UUID.UUID where
16131701 parseJSON = withText "UUID" $
1614− maybe (fail "Invalid UUID") pure . UUID.fromText
1702+ maybe (fail "invalid UUID") pure . UUID.fromText
16151703
16161704instance FromJSONKey UUID.UUID where
16171705 fromJSONKey = FromJSONKeyTextParser $
1618− maybe (fail "Invalid UUID") pure . UUID.fromText
1706+ maybe (fail "invalid UUID") pure . UUID.fromText
16191707
16201708-------------------------------------------------------------------------------
16211709-- vector
16221710-------------------------------------------------------------------------------
16231711
16241712instance FromJSON1 Vector where
1625− liftParseJSON p _ = withArray "Vector a" $
1713+ liftParseJSON p _ = withArray "Vector" $
16261714 V.mapM (uncurry $ parseIndexedJSON p) . V.indexed
16271715 {-# INLINE liftParseJSON #-}
16281716
@@ -1636,14 +1724,14 @@ vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry $ parseIndexe
16361724{-# INLINE vectorParseJSON #-}
16371725
16381726instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where
1639− parseJSON = vectorParseJSON "Data.Vector.Storable.Vector a"
1727+ parseJSON = vectorParseJSON "Data.Vector.Storable.Vector"
16401728
16411729instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where
1642− parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector a"
1730+ parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector"
16431731 {-# INLINE parseJSON #-}
16441732
16451733instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where
1646− parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"
1734+ parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector"
16471735 {-# INLINE parseJSON #-}
16481736
16491737-------------------------------------------------------------------------------
@@ -1657,13 +1745,13 @@ instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where
16571745
16581746instance (FromJSONKey k, Eq k, Hashable k) => FromJSON1 (H.HashMap k) where
16591747 liftParseJSON p _ = case fromJSONKey of
1660− FromJSONKeyCoerce _ -> withObject "HashMap ~Text v" $
1748+ FromJSONKeyCoerce _ -> withObject "HashMap ~Text" $
16611749 uc . H.traverseWithKey (\k v -> p v <?> Key k)
1662− FromJSONKeyText f -> withObject "HashMap k v" $
1750+ FromJSONKeyText f -> withObject "HashMap" $
16631751 fmap (mapKey f) . H.traverseWithKey (\k v -> p v <?> Key k)
1664− FromJSONKeyTextParser f -> withObject "HashMap k v" $
1752+ FromJSONKeyTextParser f -> withObject "HashMap" $
16651753 H.foldrWithKey (\k v m -> H.insert <$> f k <?> Key k <*> p v <?> Key k <*> m) (pure H.empty)
1666− FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
1754+ FromJSONKeyValue f -> withArray "Map" $ \arr ->
16671755 fmap H.fromList . Tr.sequence .
16681756 zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr
16691757 where
@@ -1900,14 +1988,15 @@ instance FromJSON a => FromJSON (Semigroup.Option a) where
19001988
19011989instance FromJSON1 Proxy where
19021990 {-# INLINE liftParseJSON #-}
1903− liftParseJSON _ _ Null = pure Proxy
1904− liftParseJSON _ _ v = typeMismatch "Proxy" v
1991+ liftParseJSON _ _ = fromNull "Proxy" Proxy
19051992
19061993instance FromJSON (Proxy a) where
19071994 {-# INLINE parseJSON #-}
1908− parseJSON Null = pure Proxy
1909− parseJSON v = typeMismatch "Proxy" v
1995+ parseJSON = fromNull "Proxy" Proxy
19101996
1997+fromNull :: String -> a -> Value -> Parser a
1998+fromNull _ a Null = pure a
1999+fromNull c _ v = prependContext c (typeMismatch "Null" v)
19112000
19122001instance FromJSON2 Tagged where
19132002 liftParseJSON2 _ _ p _ = fmap Tagged . p
@@ -1934,10 +2023,7 @@ instance (FromJSON a, FromJSON b, FromJSON c) => FromJSONKey (a,b,c)
19342023instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSONKey (a,b,c,d)
19352024
19362025instance FromJSONKey Char where
1937− fromJSONKey = FromJSONKeyTextParser $ \t ->
1938− if T.length t == 1
1939− then return (T.index t 0)
1940− else typeMismatch "Expected Char but String didn't contain exactly one character" (String t)
2026+ fromJSONKey = FromJSONKeyTextParser parseChar
19412027 fromJSONKeyList = FromJSONKeyText T.unpack
19422028
19432029instance (FromJSONKey a, FromJSON a) => FromJSONKey [a] where