freckle-app 1.25.0.1 → 1.26.0.0
raw patch · 5 files changed
+8/−272 lines, 5 filesdep −annotated-exceptionPVP ok
version bump matches the API change (PVP)
Dependencies removed: annotated-exception
API changes (from Hackage documentation)
- Freckle.App.Test.Hspec.AnnotatedException: annotateHUnitFailure :: AnnotatedException HUnitFailure -> HUnitFailure
- Freckle.App.Test.Hspec.AnnotatedException: unwrapAnnotatedHUnitFailure :: Spec -> Spec
Files
- CHANGELOG.md +6/−0
- freckle-app.cabal +1/−7
- library/Freckle/App/Test/Hspec/AnnotatedException.hs +0/−107
- package.yaml +1/−5
- tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs +0/−153
CHANGELOG.md view
@@ -1,5 +1,11 @@ ## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-app-v1.25.0.0...main) +## [v1.26.0.0](https://github.com/freckle/freckle-app/compare/freckle-app-v1.24.0.1...freckle-app-v1.25.0.0)++- Remove `Freckle.App.Test.Hspec.AnnotatedException`++ This module can now be found in `freckle-exception-0.1.0.0`.+ ## [v1.25.0.0](https://github.com/freckle/freckle-app/compare/freckle-app-v1.24.0.1...freckle-app-v1.25.0.0) Stop re-exporting modules from extracted `freckle-` packages. To continue using
freckle-app.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: freckle-app-version: 1.25.0.1+version: 1.26.0.0 license: MIT license-file: LICENSE maintainer: Freckle Education@@ -37,7 +37,6 @@ Freckle.App.Scientist Freckle.App.Test Freckle.App.Test.DocTest- Freckle.App.Test.Hspec.AnnotatedException Freckle.App.Test.Hspec.Runner Freckle.App.Test.Properties.JSON Freckle.App.Test.Properties.PathPiece@@ -75,7 +74,6 @@ MonadRandom >=0.5.3, QuickCheck >=2.14.3, aeson >=2.0.3.0,- annotated-exception >=0.2.0.4, autodocodec >=0.2.0.3, autodocodec-openapi3 >=0.2.1.1, base >=4.16.4.0 && <5,@@ -179,7 +177,6 @@ Freckle.App.Bugsnag.MetaDataSpec Freckle.App.BugsnagSpec Freckle.App.CsvSpec- Freckle.App.Test.Hspec.AnnotatedExceptionSpec Freckle.App.Test.Properties.JSONSpec Freckle.App.Test.Properties.PathPieceSpec Freckle.App.Test.Properties.PersistValueSpec@@ -204,10 +201,8 @@ build-depends: Blammo >=2.1.0.0,- HUnit >=1.6.2.0, QuickCheck >=2.14.3, aeson >=2.0.3.0,- annotated-exception >=0.2.0.4, async >=2.2.4, base >=4.16.4.0 && <5, bugsnag >=1.1.0.0,@@ -215,7 +210,6 @@ cassava >=0.5.3.0, conduit >=1.3.5, freckle-app,- freckle-exception >=0.0.0.0, freckle-prelude >=0.0.4.0, freckle-stats >=0.0.0.0, hs-opentelemetry-api >=0.1.0.0,
− library/Freckle/App/Test/Hspec/AnnotatedException.hs
@@ -1,107 +0,0 @@-module Freckle.App.Test.Hspec.AnnotatedException- ( unwrapAnnotatedHUnitFailure- , annotateHUnitFailure- ) where--import Freckle.App.Prelude--import Control.Exception qualified-import Control.Lens (Lens', lens, over)-import Data.Annotation (Annotation, tryAnnotations)-import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)-import Data.Text qualified as T-import Freckle.App.Exception (AnnotatedException (..))-import GHC.Stack (CallStack, prettyCallStack)-import Test.HUnit.Lang (FailureReason (..), HUnitFailure (..))-import Test.Hspec---- | An hspec hook that lets hspec catch and pretty-print 'HUnitFailure', the--- exception that is thrown when a test assertion fails------ Tests for any code that might throw 'AnnotatedException' (which includes anything--- that uses freckle-app) should add this hook to their test suite. Without it, if--- you end up with an @'AnnotatedException' 'HUnitFailure'@, hspec doesn't recognize--- it as an assertion failure and you get ugly output instead of nice output.-unwrapAnnotatedHUnitFailure :: Spec -> Spec-unwrapAnnotatedHUnitFailure = around_ $ mapException annotateHUnitFailure--mapException :: (Exception e, Exception e') => (e -> e') -> IO a -> IO a-mapException f = Control.Exception.handle $ Control.Exception.throw . f--annotateHUnitFailure :: AnnotatedException HUnitFailure -> HUnitFailure-annotateHUnitFailure- AnnotatedException {exception, annotations} =- over hUnitFailureReason (annotateFailureReason annotations) exception--hUnitFailureReason :: Lens' HUnitFailure FailureReason-hUnitFailureReason =- lens- (\(HUnitFailure _ x) -> x)- (\(HUnitFailure l _) x -> HUnitFailure l x)---- | Augment a 'FailureReason' with extra information derived from 'Annotation's-annotateFailureReason :: [Annotation] -> FailureReason -> FailureReason-annotateFailureReason as =- \case- Reason m -> Reason (makeMessage m as)- ExpectedButGot m e g -> ExpectedButGot (makeMessageMaybe m as) e g---- | Construct a message that consists of an introductory paragraph plus--- some additional paragraphs based on annotations, separated by blank lines-makeMessage :: String -> [Annotation] -> String-makeMessage m as =- combineParagraphs $ stringParagraph m :| annotationParagraphs as---- | Like 'makeMessage' but without necessarily having an introductory paragraph present------ If there is neither an introductory paragraph nor any annotations, the result is 'Nothing'.-makeMessageMaybe :: Maybe String -> [Annotation] -> Maybe String-makeMessageMaybe mm as =- fmap combineParagraphs $- nonEmpty $- fmap stringParagraph (toList mm) <> annotationParagraphs as---- | Text that constitutes a paragraph in a potentially lengthy error message------ Construct with 'stringParagraph' or 'textParagraph', which strip the text of--- surrounding whitespace.-newtype Paragraph = Paragraph {paragraphText :: Text}--stringParagraph :: String -> Paragraph-stringParagraph = textParagraph . T.pack--textParagraph :: Text -> Paragraph-textParagraph = Paragraph . T.strip---- | Combine a list of paragraphs into a single string for the final output-combineParagraphs :: Foldable t => t Paragraph -> String-combineParagraphs =- T.unpack . T.intercalate "\n\n" . fmap paragraphText . toList---- | Render a list of annotations as a list of paragraphs------ The paragraphs, depending on how much information there is to display, are:------ * a summary of any annotations that aren't call stacks, if any--- * the first call stack, if there are any call stacks-annotationParagraphs :: [Annotation] -> [Paragraph]-annotationParagraphs annotations =- catMaybes- [ otherAnnotationsPart <$> nonEmpty otherAnnotations- , callStackPart <$> listToMaybe callStacks- ]- where- (callStacks, otherAnnotations) = tryAnnotations @CallStack annotations---- | Construct a paragraph consisting of a bullet list of annotations-otherAnnotationsPart :: Foldable t => t Annotation -> Paragraph-otherAnnotationsPart =- textParagraph- . T.intercalate "\n"- . ("Annotations:" :)- . fmap (("\t * " <>) . T.pack . show)- . toList---- | Construct a paragraph that displays a call stack-callStackPart :: CallStack -> Paragraph-callStackPart = textParagraph . T.pack . prettyCallStack
package.yaml view
@@ -1,5 +1,5 @@ name: freckle-app-version: 1.25.0.1+version: 1.26.0.0 maintainer: Freckle Education category: Utils@@ -62,7 +62,6 @@ - HUnit - MonadRandom - QuickCheck- - annotated-exception - autodocodec - autodocodec-openapi3 - aeson@@ -132,9 +131,7 @@ source-dirs: tests ghc-options: -threaded -rtsopts "-with-rtsopts=-N" dependencies:- - annotated-exception - Blammo- - HUnit - QuickCheck - aeson - async@@ -143,7 +140,6 @@ - cassava - conduit - freckle-app- - freckle-exception - freckle-prelude - freckle-stats - hs-opentelemetry-api
− tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs
@@ -1,153 +0,0 @@-module Freckle.App.Test.Hspec.AnnotatedExceptionSpec- ( spec- ) where--import Freckle.App.Prelude--import Data.Annotation (toAnnotation)-import Data.List (intercalate)-import Freckle.App.Exception (AnnotatedException (..))-import Freckle.App.Test.Hspec.AnnotatedException (annotateHUnitFailure)-import GHC.Exts (fromList)-import GHC.Stack (CallStack, SrcLoc (..))-import Test.HUnit.Lang (FailureReason (..), HUnitFailure (..))-import Test.Hspec (Spec, describe, it, shouldBe)--spec :: Spec-spec = do- describe "annotateHUnitFailure" $ do- describe "does nothing if there are no annotations" $ do- it "when the failure is Reason" $- let e = HUnitFailure Nothing (Reason "x")- in annotateHUnitFailure (AnnotatedException [] e) `shouldBe` e-- it "when the failure is ExpectedButGot with no message" $- let e = HUnitFailure Nothing (ExpectedButGot Nothing "a" "b")- in annotateHUnitFailure (AnnotatedException [] e) `shouldBe` e-- it "when the failure is ExpectedButGot with a message" $- let e = HUnitFailure Nothing (ExpectedButGot (Just "x") "a" "b")- in annotateHUnitFailure (AnnotatedException [] e) `shouldBe` e-- describe "can show an annotation" $ do- it "when the failure is Reason" $- annotateHUnitFailure- AnnotatedException- { annotations = [toAnnotation @Int 56]- , exception = HUnitFailure Nothing (Reason "x")- }- `shouldBe` HUnitFailure- Nothing- ( Reason . intercalate "\n" $- [ "x"- , ""- , "Annotations:"- , "\t * Annotation @Int 56"- ]- )-- it "when the failure is ExpectedButGot with no message" $ do- annotateHUnitFailure- AnnotatedException- { annotations = [toAnnotation @Int 56]- , exception = HUnitFailure Nothing (ExpectedButGot Nothing "a" "b")- }- `shouldBe` HUnitFailure- Nothing- ( ExpectedButGot- ( Just . intercalate "\n" $- [ "Annotations:"- , "\t * Annotation @Int 56"- ]- )- "a"- "b"- )-- it "when the failure is ExpectedButGot with a message" $- annotateHUnitFailure- AnnotatedException- { annotations = [toAnnotation @Int 56]- , exception = HUnitFailure Nothing (ExpectedButGot (Just "x") "a" "b")- }- `shouldBe` HUnitFailure- Nothing- ( ExpectedButGot- ( Just . intercalate "\n" $- [ "x"- , ""- , "Annotations:"- , "\t * Annotation @Int 56"- ]- )- "a"- "b"- )-- it "can show a stack trace" $- annotateHUnitFailure- AnnotatedException- { annotations =- [ toAnnotation @CallStack $- fromList- [- ( "abc"- , SrcLoc- { srcLocPackage = "thepackage"- , srcLocModule = "Foo"- , srcLocFile = "src/Foo.hs"- , srcLocStartLine = 7- , srcLocStartCol = 50- , srcLocEndLine = 8- , srcLocEndCol = 23- }- )- ]- ]- , exception = HUnitFailure Nothing (Reason "x")- }- `shouldBe` HUnitFailure- Nothing- ( Reason . intercalate "\n" $- [ "x"- , ""- , "CallStack (from HasCallStack):"- , " abc, called at src/Foo.hs:7:50 in thepackage:Foo"- ]- )-- it "can show both an annotation and a stack trace" $- annotateHUnitFailure- AnnotatedException- { annotations =- [ toAnnotation @Text "Visibility is poor"- , toAnnotation @CallStack $- fromList- [- ( "abc"- , SrcLoc- { srcLocPackage = "thepackage"- , srcLocModule = "Foo"- , srcLocFile = "src/Foo.hs"- , srcLocStartLine = 7- , srcLocStartCol = 50- , srcLocEndLine = 8- , srcLocEndCol = 23- }- )- ]- ]- , exception = HUnitFailure Nothing (Reason "x")- }- `shouldBe` HUnitFailure- Nothing- ( Reason . intercalate "\n" $- [ "x"- , ""- , "Annotations:"- , "\t * Annotation @Text \"Visibility is poor\""- , ""- , "CallStack (from HasCallStack):"- , " abc, called at src/Foo.hs:7:50 in thepackage:Foo"- ]- )