202da6d · typeable/aeson

git.iko.soy/typeable/aeson

Merge pull request #550 from phadej/stuhv

Add parserThrowError and parserCatchError

commit202da6da217656206d71f61d6c0662f3fbaf8257 authorAdam Bergmark <adam@bergmark.nl> dateSat 10 Jun 2017, 13:28 (9 years ago) parent8f246ac f0097f6

13 files changed+67−15

compare with master

unifiedsplit

.gitignore+1 Data/Aeson/Types.hs+2 Data/Aeson/Types/Internal.hs+18−1 aeson.cabal+1−1 changelog.md+4 stack-bench.yaml+2 stack-lts6.yaml+6−1 stack-lts7.yaml+1 stack-lts8.yaml+2 stack-nightly.yaml+2 stack-pure-unescape.yaml+2 tests/Instances.hs−12 tests/Properties.hs+26

.gitignore+1

@@ -1,5 +1,6 @@

11dist

22dist-newstyle

3+.ghc.environment.*

34.cabal-sandbox/

45cabal.sandbox.config

56.stack-work/

Data/Aeson/Types.hs+2

@@ -36,6 +36,8 @@ module Data.Aeson.Types

3636 , ToJSON(..)

3737 , KeyValue(..)

3838 , modifyFailure

39+ , parserThrowError

40+ , parserCatchError

3941

4042 -- ** Keys for maps

4143 , ToJSONKey(..)

Data/Aeson/Types/Internal.hs+18−1

@@ -44,6 +44,8 @@ module Data.Aeson.Types.Internal

4444 , parseEither

4545 , parseMaybe

4646 , modifyFailure

47+ , parserThrowError

48+ , parserCatchError

4749 , formatError

4850 , (<?>)

4951 -- * Constructors and accessors

@@ -507,7 +509,22 @@ p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks

507509--

508510-- Since 0.6.2.0

509511modifyFailure :: (String -> String) -> Parser a -> Parser a

510−modifyFailure f (Parser p) = Parser $ \path kf ks -> p path (\p' m -> kf p' (f m)) ks

512+modifyFailure f (Parser p) = Parser $ \path kf ks ->

513+ p path (\p' m -> kf p' (f m)) ks

514+

515+-- | Throw a parser error with an additional path.

516+--

517+-- @since 1.2.1.0

518+parserThrowError :: JSONPath -> String -> Parser a

519+parserThrowError path' msg = Parser $ \path kf _ks ->

520+ kf (reverse path ++ path') msg

521+

522+-- | A handler function to handle previous errors and return to normal execution.

523+--

524+-- @since 1.2.1.0

525+parserCatchError :: Parser a -> (JSONPath -> String -> Parser a) -> Parser a

526+parserCatchError (Parser p) handler = Parser $ \path kf ks ->

527+ p path (\e msg -> runParser (handler e msg) path kf ks) ks

511528

512529--------------------------------------------------------------------------------

513530-- Generic and TH encoding configuration

aeson.cabal+1−1

@@ -225,7 +225,7 @@ test-suite tests

225225 unordered-containers,

226226 uuid-types,

227227 vector,

228− quickcheck-instances >=0.3.12

228+ quickcheck-instances >=0.3.14

229229

230230 if flag(bytestring-builder)

231231 build-depends: bytestring >= 0.9 && < 0.10.4,

changelog.md+4

@@ -1,5 +1,9 @@

11For 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).

3+## 1.2.1.0

5+* Add `parserThrowError` and `parserCatchError` combinators.

37## 1.2.0.0

59* `tagSingleConstructors`, an option to encode single-constructor types as tagged sums was added to `Options`. It is disabled by default for backward compatibility.

stack-bench.yaml+2

@@ -2,3 +2,5 @@ resolver: lts-8.5

22packages:

33- '.'

44- benchmarks

5+extra-deps:

6+- quickcheck-instances-0.3.14

stack-lts6.yaml+6−1

@@ -3,8 +3,13 @@ packages:

33- '.'

44- attoparsec-iso8601

55extra-deps:

6−- semigroups-0.18.2

76- integer-logarithms-1

7+- QuickCheck-2.9.2

8+- quickcheck-instances-0.3.14

9+- semigroups-0.18.2

10+- tagged-0.8.5

11+- transformers-compat-0.5.1.4

12+flags:

813flags:

914 aeson:

1015 fast: true

stack-lts7.yaml+1

@@ -4,6 +4,7 @@ packages:

44- attoparsec-iso8601

55extra-deps:

66- integer-logarithms-1

7+- quickcheck-instances-0.3.14

