mirror of
https://github.com/Mesabloo/diagnose.git
synced 2024-08-17 07:10:35 +03:00
allow inserting invisible markers
This commit is contained in:
parent
5d831d4c7b
commit
87de51ac93
@ -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
|
||||
--
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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)]
|
||||
[]
|
||||
|
Loading…
Reference in New Issue
Block a user