aeson-commit 1.3 → 1.4

raw patch · 4 files changed

+131/−110 lines, 4 filesdep +hspecdep −tastydep −tasty-hspecdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

Dependencies removed: tasty, tasty-hspec

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• aeson-commit.cabal +8/−9
• src/Data/Aeson/Commit.hs +70/−57
• test/tasty/Main.hs +46/−44

@@ -1,5 +1,12 @@ # Changelog +## [1.4]+### [Added]+- Nix support+- Conditionally qualifications for `aeson-2.0`+### [Changed]+- Reword documentation+ ## [1.3] ### [Changed] - Relax version bounds in preparation for uploading to stackage

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               aeson-commit-version:            1.3+version:            1.4 license:            BSD3 copyright:          2020 Cross Compass Ltd. maintainer:         Jonas Carpay <jonascarpay@gmail.com>@@ -17,8 +17,8 @@ category:           Text, Web, JSON build-type:         Simple extra-source-files:-  README.md   CHANGELOG.md+  README.md  source-repository head   type:     git@@ -30,7 +30,7 @@   default-language: Haskell2010   ghc-options:      -Wall -Wno-name-shadowing   build-depends:-      aeson  >=1.4  && <2+      aeson  >=1.4  && <2.1     , base   >=4.10 && <5     , mtl    >=2.2  && <3     , text   >=1.2  && <2@@ -42,10 +42,9 @@   default-language: Haskell2010   ghc-options:      -Wall -Wno-name-shadowing   build-depends:-      aeson         >=1.4     && <2+      aeson         >=1.4  && <2.1     , aeson-commit-    , aeson-qq      >=0.8     && <1-    , base          >=4.10    && <5-    , tasty         >=1.2     && <2-    , tasty-hspec   >=1.1.5.1 && <2-    , text          >=1.2     && <2+    , aeson-qq      >=0.8  && <1+    , base          >=4.10 && <5+    , hspec+    , text          >=1.2  && <2

