allow inserting invisible markers

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
 --

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.

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

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)]
+    []