annotated-exception 0.1.2.0 → 0.1.2.1
raw patch · 4 files changed
+65/−13 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +9/−0
- annotated-exception.cabal +1/−1
- src/Control/Exception/Annotated.hs +16/−12
- test/Control/Exception/AnnotatedSpec.hs +39/−0
ChangeLog.md view
@@ -2,6 +2,15 @@ ## Unreleased changes +## 0.1.2.1++- [#8](https://github.com/parsonsmatt/annotated-exception/pull/8)+ - There was a bug where catching or trying to catch an exception of the+ wrong type would trigger an infinite loop as the `fromException` method+ kept digging and digging and would be unable to make things work out. The+ `fromException` code no longer tries to flatten out these exceptions.+ However, `toException` *does* flatten it, so all tests still pass.+ ## 0.1.2.0 - [#6](https://github.com/parsonsmatt/annotated-exception/pull/6)
annotated-exception.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: annotated-exception-version: 0.1.2.0+version: 0.1.2.1 synopsis: Exceptions, with checkpoints and context. description: Please see the README on Github at <https://github.com/parsonsmatt/annotated-exception#readme> category: Control
src/Control/Exception/Annotated.hs view
@@ -65,6 +65,7 @@ import Data.Typeable import GHC.Stack + -- | The 'AnnotatedException' type wraps an @exception@ with -- a @['Annotation']@. This can provide a sort of a manual stack trace with -- programmer provided data.@@ -93,15 +94,13 @@ -- an empty context, so catching a @'AnnotatedException' e@ will also catch -- a regular @e@ and give it an empty set of annotations. ----- Likewise, if a @'AnnotatedException' ('AnnotatedException' e)@ is thrown--- somehow, then the 'fromException' will flatten it and combine their--- contexts.--- -- For the most up to date details, see the test suite. -- -- @since 0.1.0.0 instance (Exception exception) => Exception (AnnotatedException exception) where- toException loc = SomeException $ hide loc+ toException loc =+ tryFlatten $ SomeException $ hide loc+ fromException (SomeException exn) | Just x <- cast exn =@@ -114,9 +113,6 @@ | Just (e :: exception) <- Safe.fromException exn = pure $ new e- | Just x <- flatten <$> Safe.fromException exn- =- pure x | otherwise = Nothing@@ -223,10 +219,10 @@ -- -- @since 0.1.0.1 try :: (Exception e, MonadCatch m) => m a -> m (Either e a)-try action = do+try action = (Right <$> action)- `catches`- mkAnnotatedHandlers [Handler (\exn -> pure $ Left exn)]+ `catch`+ (\exn -> pure $ Left exn) -- | Attaches the 'CallStack' to the 'AnnotatedException' that is thrown. --@@ -246,6 +242,14 @@ flatten :: AnnotatedException (AnnotatedException e) -> AnnotatedException e flatten (AnnotatedException a (AnnotatedException b c)) = AnnotatedException (a ++ b) c +tryFlatten :: SomeException -> SomeException+tryFlatten exn =+ case Safe.fromException exn of+ Just (a :: AnnotatedException (AnnotatedException SomeException)) ->+ SomeException $ flatten a+ Nothing ->+ exn+ -- | Add a single 'Annotation' to any exceptions thrown in the following -- action. --@@ -303,7 +307,7 @@ checkpointCallStack = checkpointCallStackWith [] --- | Add the list of 'Annotations' to any exception thrown in the following+-- | Add the list of 'Annotation' to any exception thrown in the following -- action. -- -- @since 0.1.0.0
test/Control/Exception/AnnotatedSpec.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -38,6 +39,16 @@ `shouldBe` Just (new TestException) + it "can i guess also parse into a nested Annotated" $ do+ fromException (toException (new TestException))+ `shouldBe`+ Just (new (new TestException))++ it "does not loop infinitely if the wrong type is selected" $ do+ fromException (toException TestException)+ `shouldNotBe`+ Just (new $ userError "uh oh")+ describe "throw" $ do it "wraps exceptions" $ do throw TestException@@ -70,6 +81,16 @@ \(AnnotatedException _ (_ :: SomeException)) -> pass + it "permits other types to pass through" $ do+ let action =+ Safe.throw (userError "uh oh")+ `Safe.catch`+ \(AnnotatedException _ TestException) ->+ expectationFailure "Should not catch"+ action+ `shouldThrow`+ (userError "uh oh" ==)+ describe "try" $ do let subject :: (Exception e, Exception e') => e -> IO e' subject exn = do@@ -93,6 +114,24 @@ it "can catch an Annotated exception" $ do exn <- subject TestException exn `shouldBe` new TestException++ describe "when the wrong error is tried " $ do+ let+ boom :: IO a+ boom =+ Safe.throwIO $ userError "uh oh"+ it "does not catch the exception" $ do+ let+ scenario = do+ eres <- try boom+ case eres of+ Left TestException ->+ pure ()+ Right () ->+ pure ()+ scenario+ `shouldThrow`+ (\e -> userError "uh oh" == e) -- TestException describe "nesting behavior" $ do it "can catch at any level of nesting" $ do