diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/freckle-app.cabal b/freckle-app.cabal --- a/freckle-app.cabal +++ b/freckle-app.cabal @@ -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, diff --git a/library/Freckle/App/Test/Hspec/AnnotatedException.hs b/library/Freckle/App/Test/Hspec/AnnotatedException.hs deleted file mode 100644 --- a/library/Freckle/App/Test/Hspec/AnnotatedException.hs +++ /dev/null @@ -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 diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs b/tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs deleted file mode 100644 --- a/tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs +++ /dev/null @@ -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" - ] - )