From 87de51ac93c92201e048b4af0525c1367805f139 Mon Sep 17 00:00:00 2001 From: Mesabloo <22964017+Mesabloo@users.noreply.github.com> Date: Sat, 23 Jul 2022 09:53:32 +0200 Subject: [PATCH] allow inserting invisible markers --- src/Error/Diagnose.hs | 4 ++++ src/Error/Diagnose/Report/Internal.hs | 25 +++++++++++++++++-------- src/Error/Diagnose/Style.hs | 10 +++++++++- test/rendering/Spec.hs | 9 +++++++++ 4 files changed, 39 insertions(+), 9 deletions(-) diff --git a/src/Error/Diagnose.hs b/src/Error/Diagnose.hs index ac91163..5809622 100644 --- a/src/Error/Diagnose.hs +++ b/src/Error/Diagnose.hs @@ -113,6 +113,10 @@ import Error.Diagnose.Style as Export -- - 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/Report/Internal.hs b/src/Error/Diagnose/Report/Internal.hs index dd0c135..065c42a 100644 --- a/src/Error/Diagnose/Report/Internal.hs +++ b/src/Error/Diagnose/Report/Internal.hs @@ -103,11 +103,14 @@ data Marker msg 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 @@ instance Ord (Marker msg) where Where _ < This _ = True Where _ < _ = False Maybe _ < _ = True + _ < Blank = True + Blank < _ = False {-# INLINEABLE (<) #-} m1 <= m2 = m1 < m2 || m1 == m2 @@ -439,14 +444,16 @@ prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNu <> 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 +466,7 @@ prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNu 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 +497,7 @@ getLine_ files markers line tabSize isError = 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 +507,7 @@ getLine_ files markers line tabSize isError = || (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 +539,7 @@ showAllMarkersInLine hasMultilines inSpanOfMultiline colorMultilinePrefix withUn 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 +555,7 @@ showAllMarkersInLine hasMultilines inSpanOfMultiline colorMultilinePrefix withUn 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 +644,7 @@ markerColor :: 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 +652,7 @@ markerMessage :: Marker msg -> msg 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 index 25f355a..46ee9f7 100644 --- a/src/Error/Diagnose/Style.hs +++ b/src/Error/Diagnose/Style.hs @@ -68,6 +68,8 @@ data Annotation -- 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 @@ type Style = Doc Annotation -> Doc AnsiStyle -- * 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 @@ defaultStyle = reAnnotate style 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 index 3a2ba0d..e47a7af 100644 --- a/test/rendering/Spec.hs +++ b/test/rendering/Spec.hs @@ -71,6 +71,7 @@ main = do repro3, errorWithMultilineMarkerMessage, errorWithMultilineMarkerMessage', + errorWithSingleBlankMarker, beautifulExample ] @@ -426,3 +427,11 @@ repro3 = (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)] + []