error-context 0.1.0.0 → 0.1.1.0

raw patch · 3 files changed

+98/−44 lines, 3 filesdep −eitherPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: either

API changes (from Hackage documentation)

Files

• error-context.cabal +2/−4
• src/Control/Error/Context.hs +39/−37
• test/Control/Error/Context/Test.hs +57/−3

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 73e6d19a6c9cb2896dc6e9b9b7465b7a556008ed26855c87123649feea1d426b+-- hash: 369905ea93b6cf094576c09b64bd7e22102e1f70d9b188d9386b7b6171d00077  name:           error-context-version:        0.1.0.0+version:        0.1.1.0 synopsis:       Provides API for enriching errors with contexts description:    Please see the README on Github at <https://github.com/mtesseract/error-context#readme> category:       Control, Error Handling@@ -33,7 +33,6 @@   ghc-options: -Wall   build-depends:       base >=4.7 && <5-    , either     , exceptions     , monad-logger     , mtl@@ -55,7 +54,6 @@   ghc-options: -Wall -g -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5-    , either     , error-context     , exceptions     , monad-logger

@@ -31,16 +31,16 @@   , errorWithContextDump   , catchWithoutContext   , catchWithContext-  , tryWithContext-  , tryAnyWithContext-  , catchJustWithContext   , catchAnyWithContext   , ensureExceptionContext-  )-  where+  , tryAnyWithContext+  , tryAnyWithoutContext+  , tryWithContext+  , tryWithoutContext+  ) where  import           Control.Exception.Safe       (SomeException (..), catchAny,-                                               catchJust, try, tryAny)+                                               catchJust) import           Control.Monad.Catch          (Exception (..), MonadCatch (..),                                                MonadThrow, throwM) import           Control.Monad.IO.Unlift@@ -48,7 +48,6 @@ import           Control.Monad.State import           Control.Monad.Trans.Resource import           Control.Monad.Writer-import           Data.Either.Combinators      (mapLeft) import           Data.Text                    (Text) import qualified Data.Text                    as Text import           Data.Typeable@@ -171,41 +170,53 @@ catchWithoutContext m handler = catchJust pre m handler   where pre :: SomeException -> Maybe e         pre someExn =-          -- First we check if the exception is of the type 'e'-          -- (without context). If so, provide it to the handler-          -- directly.-          case fromException someExn :: Maybe e of-            Just exn ->-              Just exn+          -- First we check if the exception is of the type+          -- 'ErrorWithContext e'. In this case we forget the context+          -- and provide the exception without context to the handler.+          case fromException someExn :: Maybe (ErrorWithContext SomeException) of+            Just (ErrorWithContext _ctx someExnWithoutContext) ->+              case fromException someExnWithoutContext :: Maybe e of+                Just exn ->+                  Just exn+                Nothing ->+                  Nothing             Nothing  ->-              -- Then we check if the exception is of the type-              -- 'ErrorWithContext e'. In this case we forget the-              -- context and provide the exception without context to-              -- the handler.-              case fromException someExn :: Maybe (ErrorWithContext SomeException) of-                Just (ErrorWithContext _ctx someExnWithoutContext) ->-                  case fromException someExnWithoutContext :: Maybe e of-                    Just exn ->-                      Just exn-                    Nothing ->-                      Nothing+              -- Then we check if the exception is of type 'e'. If so,+              -- provide it to the handler directly.+              case fromException someExn :: Maybe e of+                Just exn ->+                  Just exn                 Nothing  ->                   Nothing  tryAnyWithContext-  :: (MonadErrorContext m, MonadCatch m)+  :: MonadCatch m   => m a   -> m (Either (ErrorWithContext SomeException) a) tryAnyWithContext m =-  mapLeft (ErrorWithContext (ErrorContext [])) <$> tryAny m+  catchWithContext (Right `liftM` m) (return . Left) +tryAnyWithoutContext+  :: MonadCatch m+  => m a+  -> m (Either SomeException a)+tryAnyWithoutContext m =+  catchWithoutContext (Right `liftM` m) (return . Left)+ tryWithContext-  :: (MonadErrorContext m, MonadCatch m, Exception e)+  :: (MonadCatch m, Exception e)   => m a   -> m (Either (ErrorWithContext e) a) tryWithContext m =-  mapLeft (ErrorWithContext (ErrorContext [])) <$> try m+  catchWithContext (Right `liftM` m) (return . Left) +tryWithoutContext+  :: (MonadCatch m, Exception e)+  => m a+  -> m (Either e a)+tryWithoutContext m =+  catchWithoutContext (Right `liftM` m) (return . Left)+ -- | Implement 'MonadResource' for 'ErrorContextT'. instance (MonadCatch m, MonadResource m) => MonadResource (ErrorContextT m) where   liftResourceT = lift . liftResourceT@@ -255,15 +266,6 @@   :: ErrorWithContext e   -> e errorContextForget (ErrorWithContext _ctx e) = e--catchJustWithContext-  :: (MonadCatch m, Exception e)-  => (e -> Maybe b)-  -> m a-  -> (b -> m a)-  -> m a-catchJustWithContext f a b =-  a `catch` \ exn -> maybe (throwM exn) b $ f exn  -- | Context aware version of 'catchAny'. catchAnyWithContext

