Add parserThrowError and parserCatchError

Author: phadej

Data/Aeson/Types.hs

@@ -36,6 +36,8 @@ module Data.Aeson.Types
     , ToJSON(..)
     , KeyValue(..)
     , modifyFailure
+    , parserThrowError
+    , parserCatchError
 
     -- ** Keys for maps
     , ToJSONKey(..)

Data/Aeson/Types/Internal.hs

@@ -44,6 +44,8 @@ module Data.Aeson.Types.Internal
     , parseEither
     , parseMaybe
     , modifyFailure
+    , parserThrowError
+    , parserCatchError
     , formatError
     , (<?>)
     -- * Constructors and accessors
@@ -507,7 +509,22 @@ p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks
 --
 -- Since 0.6.2.0
 modifyFailure :: (String -> String) -> Parser a -> Parser a
-modifyFailure f (Parser p) = Parser $ \path kf ks -> p path (\p' m -> kf p' (f m)) ks
+modifyFailure f (Parser p) = Parser $ \path kf ks ->
+    p path (\p' m -> kf p' (f m)) ks
+
+-- | Throw a parser error with an additional path.
+--
+-- @since 1.2.1.0
+parserThrowError :: JSONPath -> String -> Parser a
+parserThrowError path' msg = Parser $ \path kf _ks ->
+    kf (reverse path ++ path') msg
+
+-- | A handler function to handle previous errors and return to normal execution.
+--
+-- @since 1.2.1.0
+parserCatchError :: Parser a -> (JSONPath -> String -> Parser a) -> Parser a
+parserCatchError (Parser p) handler = Parser $ \path kf ks ->
+    p path (\e msg -> runParser (handler e msg) path kf ks) ks
 
 --------------------------------------------------------------------------------
 -- Generic and TH encoding configuration

changelog.md

@@ -1,5 +1,9 @@
 For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).
 
+## 1.2.1.0
+
+* Add `parserThrowError` and `parserCatchError` combinators.
+
 ## 1.2.0.0
 
 * `tagSingleConstructors`, an option to encode single-constructor types as tagged sums was added to `Options`. It is disabled by default for backward compatibility.

tests/Properties.hs

@@ -113,6 +113,23 @@ modifyFailureProp orig added =
     result :: Result ()
     result = parse parser ()
 
+parserThrowErrorProp :: String -> Property
+parserThrowErrorProp msg =
+    result === Error msg
+  where
+    parser = const $ parserThrowError [] msg
+    result :: Result ()
+    result = parse parser ()
+
+parserCatchErrorProp :: String -> Property
+parserCatchErrorProp msg =
+    result === Success msg
+  where
+    -- Fail, catch, use error message as a successful parse
+    parser = const $ parserCatchError (fail msg) (\_ err -> pure err)
+    result :: Result String
+    result = parse parser ()
+
 -- | Perform a structural comparison of the results of two encoding
 -- methods. Compares decoded values to account for HashMap-driven
 -- variation in JSON object key ordering.
@@ -306,6 +323,8 @@ tests = testGroup "properties" [
     ]
   , testGroup "failure messages" [
       testProperty "modify failure" modifyFailureProp
+    , testProperty "parserThrowError" parserThrowErrorProp
+    , testProperty "parserCatchError" parserCatchErrorProp
     ]
   , testGroup "generic" [
       testGroup "toJSON" [