From 1cb7a3c1c90fbc16538c3f439ee8633b24d7a381 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 12 Jan 2026 16:45:52 -0500 Subject: [PATCH 1/4] Tweak fourmolu --- fourmolu.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/fourmolu.yaml b/fourmolu.yaml index 315cc82b..61cea5ce 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -10,6 +10,7 @@ haddock-style: single-line let-style: mixed in-style: left-align single-constraint-parens: never # ignored until v12 / ghc-9.6 +trailing-section-operators: false # needs fourmolu >= v0.17 unicode: never # default respectful: true # default fixities: From c71984ff748b771b0ab869c1f08b9f9545238d8b Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 12 Jan 2026 16:45:56 -0500 Subject: [PATCH 2/4] Use prettyprinter for annotateFailureReason I attempted do this is the least disruptive way. At this point, there's almost no value in prettyprinter being used. What I've done amounts to switching `T.pack` for `pretty` and `T.intercate "\n"` for `vsep`, and adding a pretty pointless layout and render step. However, I plan to take more advantage in future commits. --- freckle-app/freckle-app.cabal | 1 + .../App/Test/Hspec/AnnotatedException.hs | 44 ++++++++----------- freckle-app/package.yaml | 1 + 3 files changed, 21 insertions(+), 25 deletions(-) diff --git a/freckle-app/freckle-app.cabal b/freckle-app/freckle-app.cabal index 93634719..ade2f96b 100644 --- a/freckle-app/freckle-app.cabal +++ b/freckle-app/freckle-app.cabal @@ -125,6 +125,7 @@ library , persistent-postgresql , persistent-sql-lifted , postgresql-simple + , prettyprinter , primitive , resource-pool >=0.4.0.0 , resourcet diff --git a/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs b/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs index dbc45135..0833d8de 100644 --- a/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs +++ b/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs @@ -12,6 +12,9 @@ import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) import Data.Text qualified as T import Freckle.App.Exception (AnnotatedException (..)) import GHC.Stack (CallStack, prettyCallStack) +import Prettyprinter +import Prettyprinter.Render.String +import Prettyprinter.Util (reflow) import Test.HUnit.Lang (FailureReason (..), HUnitFailure (..)) import Test.Hspec @@ -50,33 +53,25 @@ annotateFailureReason as = -- some additional paragraphs based on annotations, separated by blank lines makeMessage :: String -> [Annotation] -> String makeMessage m as = - combineParagraphs $ stringParagraph m :| annotationParagraphs as + combineParagraphs $ pretty 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 + fmap combineParagraphs + $ nonEmpty + $ fmap pretty (toList mm) <> annotationParagraphs as -- | Combine a list of paragraphs into a single string for the final output -combineParagraphs :: Foldable t => t Paragraph -> String +combineParagraphs :: Foldable t => t (Doc ann) -> String combineParagraphs = - T.unpack . T.intercalate "\n\n" . fmap paragraphText . toList + renderString + . layoutSmart defaultLayoutOptions + . vsep + . punctuate "\n" + . toList -- | Render a list of annotations as a list of paragraphs -- @@ -84,7 +79,7 @@ combineParagraphs = -- -- * 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 :: [Annotation] -> [Doc ann] annotationParagraphs annotations = catMaybes [ otherAnnotationsPart <$> nonEmpty otherAnnotations @@ -94,14 +89,13 @@ annotationParagraphs annotations = (callStacks, otherAnnotations) = tryAnnotations @CallStack annotations -- | Construct a paragraph consisting of a bullet list of annotations -otherAnnotationsPart :: Foldable t => t Annotation -> Paragraph +otherAnnotationsPart :: Foldable t => t Annotation -> Doc ann otherAnnotationsPart = - textParagraph - . T.intercalate "\n" + vsep . ("Annotations:" :) - . fmap (("\t * " <>) . T.pack . show) + . fmap (("\t * " <>) . pretty . show) . toList -- | Construct a paragraph that displays a call stack -callStackPart :: CallStack -> Paragraph -callStackPart = textParagraph . T.pack . prettyCallStack +callStackPart :: CallStack -> Doc ann +callStackPart = pretty . prettyCallStack diff --git a/freckle-app/package.yaml b/freckle-app/package.yaml index eb86500c..9611455e 100644 --- a/freckle-app/package.yaml +++ b/freckle-app/package.yaml @@ -106,6 +106,7 @@ library: - persistent-sql-lifted - persistent-postgresql - postgresql-simple + - prettyprinter - primitive - resource-pool >= 0.4.0.0 # defaultPoolConfig, etc - resourcet From c336c14f43645a9cb88ee4fa590b36a338157164 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 12 Jan 2026 16:52:57 -0500 Subject: [PATCH 3/4] Neatly align listed annotations And don't use tabs. --- .../App/Test/Hspec/AnnotatedException.hs | 2 +- .../App/Test/Hspec/AnnotatedExceptionSpec.hs | 142 +++++++++++------- 2 files changed, 92 insertions(+), 52 deletions(-) diff --git a/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs b/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs index 0833d8de..3d659d9c 100644 --- a/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs +++ b/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs @@ -93,7 +93,7 @@ otherAnnotationsPart :: Foldable t => t Annotation -> Doc ann otherAnnotationsPart = vsep . ("Annotations:" :) - . fmap (("\t * " <>) . pretty . show) + . fmap (indent 2 . ("*" <+>) . align . reflow . T.pack . show) . toList -- | Construct a paragraph that displays a call stack diff --git a/freckle-app/tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs b/freckle-app/tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs index 30a7e432..60a99bde 100644 --- a/freckle-app/tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs +++ b/freckle-app/tests/Freckle/App/Test/Hspec/AnnotatedExceptionSpec.hs @@ -17,33 +17,33 @@ 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 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 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 + 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 + 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" - ] + ( Reason . intercalate "\n" + $ [ "x" + , "" + , "Annotations:" + , " * Annotation @Int 56" + ] ) it "when the failure is ExpectedButGot with no message" $ do @@ -55,17 +55,17 @@ spec = do `shouldBe` HUnitFailure Nothing ( ExpectedButGot - ( Just . intercalate "\n" $ - [ "Annotations:" - , "\t * Annotation @Int 56" - ] + ( Just . intercalate "\n" + $ [ "Annotations:" + , " * Annotation @Int 56" + ] ) "a" "b" ) - it "when the failure is ExpectedButGot with a message" $ - annotateHUnitFailure + it "when the failure is ExpectedButGot with a message" + $ annotateHUnitFailure AnnotatedException { annotations = [toAnnotation @Int 56] , exception = HUnitFailure Nothing (ExpectedButGot (Just "x") "a" "b") @@ -73,23 +73,23 @@ spec = do `shouldBe` HUnitFailure Nothing ( ExpectedButGot - ( Just . intercalate "\n" $ - [ "x" - , "" - , "Annotations:" - , "\t * Annotation @Int 56" - ] + ( Just . intercalate "\n" + $ [ "x" + , "" + , "Annotations:" + , " * Annotation @Int 56" + ] ) "a" "b" ) - it "can show a stack trace" $ - annotateHUnitFailure + it "can show a stack trace" + $ annotateHUnitFailure AnnotatedException { annotations = - [ toAnnotation @CallStack $ - fromList + [ toAnnotation @CallStack + $ fromList [ ( "abc" , SrcLoc @@ -108,21 +108,21 @@ spec = do } `shouldBe` HUnitFailure Nothing - ( Reason . intercalate "\n" $ - [ "x" - , "" - , "CallStack (from HasCallStack):" - , " abc, called at src/Foo.hs:7:50 in thepackage:Foo" - ] + ( 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 + it "can show both an annotation and a stack trace" + $ annotateHUnitFailure AnnotatedException { annotations = [ toAnnotation @Text "Visibility is poor" - , toAnnotation @CallStack $ - fromList + , toAnnotation @CallStack + $ fromList [ ( "abc" , SrcLoc @@ -141,13 +141,53 @@ spec = do } `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" + ( Reason . intercalate "\n" + $ [ "x" + , "" + , "Annotations:" + , " * Annotation @Text \"Visibility is poor\"" + , "" + , "CallStack (from HasCallStack):" + , " abc, called at src/Foo.hs:7:50 in thepackage:Foo" + ] + ) + + it "wraps long annotations into neat lists" + $ annotateHUnitFailure + AnnotatedException + { annotations = + [ toAnnotation @Text + "Visibility is poor. Visability is poor. Visability is poor. Visability is poor. Visability is poor. Visability is poor. Visability is poor. Visability is poor. Visability is poor. Visability is poor. Visability 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:" + , " * Annotation @Text \"Visibility is poor. Visability is poor. Visability is" + , " poor. Visability is poor. Visability is poor. Visability is poor. Visability" + , " is poor. Visability is poor. Visability is poor. Visability is poor." + , " Visability is poor\"" + , "" + , "CallStack (from HasCallStack):" + , " abc, called at src/Foo.hs:7:50 in thepackage:Foo" + ] ) From 7ecb2360aa2ec297eeea03fb814347c7327a1abd Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Mon, 12 Jan 2026 16:54:08 -0500 Subject: [PATCH 4/4] Use hardline, not literal --- .../library/Freckle/App/Test/Hspec/AnnotatedException.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs b/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs index 3d659d9c..c602d158 100644 --- a/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs +++ b/freckle-app/library/Freckle/App/Test/Hspec/AnnotatedException.hs @@ -70,7 +70,7 @@ combineParagraphs = renderString . layoutSmart defaultLayoutOptions . vsep - . punctuate "\n" + . punctuate hardline . toList -- | Render a list of annotations as a list of paragraphs