annotated-exception 0.2.0.2 → 0.2.0.3

raw patch · 6 files changed

+109/−16 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• annotated-exception.cabal +1/−1
• src/Control/Exception/Annotated.hs +5/−5
• src/Control/Exception/Annotated/UnliftIO.hs +4/−4
• test/Control/Exception/Annotated/UnliftIOSpec.hs +40/−3
• test/Control/Exception/AnnotatedSpec.hs +54/−3

@@ -1,5 +1,10 @@ # Changelog for `annotated-exception` +## 0.2.0.3++- [#17](https://github.com/parsonsmatt/annotated-exception/pull/17)+    - Add `HasCallStack` to `catch` and `catches`+ ## 0.2.0.2  - [#14](https://github.com/parsonsmatt/annotated-exception/pull/14)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           annotated-exception-version:        0.2.0.2+version:        0.2.0.3 synopsis:       Exceptions, with checkpoints and context. description:    Please see the README on Github at <https://github.com/parsonsmatt/annotated-exception#readme> category:       Control

@@ -183,23 +183,23 @@ -- >     putStrLn "ok!" -- -- @since 0.1.0.0-catch :: (Exception e, MonadCatch m) => m a -> (e -> m a) -> m a+catch :: (HasCallStack, Exception e, MonadCatch m) => m a -> (e -> m a) -> m a catch action handler =-    catches action [Handler handler]+    withFrozenCallStack catches action [Handler handler]  -- | Like 'Safe.catches', but this function enhance the provided 'Handler's -- to "see through" any 'AnnotatedException's. -- -- @since 0.1.2.0-catches :: (MonadCatch m) => m a -> [Handler m a] -> m a+catches :: (MonadCatch m, HasCallStack) => m a -> [Handler m a] -> m a catches action handlers =-    Safe.catches action (mkAnnotatedHandlers handlers)+    Safe.catches action (withFrozenCallStack mkAnnotatedHandlers handlers)  -- | Extends each 'Handler' in the list with a variant that sees through -- the 'AnnotatedException' and re-annotates any rethrown exceptions. -- -- @since 0.1.1.0-mkAnnotatedHandlers :: MonadCatch m => [Handler m a] -> [Handler m a]+mkAnnotatedHandlers :: (HasCallStack, MonadCatch m) => [Handler m a] -> [Handler m a] mkAnnotatedHandlers xs =     xs >>= \(Handler hndlr) ->         [ Handler hndlr

@@ -118,13 +118,13 @@ -- -- @since 0.1.2.0 catch-    :: forall e m a. (MonadUnliftIO m, Exception e)+    :: forall e m a. (MonadUnliftIO m, Exception e, HasCallStack)     => m a     -> (e -> m a)     -> m a catch action handler =     withRunInIO $ \runInIO ->-        liftIO $ Catch.catch (runInIO action) (\e -> runInIO $ handler e)+        liftIO $ withFrozenCallStack Catch.catch (runInIO action) (\e -> runInIO $ handler e)  -- | Like 'Catch.tryAnnotated' but uses 'MonadUnliftIO' instead of 'Control.Monad.Catch.MonadCatch'. --@@ -152,11 +152,11 @@ -- -- @since 0.1.2.0 catches-    :: forall m a. MonadUnliftIO m+    :: forall m a. (MonadUnliftIO m, HasCallStack)     => m a     -> [Handler m a]     -> m a catches action handlers =     withRunInIO $ \runInIO -> do         let f (Handler k) = Handler (\e -> runInIO (k e))-        liftIO $ Catch.catches (runInIO action) (map f handlers)+        liftIO $ withFrozenCallStack Catch.catches (runInIO action) (map f handlers)

@@ -1,4 +1,4 @@-{-# language RecordWildCards, StrictData, RankNTypes #-}+{-# language ScopedTypeVariables, RecordWildCards, StrictData, RankNTypes #-}  module Control.Exception.Annotated.UnliftIOSpec where @@ -10,7 +10,10 @@ import GHC.Stack  import Data.AnnotationSpec ()-import Control.Exception.AnnotatedSpec (TestException(..))+import Control.Exception.AnnotatedSpec+    ( TestException(..)+    , callStackFunctionNamesShouldBe+    ) import Data.Maybe  asIO :: IO a -> IO a@@ -34,8 +37,42 @@                                 expectationFailure "Should not catch"                 action `shouldThrow` \(AnnotatedException _ e) ->                     e == userError "oh no"-+        it "includes a callstack location" $ do+            let+                action =+                    throw TestException+                        `catch`+                            \TestException ->+                                throw TestException+            action+                `Safe.catch`+                        \(e :: AnnotatedException TestException) -> do+                            annotations e+                                `callStackFunctionNamesShouldBe`+                                    [ "throw"+                                    , "throw"+                                    , "catch"+                                    ]     describe "catches" $ do+        it "has a callstack entry" $ do+            let+                action =+                    throw TestException+                        `catches`+                            [ Handler $ \TestException ->+                                throw TestException+                            ]+            action+                `Safe.catch`+                        \(e :: AnnotatedException TestException) -> do+                            annotations e+                                `callStackFunctionNamesShouldBe`+                                    [ "throw"+                                    , "throw"+                                    , "catches"+                                    ]++         describe "the right exception" $ do             it "works" $ asIO $ do                 throw TestException

@@ -15,7 +15,7 @@ import qualified Control.Exception.Safe as Safe import Data.Annotation import GHC.Stack-+import Data.Typeable import Data.AnnotationSpec () import Data.Maybe @@ -28,7 +28,8 @@     deriving (Eq, Show, Exception)  instance Eq SomeException where-    e0 == e1 = show e0 == show e1+    SomeException (e0 :: e0) == SomeException (e1 :: e1) =+        typeOf e0 == typeOf e1 && show e0 == show e1  pass :: Expectation pass = pure ()@@ -38,6 +39,22 @@  spec :: Spec spec = do+    describe "toException" $ do+        it "wraps inner in SomeException" $ do+            toException (AnnotatedException [] TestException)+                `shouldBe` do+                    SomeException+                        (AnnotatedException [] (SomeException TestException))+        it "flattens annotations" $ do+            let+                exn =+                    AnnotatedException ["hello"] $+                        AnnotatedException ["goodbye"] TestException+            toException exn+                `shouldBe` do+                    SomeException $+                        AnnotatedException ["hello", "goodbye"] (SomeException TestException)+     describe "AnnotatedException can fromException a" $ do         it "different type" $ do             fromException (toException TestException)@@ -105,6 +122,40 @@             action                 `shouldThrow`                     (userError "uh oh" ==)+        it "includes a callstack location" $ do+            let+                action =+                    throw TestException+                        `catch`+                            \TestException ->+                                throw TestException+            action+                `Safe.catch`+                        \(e :: AnnotatedException TestException) -> do+                            annotations e+                                `callStackFunctionNamesShouldBe`+                                    [ "throw"+                                    , "throw"+                                    , "catch"+                                    ]+    describe "catches" $ do+        it "has a callstack entry" $ do+            let+                action =+                    throw TestException+                        `catches`+                            [ Handler $ \TestException ->+                                throw TestException+                            ]+            action+                `Safe.catch`+                        \(e :: AnnotatedException TestException) -> do+                            annotations e+                                `callStackFunctionNamesShouldBe`+                                    [ "throw"+                                    , "throw"+                                    , "catches"+                                    ]      describe "tryAnnotated" $ do         let subject :: (Exception e, Exception e') => e -> IO (AnnotatedException e')@@ -153,7 +204,7 @@                     `Safe.catch` \(e :: AnnotatedException TestException) -> do                         annotations e                             `callStackFunctionNamesShouldBe`-                                ["throwWithCallStack"+                                [ "throwWithCallStack"                                 , "checkpointCallStack"                                 ]