git.iko.soy/typeable/aeson
on master help sign in
Improve error reporting on type mismatches
215f76cBryan O'Sullivan
Data/Aeson/Types.hs+60−28
compare with master
unifiedsplit
@@ -19,8 +19,9 @@ module Data.Aeson.Types
19 , Pair
19 , Pair
20 , Object
20 , Object
21 , emptyObject
21 , emptyObject
22− -- * Convenience types
22+ -- * Convenience types and functions
23 , DotNetTime(..)
23 , DotNetTime(..)
24+ , typeMismatch
24 -- * Type conversion
25 -- * Type conversion
25 , Parser
26 , Parser
26 , Result(..)
27 , Result(..)
@@ -191,7 +192,7 @@ parse m v = runParser (m v) Error Success
191-- optional, use '(.:?)' instead.
192-- optional, use '(.:?)' instead.
192(.:) :: (FromJSON a) => Object -> Text -> Parser a
193(.:) :: (FromJSON a) => Object -> Text -> Parser a
193obj .: key = case M.lookup key obj of
194obj .: key = case M.lookup key obj of
194− Nothing -> empty
195+ Nothing -> fail $ "key " ++ show key ++ " not present"
195 Just v -> parseJSON v
196 Just v -> parseJSON v
196{-# INLINE (.:) #-}
197{-# INLINE (.:) #-}
197
198
@@ -273,7 +274,7 @@ instance ToJSON Bool where
273
274
274instance FromJSON Bool where
275instance FromJSON Bool where
275 parseJSON (Bool b) = pure b
276 parseJSON (Bool b) = pure b
276− parseJSON _ = empty
277+ parseJSON v = typeMismatch "Bool" v
277 {-# INLINE parseJSON #-}
278 {-# INLINE parseJSON #-}
278
279
279instance ToJSON () where
280instance ToJSON () where
@@ -282,7 +283,7 @@ instance ToJSON () where
282
283
283instance FromJSON () where
284instance FromJSON () where
284 parseJSON (Array v) | V.null v = pure ()
285 parseJSON (Array v) | V.null v = pure ()
285− parseJSON _ = empty
286+ parseJSON v = typeMismatch "()" v
286 {-# INLINE parseJSON #-}
287 {-# INLINE parseJSON #-}
287
288
288instance ToJSON [Char] where
289instance ToJSON [Char] where
@@ -291,7 +292,7 @@ instance ToJSON [Char] where
291
292
292instance FromJSON [Char] where
293instance FromJSON [Char] where
293 parseJSON (String t) = pure (T.unpack t)
294 parseJSON (String t) = pure (T.unpack t)
294− parseJSON _ = empty
295+ parseJSON v = typeMismatch "String" v
295 {-# INLINE parseJSON #-}
296 {-# INLINE parseJSON #-}
296
297
297instance ToJSON Char where
298instance ToJSON Char where
@@ -301,7 +302,7 @@ instance ToJSON Char where
301instance FromJSON Char where
302instance FromJSON Char where
302 parseJSON (String t)
303 parseJSON (String t)
303 | T.compareLength t 1 == EQ = pure (T.head t)
304 | T.compareLength t 1 == EQ = pure (T.head t)
304− parseJSON _ = empty
305+ parseJSON v = typeMismatch "Char" v
305 {-# INLINE parseJSON #-}
306 {-# INLINE parseJSON #-}
306
307
307instance ToJSON Double where
308instance ToJSON Double where
@@ -312,7 +313,7 @@ instance FromJSON Double where
312 parseJSON (Number n) = case n of
313 parseJSON (Number n) = case n of
313 D d -> pure d
314 D d -> pure d
314 I i -> pure (fromIntegral i)
315 I i -> pure (fromIntegral i)
315− parseJSON _ = empty
316+ parseJSON v = typeMismatch "Double" v
316 {-# INLINE parseJSON #-}
317 {-# INLINE parseJSON #-}
317
318
318instance ToJSON Number where
319instance ToJSON Number where
@@ -321,7 +322,7 @@ instance ToJSON Number where
321
322
322instance FromJSON Number where
323instance FromJSON Number where
323 parseJSON (Number n) = pure n
324 parseJSON (Number n) = pure n
324− parseJSON _ = empty
325+ parseJSON v = typeMismatch "Number" v
325 {-# INLINE parseJSON #-}
326 {-# INLINE parseJSON #-}
326
327
327instance ToJSON Float where
328instance ToJSON Float where
@@ -332,7 +333,7 @@ instance FromJSON Float where
332 parseJSON (Number n) = case n of
333 parseJSON (Number n) = case n of
333 D d -> pure . fromRational . toRational $ d
334 D d -> pure . fromRational . toRational $ d
334 I i -> pure (fromIntegral i)
335 I i -> pure (fromIntegral i)
335− parseJSON _ = empty
336+ parseJSON v = typeMismatch "Float" v
336 {-# INLINE parseJSON #-}
337 {-# INLINE parseJSON #-}
337
338
338instance ToJSON (Ratio Integer) where
339instance ToJSON (Ratio Integer) where
@@ -343,7 +344,7 @@ instance FromJSON (Ratio Integer) where
343 parseJSON (Number n) = case n of
344 parseJSON (Number n) = case n of
344 D d -> pure . toRational $ d
345 D d -> pure . toRational $ d
345 I i -> pure (fromIntegral i)
346 I i -> pure (fromIntegral i)
346− parseJSON _ = empty
347+ parseJSON v = typeMismatch "Ratio Integer" v
347 {-# INLINE parseJSON #-}
348 {-# INLINE parseJSON #-}
348
349
349instance ToJSON Int where
350instance ToJSON Int where
@@ -356,7 +357,7 @@ instance FromJSON Int where
356
357
357parseIntegral :: Integral a => Value -> Parser a
358parseIntegral :: Integral a => Value -> Parser a
358parseIntegral (Number n) = pure (floor n)
359parseIntegral (Number n) = pure (floor n)
359−parseIntegral _ = empty
360+parseIntegral v = typeMismatch "Integral" v
360{-# INLINE parseIntegral #-}
361{-# INLINE parseIntegral #-}
361
362
362instance ToJSON Integer where
363instance ToJSON Integer where
@@ -445,7 +446,7 @@ instance ToJSON Text where
445
446
446instance FromJSON Text where
447instance FromJSON Text where
447 parseJSON (String t) = pure t
448 parseJSON (String t) = pure t
448− parseJSON _ = empty
449+ parseJSON v = typeMismatch "Text" v
449 {-# INLINE parseJSON #-}
450 {-# INLINE parseJSON #-}
450
451
451instance ToJSON LT.Text where
452instance ToJSON LT.Text where
@@ -454,7 +455,7 @@ instance ToJSON LT.Text where
454
455
455instance FromJSON LT.Text where
456instance FromJSON LT.Text where
456 parseJSON (String t) = pure (LT.fromStrict t)
457 parseJSON (String t) = pure (LT.fromStrict t)
457− parseJSON _ = empty
458+ parseJSON v = typeMismatch "Lazy Text" v
458 {-# INLINE parseJSON #-}
459 {-# INLINE parseJSON #-}
459
460
460instance ToJSON B.ByteString where
461instance ToJSON B.ByteString where
@@ -463,7 +464,7 @@ instance ToJSON B.ByteString where
463
464
464instance FromJSON B.ByteString where
465instance FromJSON B.ByteString where
465 parseJSON (String t) = pure . encodeUtf8 $ t
466 parseJSON (String t) = pure . encodeUtf8 $ t
466− parseJSON _ = empty
467+ parseJSON v = typeMismatch "ByteString" v
467 {-# INLINE parseJSON #-}
468 {-# INLINE parseJSON #-}
468
469
469instance ToJSON LB.ByteString where
470instance ToJSON LB.ByteString where
@@ -472,7 +473,7 @@ instance ToJSON LB.ByteString where
472
473
473instance FromJSON LB.ByteString where
474instance FromJSON LB.ByteString where
474 parseJSON (String t) = pure . lazy $ t
475 parseJSON (String t) = pure . lazy $ t
475− parseJSON _ = empty
476+ parseJSON v = typeMismatch "Lazy ByteString" v
476 {-# INLINE parseJSON #-}
477 {-# INLINE parseJSON #-}
477
478
478instance (ToJSON a) => ToJSON [a] where
479instance (ToJSON a) => ToJSON [a] where
@@ -481,7 +482,7 @@ instance (ToJSON a) => ToJSON [a] where
481
482
482instance (FromJSON a) => FromJSON [a] where
483instance (FromJSON a) => FromJSON [a] where
483 parseJSON (Array a) = mapM parseJSON (V.toList a)
484 parseJSON (Array a) = mapM parseJSON (V.toList a)
484− parseJSON _ = empty
485+ parseJSON v = typeMismatch "[a]" v
485 {-# INLINE parseJSON #-}
486 {-# INLINE parseJSON #-}
486
487
487instance (ToJSON a) => ToJSON (Vector a) where
488instance (ToJSON a) => ToJSON (Vector a) where
@@ -490,7 +491,7 @@ instance (ToJSON a) => ToJSON (Vector a) where
490
491
491instance (FromJSON a) => FromJSON (Vector a) where
492instance (FromJSON a) => FromJSON (Vector a) where
492 parseJSON (Array a) = V.mapM parseJSON a
493 parseJSON (Array a) = V.mapM parseJSON a
493− parseJSON _ = empty
494+ parseJSON v = typeMismatch "Vector a" v
494 {-# INLINE parseJSON #-}
495 {-# INLINE parseJSON #-}
495
496
496instance (ToJSON a) => ToJSON (Set.Set a) where
497instance (ToJSON a) => ToJSON (Set.Set a) where
@@ -516,7 +517,7 @@ instance (ToJSON v) => ToJSON (M.Map Text v) where
516instance (FromJSON v) => FromJSON (M.Map Text v) where
517instance (FromJSON v) => FromJSON (M.Map Text v) where
517 parseJSON (Object o) = M.fromAscList <$> mapM go (M.toAscList o)
518 parseJSON (Object o) = M.fromAscList <$> mapM go (M.toAscList o)
518 where go (k,v) = ((,) k) <$> parseJSON v
519 where go (k,v) = ((,) k) <$> parseJSON v
519− parseJSON _ = empty
520+ parseJSON v = typeMismatch "Map Text a" v
520
521
521instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
522instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
522 toJSON = Object . transformMap LT.toStrict toJSON
523 toJSON = Object . transformMap LT.toStrict toJSON
@@ -549,7 +550,7 @@ instance (ToJSON v) => ToJSON (H.HashMap Text v) where
549instance (FromJSON v) => FromJSON (H.HashMap Text v) where
550instance (FromJSON v) => FromJSON (H.HashMap Text v) where
550 parseJSON (Object o) = H.fromList <$> mapM go (M.toList o)
551 parseJSON (Object o) = H.fromList <$> mapM go (M.toList o)
551 where go (k,v) = ((,) k) <$> parseJSON v
552 where go (k,v) = ((,) k) <$> parseJSON v
552− parseJSON _ = empty
553+ parseJSON v = typeMismatch "HashMap Text a" v
553
554
554instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
555instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
555 toJSON = Object . M.fromList . H.foldrWithKey (\k v -> ((LT.toStrict k,toJSON v) :)) []
556 toJSON = Object . M.fromList . H.foldrWithKey (\k v -> ((LT.toStrict k,toJSON v) :)) []
@@ -598,8 +599,8 @@ instance FromJSON DotNetTime where
598 parseJSON (String t) =
599 parseJSON (String t) =
599 case parseTime defaultTimeLocale "/Date(%s)/" (unpack t) of
600 case parseTime defaultTimeLocale "/Date(%s)/" (unpack t) of
600 Just d -> pure (DotNetTime d)
601 Just d -> pure (DotNetTime d)
601− _ -> empty
602+ _ -> fail "could not parse .NET time"
602− parseJSON _ = empty
603+ parseJSON v = typeMismatch "DotNetTime" v
603 {-# INLINE parseJSON #-}
604 {-# INLINE parseJSON #-}
604
605
605instance ToJSON UTCTime where
606instance ToJSON UTCTime where
@@ -609,10 +610,10 @@ instance ToJSON UTCTime where
609
610
610instance FromJSON UTCTime where
611instance FromJSON UTCTime where
611 parseJSON (String t) =
612 parseJSON (String t) =
612− case parseTime defaultTimeLocale "%FT%X%QZ" (unpack t) of
613+ case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of
613 Just d -> pure d
614 Just d -> pure d
614− _ -> empty
615+ _ -> fail "could not parse ISO-8601 date"
615− parseJSON _ = empty
616+ parseJSON v = typeMismatch "UTCTime" v
616 {-# INLINE parseJSON #-}
617 {-# INLINE parseJSON #-}
617
618
618instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
619instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
@@ -620,10 +621,25 @@ instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
620 {-# INLINE toJSON #-}
621 {-# INLINE toJSON #-}
621
622
622instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
623instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
623− parseJSON (Array ab) = case V.toList ab of
624+ parseJSON (Array ab) =
625+ case V.toList ab of
624− [a,b] -> (,) <$> parseJSON a <*> parseJSON b
626+ [a,b] -> (,) <$> parseJSON a <*> parseJSON b
625− _ -> empty
627+ _ -> fail $ "cannot unpack array of length " ++
628+ show (V.length ab) ++ " into a pair"
629+ parseJSON v = typeMismatch "(a,b)" v
626− parseJSON _ = empty
630+ {-# INLINE parseJSON #-}
631+
632+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where
633+ toJSON (a,b,c) = toJSON [toJSON a, toJSON b, toJSON c]
634+ {-# INLINE toJSON #-}
635+
636+instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
637+ parseJSON (Array abc) =
638+ case V.toList abc of
639+ [a,b,c] -> (,,) <$> parseJSON a <*> parseJSON b <*> parseJSON c
640+ _ -> fail $ "cannot unpack array of length " ++
641+ show (V.length abc) ++ " into a 3-tuple"
642+ parseJSON v = typeMismatch "(a,b,c)" v
627 {-# INLINE parseJSON #-}
643 {-# INLINE parseJSON #-}
628
644
629instance ToJSON a => ToJSON (Dual a) where
645instance ToJSON a => ToJSON (Dual a) where
@@ -649,3 +665,19 @@ instance ToJSON a => ToJSON (Last a) where
649instance FromJSON a => FromJSON (Last a) where
665instance FromJSON a => FromJSON (Last a) where
650 parseJSON = fmap Last . parseJSON
666 parseJSON = fmap Last . parseJSON
651 {-# INLINE parseJSON #-}
667 {-# INLINE parseJSON #-}
668+
669+-- | Fail parsing due to a type mismatch, with a descriptive message.
670+typeMismatch :: String -- ^ The name of the type you are trying to parse.
671+ -> Value -- ^ The actual value encountered.
672+ -> Parser a
673+typeMismatch expected actual =
674+ fail $ "when expecting a " ++ expected ++ ", encountered " ++ name ++
675+ " instead"
676+ where
677+ name = case actual of
678+ Object _ -> "Object"
679+ Array _ -> "Array"
680+ String _ -> "String"
681+ Number _ -> "Number"
682+ Bool _ -> "Boolean"
683+ Null -> "Null"
aeson.cabal+1−1
@@ -1,5 +1,5 @@
1name: aeson
1name: aeson
2−version: 0.3.0.0
2+version: 0.3.0.1
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5category: Text, Web, JSON
5category: Text, Web, JSON