diff --git a/diagnose.cabal b/diagnose.cabal --- a/diagnose.cabal +++ b/diagnose.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: diagnose -version: 2.2.0 +version: 2.3.0 synopsis: Beautiful error reporting done easily description: This package provides a simple way of getting beautiful compiler/interpreter errors using a very simple interface for the programmer. diff --git a/src/Error/Diagnose.hs b/src/Error/Diagnose.hs --- a/src/Error/Diagnose.hs +++ b/src/Error/Diagnose.hs @@ -113,6 +113,10 @@ -- - A 'Error.Diagnose.Report.Maybe' marker may contain possible fixes (if the text is short, else hints are recommended for this use). -- -- This marker is output in magenta. +-- +-- - A 'Error.Diagnose.Report.Blank' marker is useful only to output additional lines of code in the report. +-- +-- This marker is not output and has no color. -- $create_diagnostic -- diff --git a/src/Error/Diagnose/Diagnostic.hs b/src/Error/Diagnose/Diagnostic.hs --- a/src/Error/Diagnose/Diagnostic.hs +++ b/src/Error/Diagnose/Diagnostic.hs @@ -21,7 +21,10 @@ addFile, addReport, def, + errorsToWarnings, + hasReports, prettyDiagnostic, printDiagnostic, + warningsToErrors, ) import System.IO as Export (stderr, stdout) diff --git a/src/Error/Diagnose/Diagnostic/Internal.hs b/src/Error/Diagnose/Diagnostic/Internal.hs --- a/src/Error/Diagnose/Diagnostic/Internal.hs +++ b/src/Error/Diagnose/Diagnostic/Internal.hs @@ -29,7 +29,7 @@ import qualified Data.HashMap.Lazy as HashMap import Data.List (intersperse) import Error.Diagnose.Report (Report) -import Error.Diagnose.Report.Internal (FileMap, prettyReport) +import Error.Diagnose.Report.Internal (FileMap, errorToWarning, prettyReport, warningToError) import Error.Diagnose.Style (Annotation, Style) import Prettyprinter (Doc, Pretty, hardline, unAnnotate) import Prettyprinter.Render.Terminal (hPutDoc) @@ -66,6 +66,19 @@ , "content" .= content ] #endif + +-- | Checks whether the given diagnostic has any report or not (if it is effectively empty). +hasReports :: Diagnostic msg -> Bool +hasReports (Diagnostic DL.Nil _) = True +hasReports _ = False + +-- | Transforms every warning report in this diagnostic into an error report. +warningsToErrors :: Diagnostic msg -> Diagnostic msg +warningsToErrors (Diagnostic reports files) = Diagnostic (warningToError <$> reports) files + +-- | Transforms every error report in this diagnostic into a warning report. +errorsToWarnings :: Diagnostic msg -> Diagnostic msg +errorsToWarnings (Diagnostic reports files) = Diagnostic (errorToWarning <$> reports) files -- | Pretty prints a 'Diagnostic' into a 'Doc'ument that can be output using 'hPutDoc'. -- diff --git a/src/Error/Diagnose/Report.hs b/src/Error/Diagnose/Report.hs --- a/src/Error/Diagnose/Report.hs +++ b/src/Error/Diagnose/Report.hs @@ -11,4 +11,4 @@ ) where -import Error.Diagnose.Report.Internal as Export (Marker (..), Note (..), Report, err, warn) +import Error.Diagnose.Report.Internal as Export (Marker (..), Note (..), Report, err, errorToWarning, warn, warningToError) diff --git a/src/Error/Diagnose/Report/Internal.hs b/src/Error/Diagnose/Report/Internal.hs --- a/src/Error/Diagnose/Report/Internal.hs +++ b/src/Error/Diagnose/Report/Internal.hs @@ -103,11 +103,14 @@ Where msg | -- | A magenta marker to report potential fixes. Maybe msg + | -- | An empty marker, whose sole purpose is to include a line of code in the report without markers under. + Blank instance Eq (Marker msg) where This _ == This _ = True Where _ == Where _ = True Maybe _ == Maybe _ = True + Blank == Blank = True _ == _ = False {-# INLINEABLE (==) #-} @@ -116,6 +119,8 @@ Where _ < This _ = True Where _ < _ = False Maybe _ < _ = True + _ < Blank = True + Blank < _ = False {-# INLINEABLE (<) #-} m1 <= m2 = m1 < m2 || m1 == m2 @@ -155,6 +160,16 @@ err = Report True {-# INLINE err #-} +-- | Transforms a warning report into an error report. +warningToError :: Report msg -> Report msg +warningToError (Report False code msg markers notes) = Report True code msg markers notes +warningToError r@(Report True _ _ _ _) = r + +-- | Transforms an error report into a warning report. +errorToWarning :: Report msg -> Report msg +errorToWarning (Report True code msg markers notes) = Report False code msg markers notes +errorToWarning r@(Report False _ _ _ _) = r + -- | Pretty prints a report to a 'Doc' handling colors. prettyReport :: Pretty msg => @@ -439,14 +454,16 @@ <> annotate (markerColor isError marker) (if withUnicode then "┤" else ">") <> space - allMarkersInLine = {- List.sortOn fst $ -} allInlineMarkersInLine <> allMultilineMarkersInLine + -- we need to remove all blank markers because they are irrelevant to the display + allInlineMarkersInLine' = filter ((/=) Blank . snd) allInlineMarkersInLine + allMultilineMarkersSpanningLine' = filter ((/=) Blank . snd) allMultilineMarkersSpanningLine - (widths, renderedCode) = getLine_ files (allMarkersInLine <> allMultilineMarkersSpanningLine) line tabSize isError + (widths, renderedCode) = getLine_ files (allInlineMarkersInLine <> allMultilineMarkersInLine <> allMultilineMarkersSpanningLine') line tabSize isError in ( otherMultilines, hardline <> {- (1) -} linePrefix leftLen line withUnicode <+> additionalPrefix <> renderedCode - <> {- (2) -} showAllMarkersInLine (not $ null multiline) inSpanOfMultiline colorOfFirstMultilineMarker withUnicode isError leftLen widths allInlineMarkersInLine + <> {- (2) -} showAllMarkersInLine (not $ null multiline) inSpanOfMultiline colorOfFirstMultilineMarker withUnicode isError leftLen widths allInlineMarkersInLine' <> showMultiline (isLastLine || List.safeLast multilineEndingOnLine == List.safeLast multiline) multilineEndingOnLine ) @@ -459,6 +476,7 @@ prefixWithBar color = prefix <> maybe id annotate color (if withUnicode then "│ " else "| ") + showMultilineMarkerMessage (_, Blank) _ = mempty showMultilineMarkerMessage (_, marker) isLast = annotate (markerColor isError marker) $ ( if isLast && isLastMultiline @@ -489,8 +507,7 @@ Just code -> ( mkWidthTable code, flip foldMap (zip [1 ..] code) \(n, c) -> - let cdoc = - ifTab (pretty (replicate tabSize ' ')) pretty c + let cdoc = ifTab (pretty (replicate tabSize ' ')) pretty c colorizingMarkers = flip filter markers \case (Position (bl, bc) (el, ec) _, _) | bl == el -> @@ -500,7 +517,7 @@ || (el == line && n < ec) || (bl < line && el > line) in maybe - id + (annotate CodeStyle) ((\m -> annotate (MarkerStyle $ markerColor isError m)) . snd) (List.safeHead colorizingMarkers) cdoc @@ -532,7 +549,7 @@ showMarkers n lineLen | n > lineLen = mempty -- reached the end of the line | otherwise = - let allMarkers = flip filter ms \(Position (_, bc) (_, ec) _, _) -> n >= bc && n < ec + let allMarkers = flip filter ms \(Position (_, bc) (_, ec) _, mark) -> mark /= Blank && n >= bc && n < ec in -- only consider markers which span onto the current column case allMarkers of [] -> fold (replicate (widthAt n) space) <> showMarkers (n + 1) lineLen @@ -548,7 +565,7 @@ showMessages specialPrefix ms lineLen = case List.safeUncons ms of Nothing -> mempty -- no more messages to show Just ((Position b@(_, bc) _ _, msg), pipes) -> - let filteredPipes = filter ((/= b) . begin . fst) pipes + let filteredPipes = filter (uncurry (&&) . bimap ((/= b) . begin) (/= Blank)) pipes -- record only the pipes corresponding to markers on different starting positions nubbedPipes = List.nubBy ((==) `on` (begin . fst)) filteredPipes -- and then remove all duplicates @@ -637,6 +654,7 @@ markerColor isError (This _) = ThisColor isError markerColor _ (Where _) = WhereColor markerColor _ (Maybe _) = MaybeColor +markerColor _ Blank = CodeStyle -- we take the same color as the code, for it to be invisible {-# INLINE markerColor #-} -- | Retrieves the message held by a marker. @@ -644,6 +662,7 @@ markerMessage (This m) = m markerMessage (Where m) = m markerMessage (Maybe m) = m +markerMessage Blank = undefined {-# INLINE markerMessage #-} -- | Pretty prints all hints. diff --git a/src/Error/Diagnose/Style.hs b/src/Error/Diagnose/Style.hs --- a/src/Error/Diagnose/Style.hs +++ b/src/Error/Diagnose/Style.hs @@ -68,6 +68,8 @@ -- already processed color annotation. MarkerStyle Annotation + | -- | The color of the code when no marker is present. + CodeStyle -- | A style is a function which can be applied using 'reAnnotate'. -- @@ -87,6 +89,7 @@ -- * The left rules are colored in bold black -- * File names are output in dull green -- * The @[error]@/@[warning]@ at the top is colored in red for errors and yellow for warnings +-- * The code is output in normal white defaultStyle :: Style defaultStyle = reAnnotate style where @@ -99,4 +102,9 @@ RuleColor -> bold <> color Black KindColor isError -> bold <> style (ThisColor isError) NoLineColor -> bold <> colorDull Magenta - MarkerStyle st -> bold <> style st + MarkerStyle st -> + let ann = style st + in if ann == style CodeStyle + then ann + else bold <> ann + CodeStyle -> color White diff --git a/test/rendering/Spec.hs b/test/rendering/Spec.hs --- a/test/rendering/Spec.hs +++ b/test/rendering/Spec.hs @@ -71,6 +71,8 @@ repro3, errorWithMultilineMarkerMessage, errorWithMultilineMarkerMessage', + errorWithSingleBlankMarker, + errorWithBlankAndNormalMarkerInLine, beautifulExample ] @@ -425,4 +427,20 @@ (Position (24, 21) (24, 26) "repro3.file", Where "This is the template being used"), (Position (24, 7) (24, 15) "repro3.file", Where "while checking this static layer") ] + [] + +errorWithSingleBlankMarker :: Report String +errorWithSingleBlankMarker = + err + Nothing + "Error with a single blank marker" + [(Position (1, 5) (1, 10) "test.zc", Blank)] + [] + +errorWithBlankAndNormalMarkerInLine :: Report String +errorWithBlankAndNormalMarkerInLine = + err + Nothing + "Error with a single blank marker" + [(Position (1, 5) (1, 10) "test.zc", Blank), (Position (1, 15) (1, 22) "test.zc", This "After a blank")] []