hspec-annotated-exception (empty) → 0.0.0.0
raw patch · 6 files changed
+287/−0 lines, 6 filesdep +HUnitdep +annotated-exceptiondep +base
Dependencies added: HUnit, annotated-exception, base, hspec, lens, text
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- README.md +25/−0
- hspec-annotated-exception.cabal +60/−0
- package.yaml +62/−0
- src/Test/Hspec/AnnotatedException.hs +114/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/freckle/hspec-annotated-exception/compare/v__...main)++## [v0.0.0.0](https://github.com/freckle/hspec-annotated-exception/tree/v0.0.0.0)++First tagged release.
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2025 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,25 @@+# haskell-library-template++When using [hspec] to test a project that uses [annotated-exception], an+`AnnotatedException` thrown by the code under test does not display well+in Hspec's output. `hspec-annotated-exception` fixes this.++To use this package with Hspec module auto-discovery:++```haskell+module SpecHook (hook) where++import Test.Hspec (Spec)+import Test.Hspec.AnnotatedException (unwrapAnnotatedHUnitFailure)++hook :: Spec -> Spec+hook = unwrapAnnotatedHUnitFailure+```++ [annotated-exception]: https://hackage.haskell.org/package/annotated-exception++ [hspec]: https://hackage.haskell.org/package/hspec++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
+ hspec-annotated-exception.cabal view
@@ -0,0 +1,60 @@+cabal-version: 1.18+name: hspec-annotated-exception+version: 0.0.0.0+license: MIT+license-file: LICENSE+maintainer: Freckle Education+homepage: https://github.com/freckle/hspec-annotated-exception#readme+bug-reports: https://github.com/freckle/hspec-annotated-exception/issues+synopsis:+ Hspec hook that unwraps test failures from AnnotatedException++description:+ An hspec hook that lets hspec catch and pretty-print HUnitFailure,+ the exception that is thrown when a test assertion fails, in the+ correct way even if it is wrapped in AnnotatedException.++category: Utils+build-type: Simple+extra-source-files: package.yaml+extra-doc-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/freckle/hspec-annotated-exception++library+ exposed-modules: Test.Hspec.AnnotatedException+ hs-source-dirs: src+ other-modules: Paths_hspec_annotated_exception+ default-language: GHC2021+ default-extensions: LambdaCase NoImplicitPrelude OverloadedStrings+ ghc-options:+ -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe++ build-depends:+ HUnit >=1.6.2.0,+ annotated-exception >=0.2.0.5,+ base >=4.17.2.1 && <5,+ hspec >=2.11.10,+ lens >=5.2.3,+ text >=2.0.2++ if impl(ghc >=9.8)+ ghc-options:+ -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++ if impl(ghc >=8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++ if impl(ghc >=8.8)+ ghc-options: -fwrite-ide-info
+ package.yaml view
@@ -0,0 +1,62 @@+name: hspec-annotated-exception+version: 0.0.0.0+maintainer: Freckle Education+category: Utils+github: freckle/hspec-annotated-exception+synopsis: Hspec hook that unwraps test failures from AnnotatedException+description: |+ An hspec hook that lets hspec catch and pretty-print HUnitFailure,+ the exception that is thrown when a test assertion fails, in the+ correct way even if it is wrapped in AnnotatedException.++extra-doc-files:+ - README.md+ - CHANGELOG.md++extra-source-files:+ - package.yaml++ghc-options:+ - -Weverything+ - -Wno-all-missed-specialisations+ - -Wno-missed-specialisations+ - -Wno-missing-exported-signatures # re-enables missing-signatures+ - -Wno-missing-import-lists+ - -Wno-missing-local-signatures+ - -Wno-monomorphism-restriction+ - -Wno-safe+ - -Wno-unsafe++when:+ - condition: "impl(ghc >= 9.8)"+ ghc-options:+ - -Wno-missing-role-annotations+ - -Wno-missing-poly-kind-signatures+ - condition: "impl(ghc >= 9.2)"+ ghc-options:+ - -Wno-missing-kind-signatures+ - condition: "impl(ghc >= 8.10)"+ ghc-options:+ - -Wno-missing-safe-haskell-mode+ - -Wno-prepositive-qualified-module+ - condition: "impl(ghc >= 8.8)"+ ghc-options:+ - -fwrite-ide-info++dependencies:+ - annotated-exception+ - base < 5+ - hspec+ - lens+ - HUnit+ - text++default-language: GHC2021++default-extensions:+ - LambdaCase+ - NoImplicitPrelude+ - OverloadedStrings++library:+ source-dirs: src
+ src/Test/Hspec/AnnotatedException.hs view
@@ -0,0 +1,114 @@+module Test.Hspec.AnnotatedException+ ( unwrapAnnotatedHUnitFailure+ , annotateHUnitFailure+ ) where++import Prelude++import Control.Exception (Exception)+import Control.Exception qualified+import Control.Exception.Annotated (AnnotatedException (..))+import Control.Lens (Lens', lens, over)+import Data.Annotation (Annotation, tryAnnotations)+import Data.Foldable (toList)+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)+import Data.Maybe (catMaybes, listToMaybe)+import Data.Text (Text)+import Data.Text qualified as T+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.+--+-- This hook does not alter whether a spec succeeds or fails; it only changes the+-- type of exception that is thrown when an assertion fails.+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