From 1951566f5e3c85c8347691776b3f2c09940894fa Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Fri, 14 Jul 2017 12:33:10 -0400 Subject: [PATCH 1/4] Add tests for error class changes --- test-suite/RatelSpec.hs | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/test-suite/RatelSpec.hs b/test-suite/RatelSpec.hs index 5e98e04..6097392 100644 --- a/test-suite/RatelSpec.hs +++ b/test-suite/RatelSpec.hs @@ -2,7 +2,7 @@ module RatelSpec (spec) where import qualified Control.Exception as Exception import qualified Ratel -import Test.Tasty.Hspec +import Test.Tasty.Hspec spec :: Spec spec = describe "Ratel" $ do @@ -22,7 +22,7 @@ spec = describe "Ratel" $ do , Ratel.traceNumber = Just "16:34" } ] - , Ratel.errorClass = Just "SomeException" + , Ratel.errorClass = Just "SomeException: something went wrong" , Ratel.errorMessage = Just "\ \something went wrong\n\ \CallStack (from HasCallStack):\n\ @@ -31,3 +31,27 @@ spec = describe "Ratel" $ do , Ratel.errorTags = Nothing } actual `shouldBe` expected) + it "should abbreviate longer errors" $ do + Exception.catch + (do + _ <- error "something went wrong, and now the server is on fire" + True `shouldBe` False) + (\ exception -> do + let actual = Ratel.toError (exception :: Exception.SomeException) + let expected = Ratel.Error + { Ratel.errorBacktrace = Just + [ Ratel.Trace + { Ratel.traceFile = Just "test-suite/RatelSpec.hs" + , Ratel.traceMethod = Just "RatelSpec.toError" + , Ratel.traceNumber = Just "40:34" + } + ] + , Ratel.errorClass = Just "SomeException: something went wrong, and now " + , Ratel.errorMessage = Just "\ + \something went wrong, and now the server is on fire\n\ + \CallStack (from HasCallStack):\n\ + \ error, called at test-suite/RatelSpec.hs:37:26 in main:RatelSpec" + , Ratel.errorSource = Nothing + , Ratel.errorTags = Nothing + } + actual `shouldBe` expected) From 575bd233ec87230c29b2fa6bc70407cdee56cdd9 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Fri, 14 Jul 2017 12:37:05 -0400 Subject: [PATCH 2/4] Format error class field to include part of message --- library/Ratel.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/library/Ratel.hs b/library/Ratel.hs index ccf6712..5c9f127 100644 --- a/library/Ratel.hs +++ b/library/Ratel.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE OverloadedStrings #-} module Ratel where @@ -58,12 +59,17 @@ notify apiKey maybeManager initialPayload = do toError :: (?callStack :: Stack.CallStack) => Exception.SomeException -> Error toError exception = Error { errorBacktrace = Just (toTraces ?callStack) - , errorClass = Just (show (Typeable.typeOf exception)) + , errorClass = Just $ concat [ show (Typeable.typeOf exception) + , ": " + , (take 30 . takeUntilNewline) (Exception.displayException exception)] , errorMessage = Just (Exception.displayException exception) , errorSource = Nothing , errorTags = Nothing } +takeUntilNewline :: String -> String +takeUntilNewline s = + Text.unpack $ fst $ Text.breakOn "\n" $ Text.pack s toTraces :: Stack.CallStack -> [Trace] toTraces callStack = map (uncurry toTrace) (Stack.getCallStack callStack) From f4a6ca60d9edcec83cbe67b8e9fd885074daf28c Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Fri, 14 Jul 2017 13:58:30 -0400 Subject: [PATCH 3/4] Bump version number --- package.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.yaml b/package.yaml index b7dbdfa..45f4b19 100644 --- a/package.yaml +++ b/package.yaml @@ -36,4 +36,4 @@ tests: - tasty-hspec ==1.1.* main: Main.hs source-dirs: test-suite -version: '0.3.3' +version: '0.4.0' From 901fa37decad1df832ae1411cc701d249b98edaf Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Sun, 16 Jul 2017 09:38:06 -0400 Subject: [PATCH 4/4] Add tfausak suggestions --- library/Ratel.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/library/Ratel.hs b/library/Ratel.hs index 5c9f127..acb4df0 100644 --- a/library/Ratel.hs +++ b/library/Ratel.hs @@ -55,22 +55,17 @@ notify apiKey maybeManager initialPayload = do Left message -> fail message Right notice -> return (unwrapNoticeUuid (noticeUuid notice)) - -toError :: (?callStack :: Stack.CallStack) => Exception.SomeException -> Error +toError :: (Exception.Exception exception, Stack.HasCallStack) => exception -> Error toError exception = Error { errorBacktrace = Just (toTraces ?callStack) , errorClass = Just $ concat [ show (Typeable.typeOf exception) , ": " - , (take 30 . takeUntilNewline) (Exception.displayException exception)] + , (take 30 . takeWhile (/= '\n')) (Exception.displayException exception)] , errorMessage = Just (Exception.displayException exception) , errorSource = Nothing , errorTags = Nothing } -takeUntilNewline :: String -> String -takeUntilNewline s = - Text.unpack $ fst $ Text.breakOn "\n" $ Text.pack s - toTraces :: Stack.CallStack -> [Trace] toTraces callStack = map (uncurry toTrace) (Stack.getCallStack callStack)