7bfbda7 · typeable/aeson

git.iko.soy/typeable/aeson

modifyFailure (bos/aeson#104)

commit7bfbda74e16944cfb9cbfcb233009a5208681fde authorMichael <michael@snoyman.com> dateTue 1 Jan 2013, 06:51 (14 years ago) parentd8403a2

3 files changed+28

compare with master

unifiedsplit

Data/Aeson/Types.hs+1 Data/Aeson/Types/Internal.hs+16 tests/Properties.hs+11

Data/Aeson/Types.hs+1

@@ -32,6 +32,7 @@ module Data.Aeson.Types

3232 , parseEither

3333 , parseMaybe

3434 , ToJSON(..)

35+ , modifyFailure

3536

3637 -- * Inspecting @'Value's@

3738 , withObject

Data/Aeson/Types/Internal.hs+16

@@ -26,6 +26,7 @@ module Data.Aeson.Types.Internal

2626 , parse

2727 , parseEither

2828 , parseMaybe

29+ , modifyFailure

2930 -- * Constructors and accessors

3031 , object

3132 ) where

@@ -225,3 +226,18 @@ type Pair = (Text, Value)

225226object :: [Pair] -> Value

226227object = Object . H.fromList

227228{-# INLINE object #-}

229+

230+-- | If the inner @Parser@ failed, modify the failure message using the

231+-- provided function. This allows you to create more meaningful error messages.

232+-- For example:

233+--

234+-- > parseJSON (Object o) = modifyFailure

235+-- > ("Parsing of the Foo value failed: " ++)

236+-- > (Foo <$> o .: "someField")

237+--

238+-- Since 0.6.2.0

239+modifyFailure :: (String -> String) -> Parser a -> Parser a

240+modifyFailure f (Parser p) =

241+ Parser $ \failure success -> p (modifyFailure' failure) success

242+ where

243+ modifyFailure' failure original = failure $ f original

tests/Properties.hs+11

@@ -66,6 +66,14 @@ regress_gh72 :: [(String, Maybe String)] -> Bool

6666regress_gh72 ys = G.decode (G.encode m) == Just m

6767 where m = Map.fromList ys

6868

69+modifyFailureProp :: String -> String -> Bool

70+modifyFailureProp orig added =

71+ result == Error (added ++ orig)

72+ where

73+ parser = const $ modifyFailure (added ++) $ fail orig

74+ result :: Result ()

75+ result = parse parser ()

76+

6977data Foo = Foo {

7078 fooInt :: Int

7179 , fooDouble :: Double

@@ -169,5 +177,8 @@ tests = [

169177 ],

170178 testGroup "genericToFromJSON" [

171179 testProperty "_UFoo" (genericToFromJSON :: UFoo -> Bool)

180+ ],

181+ testGroup "failure messages" [

182+ testProperty "modify failure" modifyFailureProp

172183 ]

173184 ]