annotated-exception 0.2.0.4 → 0.2.0.5

raw patch · 4 files changed

+76/−20 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• annotated-exception.cabal +2/−2
• src/Control/Exception/Annotated.hs +36/−18
• test/Control/Exception/AnnotatedSpec.hs +32/−0

@@ -1,5 +1,11 @@ # Changelog for `annotated-exception` +## 0.2.0.5++- [#27](https://github.com/parsonsmatt/annotated-exception/pull/27)+    - Ensure that `flatten` combines `CallStack`s even when the callstack is+      attached manually.+ ## 0.2.0.4  - [#18](https://github.com/parsonsmatt/annotated-exception/pull/18)

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           annotated-exception-version:        0.2.0.4+version:        0.2.0.5 synopsis:       Exceptions, with checkpoints and context. description:    Please see the README on Github at <https://github.com/parsonsmatt/annotated-exception#readme> category:       Control

@@ -57,6 +57,7 @@     , Handler (..)     ) where +import Control.Applicative ((<|>)) import Control.Exception.Safe        (Exception, Handler(..), MonadCatch, MonadThrow, SomeException(..)) import qualified Control.Exception.Safe as Safe@@ -257,7 +258,22 @@ -- -- @since 0.1.0.0 flatten :: AnnotatedException (AnnotatedException e)  -> AnnotatedException e-flatten (AnnotatedException a (AnnotatedException b c)) = AnnotatedException (a ++ b) c+flatten (AnnotatedException a (AnnotatedException b c)) = AnnotatedException (go Nothing a b) c+  where+    go :: Maybe CallStack -> [Annotation] -> [Annotation] -> [Annotation]+    go mcallstack [] bs =+        case mcallstack of+            Just cs ->+                addCallStackToAnnotations cs bs+            Nothing ->+                bs+    go mcallstack (a : as) bs =+        case castAnnotation a of+            Just cs ->+                let newAcc = fmap (mergeCallStack cs) mcallstack <|> Just cs+                 in go newAcc as bs+            Nothing ->+                a : go mcallstack as bs  tryFlatten :: SomeException -> SomeException tryFlatten exn =@@ -354,10 +370,12 @@     :: CallStack     -> AnnotatedException exception     -> AnnotatedException exception-addCallStackToException cs (AnnotatedException annotations' e) =-    AnnotatedException anns' e+addCallStackToException cs (AnnotatedException anns e) =+    AnnotatedException (addCallStackToAnnotations cs anns) e++addCallStackToAnnotations :: CallStack -> [Annotation] -> [Annotation]+addCallStackToAnnotations cs anns = go anns   where-    anns' = go annotations'     -- not a huge fan of the direct recursion, but it seems easier than trying     -- to finagle a `foldr` or something     go [] =@@ -365,23 +383,23 @@     go (ann : anns) =         case castAnnotation ann of             Just preexistingCallStack ->-                mergeCallStack preexistingCallStack cs : anns+                Annotation (mergeCallStack preexistingCallStack cs) : anns             Nothing ->                 ann : go anns -    -- we want to merge callstack but not duplicate entries-    mergeCallStack pre new =-        Annotation-            $ fromCallSiteList-            $ fmap (fmap fromSrcLocOrd)-            $ ordNub-            $ fmap (fmap toSrcLocOrd)-            $ getCallStack pre <> getCallStack new--toSrcLocOrd (SrcLoc a b c d e f g) =-    (a, b, c, d, e, f, g)-fromSrcLocOrd (a, b, c, d, e, f, g) =-    SrcLoc a b c d e f g+-- we want to merge callstack but not duplicate entries+mergeCallStack :: CallStack -> CallStack -> CallStack+mergeCallStack pre new =+        fromCallSiteList+        $ fmap (fmap fromSrcLocOrd)+        $ ordNub+        $ fmap (fmap toSrcLocOrd)+        $ getCallStack pre <> getCallStack new+  where+    toSrcLocOrd (SrcLoc a b c d e f g) =+        (a, b, c, d, e, f, g)+    fromSrcLocOrd (a, b, c, d, e, f, g) =+        SrcLoc a b c d e f g  -- | Remove duplicates but keep elements in order. --   O(n * log n)

@@ -364,6 +364,32 @@                 , "checkpoint"                 ] +        it "handles CallStack nicely when throwing" $ do+            Left (AnnotatedException anns TestException) <- try $+                throw TestException++            shouldHaveAtMostOneCallStack anns++        it "handles CallStack nicely when throwing manually-created AnnotatedException" $ do+            Left (AnnotatedException anns TestException) <- try $+                throw (AnnotatedException [Annotation callStack] TestException)++            shouldHaveAtMostOneCallStack anns++        it "handles CallStack nicely when rethrowing" $ do+            Left (AnnotatedException anns TestException) <- try $+                throw TestException+                    `Safe.catch` (\e -> throw (e :: AnnotatedException TestException))++            shouldHaveAtMostOneCallStack anns++        it "handles CallStack nicely when rethrowing manually-created AnnotatedException" $ do+            Left (AnnotatedException anns TestException) <- try $+                throw (AnnotatedException [Annotation callStack] TestException)+                    `Safe.catch` (\e -> throw (e :: AnnotatedException TestException))++            shouldHaveAtMostOneCallStack anns+     describe "HasCallStack behavior" $ do         -- This section of the test suite exists to verify that some behavior         -- acts how I expect it to. And/or learn how it behaves. Lol.@@ -460,6 +486,12 @@   where     filterCallStack anns =         snd $ tryAnnotations @CallStack anns++shouldHaveAtMostOneCallStack :: HasCallStack => [Annotation] -> IO ()+shouldHaveAtMostOneCallStack anns =+    if (length (fst (tryAnnotations anns) :: [CallStack]) > 1)+    then expectationFailure $ "has too many callstacks: " ++ show anns+    else pure ()  callStackFromFunctionName :: String -> CallStack callStackFromFunctionName str =