78flags:

89 aeson:

910 fast: true

stack-lts8.yaml+2

@@ -2,6 +2,8 @@ resolver: lts-8.1

22packages:

33- '.'

44- attoparsec-iso8601

5+extra-deps:

6+- quickcheck-instances-0.3.14

57flags:

68 aeson:

79 fast: true

stack-nightly.yaml+2

@@ -2,6 +2,8 @@ resolver: nightly-2017-03-25

22packages:

33- '.'

44- attoparsec-iso8601

5+extra-deps:

6+- quickcheck-instances-0.3.14

57flags:

68 aeson:

79 fast: true

stack-pure-unescape.yaml+2

@@ -1,6 +1,8 @@

11resolver: lts-8.1

22packages:

33- '.'

4+extra-deps:

5+- quickcheck-instances-0.3.14

46flags:

57 aeson:

68 fast: true

tests/Instances.hs−12

@@ -16,7 +16,6 @@ import Data.Aeson.Types

1616import Data.Function (on)

1717import Data.Functor.Compose (Compose (..))

1818import Data.Proxy (Proxy(..))

19−import Data.Tagged (Tagged(..))

2019import Data.Time (ZonedTime(..), TimeZone(..))

2120import Data.Time.Clock (UTCTime(..))

2221import Functions

@@ -24,7 +23,6 @@ import Test.QuickCheck (Arbitrary(..), elements, oneof)

2423import Types

2524import qualified Data.DList as DList

2625import qualified Data.HashMap.Strict as HM

27−import qualified Data.UUID.Types as UUID

2826

2927#if !MIN_VERSION_QuickCheck(2,9,0)

3028import Control.Applicative (Const(..))

@@ -193,9 +191,6 @@ instance Arbitrary Natural where

193191instance Arbitrary (Proxy a) where

194192 arbitrary = pure Proxy

195193

196−instance Arbitrary b => Arbitrary (Tagged a b) where

197− arbitrary = Tagged <$> arbitrary

198−

199194instance Arbitrary a => Arbitrary (DList.DList a) where

200195 arbitrary = DList.fromList <$> arbitrary

201196

@@ -220,10 +215,3 @@ makeVersion b = Version b []

220215instance Arbitrary a => Arbitrary (Identity a) where

221216 arbitrary = Identity <$> arbitrary

222217#endif

223−

224−instance Arbitrary UUID.UUID where

225− arbitrary = UUID.fromWords

226− <$> arbitrary

227− <*> arbitrary

228− <*> arbitrary

229− <*> arbitrary

tests/Properties.hs+26

@@ -13,6 +13,7 @@ import Control.Applicative (Const)

1313import Data.Aeson (eitherDecode, encode)

1414import Data.Aeson.Encoding (encodingToLazyByteString)

1515import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)

16+import qualified Data.Aeson.Internal as I

1617import Data.Aeson.Parser (value)

1718import Data.Aeson.Types

1819import Data.DList (DList)

@@ -113,6 +114,29 @@ modifyFailureProp orig added =

113114 result :: Result ()

114115 result = parse parser ()

115116

117+parserThrowErrorProp :: String -> Property

118+parserThrowErrorProp msg =

119+ result === Error msg

120+ where

121+ parser = const $ parserThrowError [] msg

122+ result :: Result ()

123+ result = parse parser ()

124+

125+-- | Tests (also) that we catch the JSONPath and it has elements in the right order.

126+parserCatchErrorProp :: [String] -> String -> Property

127+parserCatchErrorProp path msg =

128+ result === Success ([I.Key "outer", I.Key "inner"] ++ jsonPath, msg)

129+ where

130+ parser = parserCatchError outer (curry pure)

131+

132+ outer = inner I.<?> I.Key "outer"

133+ inner = parserThrowError jsonPath msg I.<?> I.Key "inner"

134+

135+ result :: Result (I.JSONPath, String)

136+ result = parse (const parser) ()

137+

138+ jsonPath = map (I.Key . T.pack) path

139+

116140-- | Perform a structural comparison of the results of two encoding

117141-- methods. Compares decoded values to account for HashMap-driven

118142-- variation in JSON object key ordering.

@@ -306,6 +330,8 @@ tests = testGroup "properties" [

306330 ]

307331 , testGroup "failure messages" [

308332 testProperty "modify failure" modifyFailureProp

333+ , testProperty "parserThrowError" parserThrowErrorProp

334+ , testProperty "parserCatchError" parserCatchErrorProp

309335 ]

310336 , testGroup "generic" [

311337 testGroup "toJSON" [