Add verboseDecode variants with accumulative errors

Author: Lysxia

Data/Aeson.hs

@@ -37,12 +37,16 @@ module Data.Aeson
     , decode'
     , eitherDecode
     , eitherDecode'
+    , verboseDecode
+    , verboseDecode'
     , encode
     -- ** Variants for strict bytestrings
     , decodeStrict
     , decodeStrict'
     , eitherDecodeStrict
     , eitherDecodeStrict'
+    , verboseDecodeStrict
+    , verboseDecodeStrict'
     -- * Core JSON types
     , Value(..)
     , Encoding
@@ -131,9 +135,14 @@ import Prelude.Compat
 
 import Data.Aeson.Types.FromJSON (ifromJSON)
 import Data.Aeson.Encoding (encodingToLazyByteString)
-import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith, eitherDecodeWith, eitherDecodeStrictWith, jsonEOF, json, jsonEOF', json')
+import Data.Aeson.Parser.Internal
+  ( decodeWith, decodeStrictWith
+  , eitherDecodeWith, eitherDecodeStrictWith
+  , verboseDecodeWith, verboseDecodeStrictWith
+  , jsonEOF, json, jsonEOF', json')
 import Data.Aeson.Types
-import Data.Aeson.Types.Internal (JSONPath, formatError)
+import Data.Aeson.Types.Internal (JSONPath, formatError, formatErrors)
+import Data.List.NonEmpty (NonEmpty)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 
@@ -221,6 +230,35 @@ eitherDecodeStrict' =
   eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON
 {-# INLINE eitherDecodeStrict' #-}
 
+eitherFormatErrors
+  :: Either (NonEmpty (JSONPath, String)) a -> Either (NonEmpty String) a
+eitherFormatErrors = either (Left . formatErrors) Right
+{-# INLINE eitherFormatErrors #-}
+
+-- | Like 'decode' but returns one or more error messages when decoding fails.
+verboseDecode :: (FromJSON a) => L.ByteString -> Either (NonEmpty String) a
+verboseDecode = eitherFormatErrors . verboseDecodeWith jsonEOF ifromJSON
+{-# INLINE verboseDecode #-}
+
+-- | Like 'decodeStrict' but returns one or more error messages when decoding
+-- fails.
+verboseDecodeStrict :: (FromJSON a) => B.ByteString -> Either (NonEmpty String) a
+verboseDecodeStrict =
+  eitherFormatErrors . verboseDecodeStrictWith jsonEOF ifromJSON
+{-# INLINE verboseDecodeStrict #-}
+
+-- | Like 'decode'' but returns one or more error messages when decoding fails.
+verboseDecode' :: (FromJSON a) => L.ByteString -> Either (NonEmpty String) a
+verboseDecode' = eitherFormatErrors . verboseDecodeWith jsonEOF' ifromJSON
+{-# INLINE verboseDecode' #-}
+
+-- | Like 'decodeStrict'' but returns one or more error messages when decoding
+-- fails.
+verboseDecodeStrict' :: (FromJSON a) => B.ByteString -> Either (NonEmpty String) a
+verboseDecodeStrict' =
+  eitherFormatErrors . verboseDecodeStrictWith jsonEOF' ifromJSON
+{-# INLINE verboseDecodeStrict' #-}
+
 -- $use
 --
 -- This section contains basic information on the different ways to

Data/Aeson/Internal.hs

@@ -18,6 +18,7 @@ module Data.Aeson.Internal
     , JSONPath
     , (<?>)
     , formatError
+    , formatErrors
     , ifromJSON
     , iparse
     ) where

Data/Aeson/Parser/Internal.hs

@@ -33,6 +33,8 @@ module Data.Aeson.Parser.Internal
     , decodeStrictWith
     , eitherDecodeWith
     , eitherDecodeStrictWith
+    , verboseDecodeWith
+    , verboseDecodeStrictWith
     ) where
 
 import Prelude ()
@@ -288,6 +290,24 @@ eitherDecodeStrictWith p to s =
       IError (e :| _) -> Left e
 {-# INLINE eitherDecodeStrictWith #-}
 
+verboseDecodeWith :: Parser Value -> (Value -> IResult a) -> L.ByteString
+                  -> Either (NonEmpty (JSONPath, String)) a
+verboseDecodeWith p to s =
+    case L.parse p s of
+      L.Done _ v     -> case to v of
+                          ISuccess a -> Right a
+                          IError   e -> Left  e
+      L.Fail _ _ msg -> Left (([], msg) :| [])
+{-# INLINE verboseDecodeWith #-}
+
+verboseDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
+                        -> Either (NonEmpty (JSONPath, String)) a
+verboseDecodeStrictWith p to s =
+    case either (\e -> IError (([], e) :| [])) to (A.parseOnly p s) of
+      ISuccess a -> Right a
+      IError   e -> Left  e
+{-# INLINE verboseDecodeStrictWith #-}
+
 -- $lazy
 --
 -- The 'json' and 'value' parsers decouple identification from

Data/Aeson/Types/Internal.hs

@@ -49,6 +49,7 @@ module Data.Aeson.Types.Internal
     , parserCatchError
     , parserCatchErrors
     , formatError
+    , formatErrors
     , (<?>)
     -- * Constructors and accessors
     , object
@@ -484,6 +485,10 @@ formatError path msg = "Error in " ++ format "$" path ++ ": " ++ msg
     escapeChar '\\' = "\\\\"
     escapeChar c    = [c]
 
+-- | Annotate a list of error messages.
+formatErrors :: Functor f => f (JSONPath, String) -> f String
+formatErrors = fmap (uncurry formatError)
+
 -- | A key\/value pair for an 'Object'.
 type Pair = (Text, Value)