@@ -1,55 +1,62 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-|-   Commitment mechanism for aeson 'Parser'.-   Commitment means that if some initial parsing succeeds, subsequent failures are unrecoverable.-   In this example, not having the key @nested@ is a normal, recoverable failure, and parsing will continue looking for another key.-   However, if @nested@ is present but malformed, the entire parser fails.--   > parse o = (o .:> "nested") (withObject "nestedObj" (.: "value"))-   >         <|> tryParser (o .: "value")--   > { value: "foo", otherField: "bar" }-   > -> Right "foo"-   >-   > { value: "foo", nested: { value: "bar" } }-   > -> Right "bar"-   >-   > { value: "foo", nested: { bar: 9 } }-   > -> Left "Error in $.nested: key \"value\" not found"-   >-   > { value: "foo", nested: 9 }-   > -> Left "Error in $.nested: parsing nestedObj failed, expected Object, but encountered Number"-   >-   > {}-   > -> Left-   >   "Error in $: No match,-   >    - key \"value\" not found"-   >    - key \"nested\" not found"---}+-- |+--   Commit mechanism for aeson's 'Parser'.+--   To commit means that if some initial parsing succeeds, subsequent failures are unrecoverable.+--+--   In the following example, we use '.:>' to look for a key @.nested.value@, and if that does not exist, @.value@.+--+--   > parse o = (o .:> "nested") (withObject "nestedObj" (.: "value"))+--   >         <|> tryParser (o .: "value")+--+--   Not having the key @nested@ is a normal, recoverable failure, and parsing will continue looking for @value@.+--   However, if @nested@ is present but malformed, parsing fails.+--+--   > { value: "foo", otherField: "bar" }+--   > -> Right "foo"+--   >+--   > { value: "foo", nested: { value: "bar" } }+--   > -> Right "bar"+--   >+--   > { value: "foo", nested: { bar: 9 } }+--   > -> Left "Error in $.nested: key \"value\" not found"+--   >+--   > { value: "foo", nested: 9 }+--   > -> Left "Error in $.nested: parsing nestedObj failed, expected Object, but encountered Number"+--   >+--   > {}+--   > -> Left+--   >   "Error in $: No match,+--   >    - key \"value\" not found"+--   >    - key \"nested\" not found" module Data.Aeson.Commit-  ( commit-  , runCommit-  , (.:>)-  , tryParser-  , liftParser-  , Commit (..)-  ) where+  ( commit,+    runCommit,+    (.:>),+    tryParser,+    liftParser,+    Commit (..),+  )+where -import           Control.Applicative  (Alternative (..))-import           Control.Monad.Except-import           Data.Aeson.Types-import           Data.Text            (Text)-import           Data.Void            (Void, absurd)+import Control.Applicative (Alternative (..))+import Control.Monad.Except+import Data.Aeson.Types+import Data.Void (Void, absurd)+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as Key+#else+import Data.Text (Text)+#endif --- | A 'Parser' that has _two_ failure modes; recoverable and non-recoverable.---   The default, recoverable failure is the equivalent to aeson's default 'Parser' behavior.---   The non-recoverable failure mode is used to commit to a branch; to commit means that every subsequent failure is non-recoverable.+-- | A 'Commit' is a 'Parser' that has two failure modes; recoverable and non-recoverable. -----   You turn run a 'Commit' and capture its result in a 'Parser' using 'runCommit'.---   As an additional benefit, it will contain error info for all attempted parsing branches.+--   > tryParser empty <|> p = p+--   > liftParser empty <|> p = empty --+--   'Commit' is typically constructed using 'commit', and consumed using 'runCommit', which captures its result in a 'Parser'.+-- --   The implementation works by wrapping 'Parser' in an 'ExceptT'. --   The derived 'Alternative' instance will then only recover from failures in the 'ExceptT'. --   This means that as soon as we successfully construct a 'Right' value, the 'Alternative' considers the 'Commit' a success, even though the underlying parser might have failed.@@ -64,35 +71,41 @@ commit pre post = Commit $ do   a <- ExceptT $ captureError pre   lift $ post a-    where-      captureError :: Parser b -> Parser (Either [Parser Void] b)-      captureError p = Right <$> p <|> pure (Left [fmap (const undefined) p])+  where+    -- TODO maybe there's a better way to prove something is an error+    captureError :: Parser b -> Parser (Either [Parser Void] b)+    captureError p = Right <$> p <|> pure (Left [fmap (const undefined) p])  -- | Run a 'Commit', capturing its result in a 'Parser'. runCommit :: Commit a -> Parser a runCommit (Commit f) = runExceptT f >>= either handleErrors pure   where-  handleErrors :: [Parser Void] -> Parser a-  handleErrors []     = fail "No parsers tried"-  handleErrors (p:ps) = fmap absurd (go (p:ps) [] [])-    where-    go [] path errors = parserThrowError path ("No match,\n" <> unlines (fmap ("- " <>) errors))-    go (y:ys) _ msgs = parserCatchError y $ \path msg ->-      go ys path (msg:msgs)+    handleErrors :: [Parser Void] -> Parser a+    handleErrors [] = fail "No parsers tried"+    handleErrors (p : ps) = fmap absurd (go (p : ps) [] [])+      where         -- TODO: how do we handle the multiple JSONPaths?         -- Right now the rightmost failure's path is used when presenting         -- the error message. Ideally one path per error would be preferable but         -- `aeson` doesn't support such a thing. When errors are reported in `aeson`         -- a single JSONPath defines how the error message is presented.+        go [] path errors = parserThrowError path ("No match,\n" <> unlines (fmap ("- " <>) errors))+        go (y : ys) _ msgs = parserCatchError y $ \path msg ->+          go ys path (msg : msgs)  -- | Convenience wrapper around 'commit' for when the commit is checking whether a key is present in some object. --   If it is, it will commit and append the key to the JSONPath of the inner context through '<?>', which will give nicer error messages.++#if MIN_VERSION_aeson(2,0,0)+(.:>)  :: FromJSON a => Object -> Key.Key -> (a -> Parser b) -> Commit b+#else (.:>)  :: FromJSON a => Object -> Text -> (a -> Parser b) -> Commit b+#endif (o .:> k) cont = commit (o .: k) (\v -> cont v <?> Key k)  -- | Turn a 'Parser' into a 'Commit' --   Unlike 'liftParser', the parser's failure is recoverable.---   +-- -- > tryParser empty <|> p = p -- > tryParser p = commit p pure tryParser :: Parser a -> Commit a@@ -100,7 +113,7 @@  -- | Turn a 'Parser' into a 'Commit'. --   Unlike 'tryParser', the parser's failure is _not_ recoverable, i.e. the parse is always committed.---   +-- -- > liftParser empty <|> p = empty -- > liftParser p = commit (pure ()) (const p) liftParser :: Parser a -> Commit a