@@ -18,14 +18,13 @@ tests =   testGroup     "Tests"-    [ testCase "Contextualize IO Exception"+    [+      testCase "Contextualize IO Exception"         testContextualizeIOException     , testCase "throwM"         testThrow     , testCase "catchAnyWithContext"         testCatchAnyWithContext-    -- , testCase "catchJustWithContext"-    --     testCatchJustWithContext     , testCase "Catch context-enriched exception without context"         testCatchWithoutContext     , testCase "Contextualize error value"@@ -40,6 +39,18 @@         testNonContextualizedCatchWithContext     , testCase "ensureExceptionContext"         testEnsureExceptionContext+    , testCase "catch head exception"+        testCatchHeadException+    , testCase "tryAnyWithoutContext"+        testTryAnyWithoutContext+    , testCase "tryAnyWithContext"+        testTryAnyWithContext+    , testCase "tryWithContext"+        testTryWithContext+    , testCase "tryWithoutContext"+        testTryWithoutContext+    , testCase "Throw and catch"+        testThrowAndCatch     ]  data TestException = TestException deriving (Show, Eq)@@ -129,3 +140,46 @@   let Just (ErrorWithContext ctx someExnWithoutCtx) = fromException someExn   Just TestException @=? fromException someExnWithoutCtx   ErrorContext ["B", "A"] @=? ctx++testCatchHeadException :: Assertion+testCatchHeadException = do+  Left errWithCtx <- tryAnyWithContext . runErrorContextT $ do+    withErrorContext "Here I am, calling head on an empty list!" $+      ensureExceptionContext $ seq (head []) (pure ())+  let (ErrorWithContext _ctx _exnWithoutCtx) = errWithCtx+  putStrLn . displayException $ errWithCtx++testTryAnyWithContext :: Assertion+testTryAnyWithContext = do+  Left (ErrorWithContext _ctx someExn) <- tryAnyWithContext . runErrorContextT $ do+    void $ throwM TestException+    pure ()+  Just TestException @=? fromException someExn++testTryAnyWithoutContext :: Assertion+testTryAnyWithoutContext = do+  Left someExn <- tryAnyWithoutContext . runErrorContextT $ do+    void $ throwM TestException+    pure ()+  Just TestException @=? fromException someExn++testTryWithContext :: Assertion+testTryWithContext = do+  Left (ErrorWithContext _ctx exn) <- tryWithContext . runErrorContextT $ do+    void $ throwM TestException+    pure ()+  TestException @=? exn++testTryWithoutContext :: Assertion+testTryWithoutContext = do+  Left exn <- tryWithoutContext . runErrorContextT $ do+    void $ throwM TestException+    pure ()+  TestException @=? exn++-- testTryAnyWithoutContext :: Assertion+-- testTryAnyWithoutContext = do+--   Left someExn <- tryAnyWithoutContext . runErrorContextT $ do+--     void $ throwM TestException+--     pure ()+--   Just TestException @=? fromException someExn