Merge pull request #988 from haskell/throwDecode

Add throwDecode and variants

Author: phadej

.github/workflows/haskell-ci.yml

@@ -170,7 +170,7 @@ jobs:
         run: |
           $CABAL v2-update -v
       - name: cache (tools)
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-tools-cd9045c2
           path: ~/.haskell-ci-tools
@@ -183,8 +183,17 @@ jobs:
           rm -f cabal-plan.xz
           chmod a+x $HOME/.cabal/bin/cabal-plan
           cabal-plan --version
+      - name: install cabal-docspec
+        run: |
+          mkdir -p $HOME/.cabal/bin
+          curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20211114/cabal-docspec-0.0.0.20211114.xz > cabal-docspec.xz
+          echo 'e224700d9e8c9ec7ec6bc3f542ba433cd9925a5d356676c62a9bd1f2c8be8f8a  cabal-docspec.xz' | sha256sum -c -
+          xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec
+          rm -f cabal-docspec.xz
+          chmod a+x $HOME/.cabal/bin/cabal-docspec
+          cabal-docspec --version
       - name: checkout
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
         with:
           path: source
       - name: initial cabal.project for sdist
@@ -232,7 +241,7 @@ jobs:
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
           cabal-plan
       - name: cache
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store
@@ -250,6 +259,10 @@ jobs:
       - name: tests
         run: |
           $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
+      - name: docspec
+        run: |
+          $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all
+          cabal-docspec $ARG_COMPILER
       - name: haddock
         run: |
           if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi

.github/workflows/z-bench.yml

@@ -174,7 +174,7 @@ jobs:
           chmod a+x $HOME/.cabal/bin/cabal-plan
           cabal-plan --version
       - name: checkout
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
         with:
           path: source
       - name: initial cabal.project for sdist
@@ -210,7 +210,7 @@ jobs:
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
           cabal-plan
       - name: cache
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store

aeson.cabal

@@ -1,5 +1,5 @@
 name:               aeson
-version:            2.1.1.0
+version:            2.1.2.0
 license:            BSD3
 license-file:       LICENSE
 category:           Text, Web, JSON
@@ -102,6 +102,7 @@ library
     , ghc-prim          >=0.5.0.0  && <0.10
     , template-haskell  >=2.11.0.0 && <2.20
     , text              >=1.2.3.0  && <1.3 || >=2.0 && <2.1
+    , exceptions        >=0.10.4   && <0.11
     , time              >=1.6.0.1  && <1.13
 
   -- Compat

benchmarks/aeson-benchmarks.cabal

@@ -31,6 +31,7 @@ library
     , data-fix
     , deepseq
     , dlist
+    , exceptions
     , generically
     , ghc-prim
     , hashable

cabal.haskell-ci

@@ -1,5 +1,6 @@
 branches: master
 cabal-check: False
+docspec: True
 
 -- GADT docs
 haddock: >=8.6

changelog.md

@@ -2,6 +2,11 @@ For the latest version of this document, please see [https://github.com/haskell/
 
 ### 2.1.2.0
 
+* Add `throwDecode :: (MonadThrow m, FromJSON a) => ByteString -> m a`
+  and variants.
+
+### 2.1.2.0
+
 * Support deriving for empty datatypes (such as `Void` and `V1`)
   in `FromJSON` and `ToJSON`.
 * Add `To/FromJSONKey Void` instances

src/Data/Aeson.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -- |
 -- Module:      Data.Aeson
 -- Copyright:   (c) 2011-2016 Bryan O'Sullivan
@@ -55,6 +56,12 @@ module Data.Aeson
     , eitherDecodeFileStrict
     , eitherDecodeStrict'
     , eitherDecodeFileStrict'
+    -- ** Exception throwing variants
+    , AesonException (..)
+    , throwDecode
+    , throwDecodeStrict
+    , throwDecode'
+    , throwDecodeStrict'
     -- * Core JSON types
     , Value(..)
     , Encoding
@@ -154,6 +161,8 @@ module Data.Aeson
 
 import Prelude.Compat
 
+import Control.Exception (Exception (..))
+import Control.Monad.Catch (MonadThrow (..))
 import Data.Aeson.Types.FromJSON (ifromJSON, parseIndexedJSON)
 import Data.Aeson.Encoding (encodingToLazyByteString)
 import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith, eitherDecodeWith, eitherDecodeStrictWith, jsonEOF, json, jsonEOF', json')
@@ -162,6 +171,9 @@ import Data.Aeson.Types.Internal (formatError)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 
+-- $setup
+-- >>> :set -XOverloadedStrings
+
 -- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
 --
 -- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.
@@ -286,6 +298,62 @@ eitherDecodeFileStrict' =
   fmap eitherDecodeStrict' . B.readFile
 {-# INLINE eitherDecodeFileStrict' #-}
 
+throwFormatError :: MonadThrow m => Either (JSONPath, String) a -> m a
+throwFormatError = either (throwM . AesonException . uncurry formatError) return
+{-# INLINE throwFormatError #-}
+
+-- | Like 'decode' but throws an 'AesonException' when decoding fails.
+--
+-- >>> throwDecode "42" :: Maybe Int
+-- Just 42
+--
+-- >>> throwDecode "42" :: IO Int
+-- 42
+--
+-- >>> throwDecode "true" :: IO Int
+-- ...Exception: AesonException...
+--
+-- @since 2.1.2.0
+--
+throwDecode :: forall a m. (FromJSON a, MonadThrow m) => L.ByteString -> m a
+throwDecode = throwFormatError . eitherDecodeWith jsonEOF ifromJSON
+{-# INLINE throwDecode #-}
+
+-- | Like 'decodeStrict' but throws an 'AesonException' when decoding fails.
+--
+-- @since 2.1.2.0
+--
+throwDecodeStrict :: forall a m. (FromJSON a, MonadThrow m) => B.ByteString -> m a
+throwDecodeStrict =
+  throwFormatError . eitherDecodeStrictWith jsonEOF ifromJSON
+{-# INLINE throwDecodeStrict #-}
+
+-- | Like 'decode'' but throws an 'AesonException' when decoding fails.
+--
+-- @since 2.1.2.0
+--
+throwDecode' :: forall a m. (FromJSON a, MonadThrow m) => L.ByteString -> m a
+throwDecode' = throwFormatError . eitherDecodeWith jsonEOF' ifromJSON
+{-# INLINE throwDecode' #-}
+
+-- | Like 'decodeStrict'' but throws an 'AesonException' when decoding fails.
+--
+-- @since 2.1.2.0
+--
+throwDecodeStrict' :: forall a m. (FromJSON a, MonadThrow m) => B.ByteString -> m a
+throwDecodeStrict' =
+  throwFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON
+{-# INLINE throwDecodeStrict' #-}
+
+-- | Exception thrown by 'throwDecode' and variants.
+--
+-- @since 2.1.2.0
+newtype AesonException = AesonException String
+  deriving (Show)
+
+instance Exception AesonException where
+    displayException (AesonException str) = "aeson: " ++ str
+
 -- $use
 --
 -- This section contains basic information on the different ways to