@@ -1,57 +1,59 @@-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}  module Main (main) where -import           Data.Aeson.QQ-import           Data.Aeson.Types-import           Data.Aeson.Commit-import           Control.Applicative-import           Data.Text (Text)-import           Test.Tasty-import           Test.Tasty.Hspec+import Control.Applicative+import Data.Aeson.Commit+import Data.Aeson.QQ+import Data.Aeson.Types+import Data.Text (Text)+import Test.Hspec  tests :: Spec-tests = testParserWithCases pNested-  [ ( "fails"-    , [aesonQQ| {} |]-    , Left $ unlines-      [ "Error in $: No match,"-      , "- key \"value\" not found"-      , "- key \"nested\" not found"-      ]-    )-  , ( "succeeds unnested"-    , [aesonQQ| { value: "top" } |]-    , Right "top"-    )-  , ( "succeeds and prefers nested"-    , [aesonQQ| { value: "top" , nested: { value: "nest" } } |]-    , Right "nest"-    )-  , ( "fails on malformed nested"-    , [aesonQQ| { value: "top", nested: { foo: 9 } } |]-    , Left "Error in $.nested: key \"value\" not found"-    )-  , ( "fails on nested type mismatch"-    , [aesonQQ| { value: "top", nested: 9 } |]-    , Left "Error in $.nested: parsing nestedObj failed, expected Object, but encountered Number"-    )-  ]+tests =+  testParserWithCases+    pNested+    [ ( "fails",+        [aesonQQ| {} |],+        Left $+          unlines+            [ "Error in $: No match,",+              "- key \"value\" not found",+              "- key \"nested\" not found"+            ]+      ),+      ( "succeeds unnested",+        [aesonQQ| { value: "top" } |],+        Right "top"+      ),+      ( "succeeds and prefers nested",+        [aesonQQ| { value: "top" , nested: { value: "nest" } } |],+        Right "nest"+      ),+      ( "fails on malformed nested",+        [aesonQQ| { value: "top", nested: { foo: 9 } } |],+        Left "Error in $.nested: key \"value\" not found"+      ),+      ( "fails on nested type mismatch",+        [aesonQQ| { value: "top", nested: 9 } |],+        Left "Error in $.nested: parsing nestedObj failed, expected Object, but encountered Number"+      )+    ]   where     pNested :: Value -> Parser Text     pNested = withObject "topLevel" $ \o ->-      runCommit-        $ (o .:> "nested") (withObject "nestedObj" (.: "value"))-        <|> tryParser (o .: "value")+      runCommit $+        (o .:> "nested") (withObject "nestedObj" (.: "value"))+          <|> tryParser (o .: "value") -testParserWithCases-  :: (Eq a, Show a)-  => (v -> Parser a)-  -> [(String, v, Either String a)]-  -> Spec+testParserWithCases ::+  (Eq a, Show a) =>+  (v -> Parser a) ->+  [(String, v, Either String a)] ->+  Spec testParserWithCases p =-  mapM_ ( \(name, v, result) -> it name (parseEither p v `shouldBe` result))+  mapM_ (\(name, v, result) -> it name (parseEither p v `shouldBe` result))  main :: IO ()-main = testSpecs tests >>= defaultMain . testGroup "aeson-commit"+main = hspec tests