annotated-exception 0.3.0.2 → 0.3.0.3
raw patch · 4 files changed
+85/−35 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- annotated-exception.cabal +1/−1
- src/Control/Exception/Annotated.hs +37/−15
- test/Control/Exception/AnnotatedSpec.hs +42/−19
ChangeLog.md view
@@ -1,5 +1,10 @@ # Changelog for `annotated-exception` +## 0.3.0.3++- [#36](https://github.com/parsonsmatt/annotated-exception/pull/36)+ - Improved the `AnotatedException` `displayException` implementation.+ ## 0.3.0.2 - [#32](https://github.com/parsonsmatt/annotated-exception/pull/32)
annotated-exception.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: annotated-exception-version: 0.3.0.2+version: 0.3.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
src/Control/Exception/Annotated.hs view
@@ -122,38 +122,60 @@ = Nothing - displayException (AnnotatedException {..}) =- unlines+ displayException (AnnotatedException{..}) =+ unlines $ [ "! AnnotatedException !" , "Underlying exception type: " <> show exceptionType , ""- , "show:"- , "\t" <> show exception- , ""- , "displayException:"- , "\t" <> Safe.displayException exception ]- <> annotationsMessage- <> callStackMessage+ <> showAndDisplayMessage+ <> annotationsMessage+ <> callStackMessage where exceptionType = case Safe.toException exception of SomeException innerException -> typeOf innerException++ shown = show exception+ displayed = Safe.displayException exception++ -- Only include the `show` section if it's not the same as the+ -- `displayException` output.+ --+ -- TODO: If the exception is multiple lines long, subsequent lines will+ -- not be indented.+ showAndDisplayMessage =+ if shown == displayed+ then+ [ displayed ]+ else+ [ "displayException:"+ , "\t" <> displayed+ , ""+ , "show:"+ , "\t" <> shown+ ]+ (callStacks, otherAnnotations) = tryAnnotations @CallStack annotations+ callStackMessage =+ [ ""+ ] <> case listToMaybe callStacks of Nothing ->- "(no callstack available)"+ ["(no callstack available)"] Just cs ->- prettyCallStack cs+ [prettyCallStack cs]+ annotationsMessage = case otherAnnotations of- [] ->- "\n"+ [] -> [] anns ->- "Annotations:\n"- <> unlines (map (\ann -> "\t * " <> show ann) anns)+ [ ""+ , "Annotations:"+ ]+ <> (map (\ann -> "\t * " <> show ann) anns) -- | Annotate the underlying exception with a 'CallStack'. --
test/Control/Exception/AnnotatedSpec.hs view
@@ -15,6 +15,7 @@ import qualified Control.Exception.Safe as Safe import Data.Annotation import Data.AnnotationSpec ()+import Data.List (dropWhileEnd) import Data.Maybe import Data.Typeable import GHC.Stack@@ -31,14 +32,20 @@ SomeException (e0 :: e0) == SomeException (e1 :: e1) = typeOf e0 == typeOf e1 && show e0 == show e1 +data TestDisplayException = TestDisplayException+ deriving (Eq, Show)++instance Exception TestDisplayException where+ displayException _ = "i am being displayed! :)"+ pass :: Expectation pass = pure () emptyAnnotation :: e -> AnnotatedException e emptyAnnotation = pure -omitEmptyLines :: String -> [String]-omitEmptyLines = filter (/= "") . lines+trimTrailingNewlines :: String -> String+trimTrailingNewlines = dropWhileEnd (== '\n') spec :: Spec spec = do@@ -60,48 +67,64 @@ describe "displayException" $ do it "is identical on SomeException" $ do- omitEmptyLines (displayException TestException)- `shouldBe` omitEmptyLines (displayException (SomeException TestException))+ trimTrailingNewlines (displayException TestException)+ `shouldBe` trimTrailingNewlines (displayException (SomeException TestException))++ it "uses show and displayException if they're different" $ do+ lines (displayException (AnnotatedException [] TestDisplayException))+ `shouldBe`+ [ "! AnnotatedException !"+ , "Underlying exception type: TestDisplayException"+ , ""+ , "displayException:"+ , "\ti am being displayed! :)"+ , ""+ , "show:"+ , "\tTestDisplayException"+ , ""+ , "(no callstack available)"+ ]+ it "is reasonably nice to look at" $ do- omitEmptyLines (displayException (AnnotatedException [] TestException))+ lines (displayException (AnnotatedException [] TestException)) `shouldBe` [ "! AnnotatedException !" , "Underlying exception type: TestException"- , "show:"- , "\tTestException"- , "displayException:"- , "\tTestException"+ , ""+ , "TestException"+ , "" , "(no callstack available)" ]+ it "is reasonably nice to look at" $ do lines (displayException (AnnotatedException [Annotation @String "asdf"] TestException)) `shouldBe` [ "! AnnotatedException !" , "Underlying exception type: TestException" , ""- , "show:"- , "\tTestException"+ , "TestException" , ""- , "displayException:"- , "\tTestException" , "Annotations:" , "\t * Annotation @[Char] \"asdf\""+ , "" , "(no callstack available)" ]+ it "shows underlying exception type" $ do Left exn <- try $ throwWithCallStack (AnnotatedException [Annotation @String "asdf"] TestException) let resultLines = [ "! AnnotatedException !" , "Underlying exception type: TestException"- , "show:"- , "\tTestException"- , "displayException:"- , "\tTestException"+ , ""+ , "TestException"+ , "" , "Annotations:" , "\t * Annotation @[Char] \"asdf\""+ , ""+ , "CallStack (from HasCallStack):" ]- take (length resultLines) (omitEmptyLines (displayException (exn :: AnnotatedException SomeException))) `shouldBe`- resultLines+ take (length resultLines) (lines (displayException (exn :: AnnotatedException TestException)))+ `shouldBe` resultLines describe "AnnotatedException can fromException a" $ do it "different type" $ do