Mesabloo/diagnose
1
1
Fork 0
mirror of https://github.com/Mesabloo/diagnose.git synced 2024-09-11 11:26:56 +03:00
Code Issues Projects Releases Wiki Activity

*: switch from ansi-wl-pprint to prettyprinter

Browse Source
This commit is contained in:
Mesabloo 2022-01-01 19:31:14 +01:00
parent 6c1516ebb2
commit 3b68aab572
5 changed files with 83 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
diagnose.cabal
View File

@ -1,6 +1,6 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.34.4.
-- This file has been generated from package.yaml by hpack version 0.34.5.
--
-- see: https://github.com/sol/hpack
@ -39,11 +39,13 @@ library
ghc-options: -Wall -Wextra
build-depends:
aeson ==1.5.6.0
, ansi-wl-pprint ==0.6.9
, base >=4.7 && <5
, bytestring ==0.10.12.0
, data-default ==0.7.1.1
, hashable ==1.3.0.0
, prettyprinter ==1.7.0
, prettyprinter-ansi-terminal ==1.1.2
, text ==1.2.4.1
, unordered-containers ==0.2.14.0
default-language: Haskell2010
@ -61,11 +63,13 @@ test-suite diagnose-tests
ghc-options: -Wall -Wextra -threaded -rtsopts -with-rtsopts=-N -O0 -g
build-depends:
aeson ==1.5.6.0
, ansi-wl-pprint ==0.6.9
, base >=4.7 && <5
, bytestring ==0.10.12.0
, data-default ==0.7.1.1
, diagnose
, hashable ==1.3.0.0
, prettyprinter ==1.7.0
, prettyprinter-ansi-terminal ==1.1.2
, text ==1.2.4.1
, unordered-containers ==0.2.14.0
default-language: Haskell2010

4
package.yaml
View File

@ -7,12 +7,14 @@ copyright: "2020 Mesabloo"
dependencies:
- base >= 4.7 && < 5
- ansi-wl-pprint == 0.6.9
- prettyprinter == 1.7.0
- prettyprinter-ansi-terminal == 1.1.2
- unordered-containers == 0.2.14.0
- hashable == 1.3.0.0
- data-default == 0.7.1.1
- aeson == 1.5.6.0
- bytestring == 0.10.12.0
- text == 1.2.4.1
default-extensions:
- OverloadedStrings

7
src/Error/Diagnose/Diagnostic/Internal.hs
View File

@ -30,7 +30,8 @@ import Error.Diagnose.Report.Internal (prettyReport)
import System.IO (Handle)
import Text.PrettyPrint.ANSI.Leijen (Pretty, Doc, hardline, hPutDoc, plain)
import Prettyprinter (Pretty, Doc, unAnnotate, hardline)
import Prettyprinter.Render.Terminal (hPutDoc, AnsiStyle)
-- | The data type for diagnostic containing messages of an abstract type.
@ -66,7 +67,7 @@ instance ToJSON msg => ToJSON (Diagnostic msg) where
prettyDiagnostic :: Pretty msg
=> Bool -- ^ Should we use unicode when printing paths?
-> Diagnostic msg -- ^ The diagnostic to print
-> Doc
-> Doc AnsiStyle
prettyDiagnostic withUnicode (Diagnostic reports file) =
fold . intersperse hardline $ prettyReport file withUnicode <$> reports
{-# INLINE prettyDiagnostic #-}
@ -79,7 +80,7 @@ printDiagnostic :: (MonadIO m, Pretty msg)
-> Diagnostic msg -- ^ The diagnostic to output.
-> m ()
printDiagnostic handle withUnicode withColors diag =
liftIO $ hPutDoc handle (unlessId withColors plain $ prettyDiagnostic withUnicode diag)
liftIO $ hPutDoc handle (unlessId withColors unAnnotate $ prettyDiagnostic withUnicode diag)
where
unlessId cond app = if cond then id else app
{-# INLINE unlessId #-}

11
src/Error/Diagnose/Position.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
@ -15,10 +16,12 @@ module Error.Diagnose.Position (Position(..)) where
import Data.Aeson (ToJSON(..), object, (.=))
import Data.Default (Default, def)
import Data.Hashable (Hashable)
import Data.Text (Text)
import GHC.Generics (Generic(..))
import Text.PrettyPrint.ANSI.Leijen (Pretty(..), text, colon, int)
import Prettyprinter (Pretty(..), colon)
-- import Text.PrettyPrint.ANSI.Leijen (Pretty(..), text, colon, int)
-- | Contains information about the location about something.
@ -46,9 +49,9 @@ instance Ord Position where
Position b1 e1 _ `compare` Position b2 e2 _ = (b1, e1) `compare` (b2, e2)
instance Pretty Position where
pretty (Position (bl, bc) (el, ec) f) = text f <> at <> int bl <> colon <> int bc <> dash <> int el <> colon <> int ec
where at = text "@"
dash = text "-"
pretty (Position (bl, bc) (el, ec) f) = pretty f <> at <> pretty bl <> colon <> pretty bc <> dash <> pretty el <> colon <> pretty ec
where at = pretty @Text "@"
dash = pretty @Text "-"
instance Hashable Position where

125
src/Error/Diagnose/Report/Internal.hs
View File

@ -36,8 +36,11 @@ import Data.Ord (Down(..))
import Error.Diagnose.Position
import Text.PrettyPrint.ANSI.Leijen (Pretty, Doc, empty, bold, red, yellow, colon, pretty, hardline, (<+>), text, black, dullgreen, width, dullblue, magenta, int, space, align, cyan, char, string)
import Text.PrettyPrint.ANSI.Leijen.Internal (Doc(..))
import Prettyprinter (Pretty(..), Doc, hardline, (<+>), align, space, annotate, width, colon)
import Prettyprinter.Internal (Doc(..))
import Prettyprinter.Render.Terminal (color, colorDull, Color(..), bold, AnsiStyle)
-- import Text.PrettyPrint.ANSI.Leijen (Pretty, Doc, mempty, bold, red, yellow, colon, pretty, hardline, (<+>), text, black, dullgreen, width, dullblue, magenta, int, space, align, cyan, char, string)
-- import Text.PrettyPrint.ANSI.Leijen.Internal (Doc(..))
-- | The type of diagnostic reports with abstract message type.
@ -99,7 +102,7 @@ instance Ord (Marker msg) where
-- | Constructs a warning or an error report.
warn, err :: msg -- ^ The report message, shown at the very top.
-> [(Position, Marker msg)] -- ^ A list associating positions with markers.
-> [msg] -- ^ A possibly empty list of hints to add at the end of the report.
-> [msg] -- ^ A possibly mempty list of hints to add at the end of the report.
-> Report msg
warn = Report False
{-# INLINE warn #-}
@ -111,7 +114,7 @@ prettyReport :: Pretty msg
=> HashMap FilePath [String] -- ^ The content of the file the reports are for
-> Bool -- ^ Should we print paths in unicode?
-> Report msg -- ^ The whole report to output
-> Doc
-> Doc AnsiStyle
prettyReport fileContent withUnicode (Report isError message markers hints) =
let sortedMarkers = List.sortOn (fst . begin . fst) markers
-- sort the markers so that the first lines of the reports are the first lines of the file
@ -124,7 +127,7 @@ prettyReport fileContent withUnicode (Report isError message markers hints) =
reportFile = maybe (pretty @Position def) (pretty . fst) $ List.safeHead (filter (isThisMarker . snd) sortedMarkers)
-- the reported file is the file of the first 'This' marker (only one must be present)
header = bold if isError then red "[error]" else yellow "[warning]"
header = annotate bold if isError then annotate (color Red) "[error]" else annotate (color Yellow) "[warning]"
maxLineNumberLength = maybe 3 (max 3 . length . show . fst . end . fst) $ List.safeLast sortedMarkers
-- if there are no markers, then default to 3, else get the maximum between 3 and the length of the last marker
@ -143,11 +146,11 @@ prettyReport fileContent withUnicode (Report isError message markers hints) =
(6) -------+
-}
in {- (1) -} header <> colon <+> align (pretty message) <> hardline
<+> {- (2) -} pad maxLineNumberLength ' ' empty <+> bold (black $ text if withUnicode then "╭─▶" else "+->") <+> bold (dullgreen reportFile) <> hardline
<+> {- (2) -} pad maxLineNumberLength ' ' mempty <+> annotate (bold <> color Black) (if withUnicode then "╭─▶" else "+->") <+> annotate (bold <> colorDull Green) reportFile <> hardline
<+> {- (3) -} pipePrefix maxLineNumberLength withUnicode
<> {- (4) -} prettyAllLines fileContent withUnicode isError maxLineNumberLength sortedMarkersPerLine multilineMarkers allLineNumbers
<> {- (5) -} (if null hints || null markers then empty else hardline <+> dotPrefix maxLineNumberLength withUnicode) <> prettyAllHints hints maxLineNumberLength withUnicode <> hardline
<> {- (6) -} bold (black $ pad (maxLineNumberLength + 2) (if withUnicode then '─' else '-') empty <> text if withUnicode then "╯" else "+") <> hardline
<> {- (5) -} (if null hints || null markers then mempty else hardline <+> dotPrefix maxLineNumberLength withUnicode) <> prettyAllHints hints maxLineNumberLength withUnicode <> hardline
<> {- (6) -} annotate (bold <> color Black) (pad (maxLineNumberLength + 2) (if withUnicode then '─' else '-') mempty <> if withUnicode then "╯" else "+") <> hardline
where
isThisMarker (This _) = True
isThisMarker _ = False
@ -158,8 +161,8 @@ prettyReport fileContent withUnicode (Report isError message markers hints) =
-------------------------------------------------------------------------------------
-- | Inserts a given number of character after a 'Doc'ument.
pad :: Int -> Char -> Doc -> Doc
pad n c d = width d \ w -> text (replicate (n - w) c)
pad :: Int -> Char -> Doc ann -> Doc ann
pad n c d = width d \ w -> pretty $ replicate (n - w) c
-- | Creates a "dot"-prefix for a report line where there is no code.
--
@ -169,8 +172,8 @@ pad n c d = width d \ w -> text (replicate (n - w) c)
-- [without unicode] "@␣␣␣␣␣:␣@"
dotPrefix :: Int -- ^ The length of the left space before the bullet.
-> Bool -- ^ Whether to print with unicode characters or not.
-> Doc
dotPrefix leftLen withUnicode = pad leftLen ' ' empty <+> bold (black $ text if withUnicode then "•" else ":")
-> Doc AnsiStyle
dotPrefix leftLen withUnicode = pad leftLen ' ' mempty <+> annotate (bold <> color Black) (if withUnicode then "•" else ":")
-- | Creates a "pipe"-prefix for a report line where there is no code.
--
@ -180,8 +183,8 @@ dotPrefix leftLen withUnicode = pad leftLen ' ' empty <+> bold (black $ text if
-- [without unicode] "@␣␣␣␣␣|␣@"
pipePrefix :: Int -- ^ The length of the left space before the pipe.
-> Bool -- ^ Whether to print with unicode characters or not.
-> Doc
pipePrefix leftLen withUnicode = pad leftLen ' ' empty <+> bold (black $ text if withUnicode then "│" else "|")
-> Doc AnsiStyle
pipePrefix leftLen withUnicode = pad leftLen ' ' mempty <+> annotate (bold <> color Black) (if withUnicode then "│" else "|")
-- | Creates a line-prefix for a report line containing source code
--
@ -194,10 +197,10 @@ pipePrefix leftLen withUnicode = pad leftLen ' ' empty <+> bold (black $ text if
linePrefix :: Int -- ^ The length of the amount of space to span before the vertical bar.
-> Int -- ^ The line number to show.
-> Bool -- ^ Whether to use unicode characters or not.
-> Doc
-> Doc AnsiStyle
linePrefix leftLen lineNo withUnicode =
let lineNoLen = length (show lineNo)
in bold $ black $ empty <+> pad (leftLen - lineNoLen) ' ' empty <> int lineNo <+> text if withUnicode then "│" else "|"
in annotate (bold <> color Black) $ mempty <+> pad (leftLen - lineNoLen) ' ' mempty <> pretty lineNo <+> if withUnicode then "│" else "|"
-- |
splitMarkersPerLine :: [(Position, Marker msg)] -> (HashMap Int [(Position, Marker msg)], [(Position, Marker msg)])
@ -217,19 +220,19 @@ prettyAllLines :: Pretty msg
-> [(Int, [(Position, Marker msg)])]
-> [(Position, Marker msg)]
-> [Int]
-> Doc
prettyAllLines _ _ _ _ _ [] [] = empty
-> Doc AnsiStyle
prettyAllLines _ _ _ _ _ [] [] = mempty
prettyAllLines _ withUnicode isError leftLen _ multiline [] =
let colorOfLastMultilineMarker = maybe id (markerColor isError . snd) (List.safeLast multiline)
let colorOfLastMultilineMarker = maybe mempty (markerColor isError . snd) (List.safeLast multiline)
-- take the color of the last multiline marker in case we need to add additional bars
prefix = hardline <+> dotPrefix leftLen withUnicode <> space
prefixWithBar color = prefix <> color (text if withUnicode then "│ " else "| ")
prefixWithBar color = prefix <> annotate color (if withUnicode then "│ " else "| ")
showMultilineMarkerMessage (_, marker) isLast = markerColor isError marker $ text (if isLast
then if withUnicode then "╰╸ " else "`- "
else if withUnicode then "├╸ " else "|- ")
<> replaceLinesWith (if isLast then prefix <> text " " else prefixWithBar (markerColor isError marker) <> space) (pretty $ markerMessage marker)
showMultilineMarkerMessage (_, marker) isLast = annotate (markerColor isError marker) $ (if isLast
then if withUnicode then "╰╸ " else "`- "
else if withUnicode then "├╸ " else "|- ")
<> replaceLinesWith (if isLast then prefix <> " " else prefixWithBar (markerColor isError marker) <> space) (pretty $ markerMessage marker)
showMultilineMarkerMessages [] = []
showMultilineMarkerMessages [m] = [showMultilineMarkerMessage m True]
@ -250,18 +253,18 @@ prettyAllLines files withUnicode isError leftLen inline multiline (line : ls) =
allMultilineMarkersInLine = flip filter multiline \ (Position (bl, _) (el, _) _, _) -> bl == line || el == line
colorOfFirstMultilineMarker = maybe id (markerColor isError . snd) (List.safeHead allMultilineMarkersInLine)
colorOfFirstMultilineMarker = maybe id (annotate . markerColor isError . snd) (List.safeHead allMultilineMarkersInLine)
-- take the first multiline marker to color the entire line, if there is one
!additionalPrefix = case allMultilineMarkersInLine of
[] -> empty
[] -> mempty
(p@(Position _ (el, _) _), marker) : _ ->
let hasPredecessor = el == line || maybe False ((/=) p . fst . fst) (List.safeUncons multiline)
in colorOfFirstMultilineMarker (text if | hasPredecessor && withUnicode -> "├"
| hasPredecessor -> "|"
| withUnicode -> "╭"
| otherwise -> "+")
<> markerColor isError marker (text if withUnicode then "┤" else ">")
in colorOfFirstMultilineMarker (if | hasPredecessor && withUnicode -> "├"
| hasPredecessor -> "|"
| withUnicode -> "╭"
| otherwise -> "+")
<> annotate (markerColor isError marker) (if withUnicode then "┤" else ">")
<> space
allMarkersInLine = {- List.sortOn fst $ -} allInlineMarkersInLine <> allMultilineMarkersInLine
@ -271,15 +274,15 @@ prettyAllLines files withUnicode isError leftLen inline multiline (line : ls) =
<> {- (3) -} prettyAllLines files withUnicode isError leftLen inline multiline ls
-- |
getLine_ :: HashMap FilePath [String] -> [(Position, Marker msg)] -> Int -> Bool -> Doc
getLine_ :: HashMap FilePath [String] -> [(Position, Marker msg)] -> Int -> Bool -> Doc AnsiStyle
getLine_ files markers line isError = case List.safeIndex (line - 1) =<< (HashMap.!?) files . file . fst =<< List.safeHead markers of
Nothing -> text "<no-line>"
Nothing -> "<no-line>"
Just code -> fold $ indexed code <&> \ (n, c) ->
let colorizingMarkers = flip filter markers \ (Position (bl, bc) (el, ec) _, _) -> if bl == el
then n >= bc && n < ec
else (bl == line && n >= bc) || (el == line && n < ec)
in maybe id ((\ m -> bold . markerColor isError m) . snd) (List.safeLast colorizingMarkers) (char c)
in maybe id ((\ m -> annotate (bold <> markerColor isError m)) . snd) (List.safeLast colorizingMarkers) (pretty c)
-- TODO: color the code where there are markers, still prioritizing right markers over left ones
where
indexed :: [a] -> [(Int, a)]
@ -290,16 +293,16 @@ getLine_ files markers line isError = case List.safeIndex (line - 1) =<< (HashMa
goIndexed n (x : xs) = (n, x) : goIndexed (n + 1) xs
-- |
showAllMarkersInLine :: Pretty msg => Bool -> (Doc -> Doc) -> Bool -> Bool -> Int -> [(Position, Marker msg)] -> Doc
showAllMarkersInLine _ _ _ _ _ [] = empty
showAllMarkersInLine :: Pretty msg => Bool -> (Doc AnsiStyle -> Doc AnsiStyle) -> Bool -> Bool -> Int -> [(Position, Marker msg)] -> Doc AnsiStyle
showAllMarkersInLine _ _ _ _ _ [] = mempty
showAllMarkersInLine hasMultilines colorMultilinePrefix withUnicode isError leftLen ms =
let maxMarkerColumn = snd $ end $ fst $ List.last $ List.sortOn (snd . end . fst) ms
specialPrefix = if hasMultilines then colorMultilinePrefix (text if withUnicode then "│ " else "| ") <> space else empty
specialPrefix = if hasMultilines then colorMultilinePrefix (if withUnicode then "│ " else "| ") <> space else mempty
-- get the maximum end column, so that we know when to stop looking for other markers on the same line
in hardline <+> dotPrefix leftLen withUnicode <+> (if List.null ms then empty else specialPrefix <> showMarkers 1 maxMarkerColumn <> showMessages specialPrefix ms maxMarkerColumn)
in hardline <+> dotPrefix leftLen withUnicode <+> (if List.null ms then mempty else specialPrefix <> showMarkers 1 maxMarkerColumn <> showMessages specialPrefix ms maxMarkerColumn)
where
showMarkers n lineLen
| n > lineLen = empty -- reached the end of the line
| n > lineLen = mempty -- reached the end of the line
| otherwise =
let allMarkers = flip filter ms \ (Position (_, bc) (_, ec) _, _) -> n >= bc && n < ec
-- only consider markers which span onto the current column
@ -308,12 +311,12 @@ showAllMarkersInLine hasMultilines colorMultilinePrefix withUnicode isError left
markers ->
let (Position{..}, marker) = List.last markers
in if snd begin == n
then markerColor isError marker (text if withUnicode then "┬" else "^") <> showMarkers (n + 1) lineLen
else markerColor isError marker (text if withUnicode then "─" else "-") <> showMarkers (n + 1) lineLen
then annotate (markerColor isError marker) (if withUnicode then "┬" else "^") <> showMarkers (n + 1) lineLen
else annotate (markerColor isError marker) (if withUnicode then "─" else "-") <> showMarkers (n + 1) lineLen
-- if the marker just started on this column, output a caret, else output a dash
showMessages specialPrefix ms lineLen = case List.safeUncons ms of
Nothing -> empty -- no more messages to show
Nothing -> mempty -- no more messages to show
Just ((Position b@(_, bc) _ _, msg), pipes) ->
let filteredPipes = filter ((/= b) . begin . fst) pipes
-- record only the pipes corresponding to markers on different starting positions
@ -330,17 +333,17 @@ showAllMarkersInLine hasMultilines colorMultilinePrefix withUnicode isError left
hasSuccessor = length filteredPipes /= length pipes
lineStart pipes =
let (n, docs) :: (Int, [Doc]) = allColumns 1 $ List.sortOn (snd . begin . fst) pipes
in dotPrefix leftLen withUnicode <+> specialPrefix <> fold docs <> text (replicate (bc - n) ' ')
let (n, docs) = allColumns 1 $ List.sortOn (snd . begin . fst) pipes
in dotPrefix leftLen withUnicode <+> specialPrefix <> fold docs <> pretty (replicate (bc - n) ' ')
-- the start of the line contains the "dot"-prefix as well as all the pipes for all the still not rendered marker messages
prefix =
let (pipesBefore, pipesAfter) = List.partition ((< bc) . snd . begin . fst) nubbedPipes
-- split the list so that all pipes before can have `|`s but pipes after won't
pipesBeforeRendered = pipesBefore <&> second \ marker -> markerColor isError marker (text if withUnicode then "│" else "|")
pipesBeforeRendered = pipesBefore <&> second \ marker -> annotate (markerColor isError marker) (if withUnicode then "│" else "|")
-- pre-render pipes which are before because they will be shown
lastBeginPosition = snd . begin . fst <$> List.safeLast (List.sortOn (Down . snd . begin . fst) pipesAfter)
lineLen = case lastBeginPosition of
@ -354,10 +357,10 @@ showAllMarkersInLine hasMultilines colorMultilinePrefix withUnicode isError left
lineChar = if withUnicode then '─' else '-'
pointChar = if withUnicode then "╸" else "-"
in lineStart pipesBeforeRendered
<> markerColor isError msg (text currentPipe <> string (replicate lineLen lineChar) <> text pointChar)
<+> markerColor isError msg (replaceLinesWith (hardline <+> lineStart pipesBeforeRendered <+> text " ") $ pretty $ markerMessage msg)
<> annotate (markerColor isError msg) (currentPipe <> pretty (replicate lineLen lineChar) <> pointChar)
<+> annotate (markerColor isError msg) (replaceLinesWith (hardline <+> lineStart pipesBeforeRendered <+> " ") $ pretty $ markerMessage msg)
in hardline <+> prefix <> showMessages specialPrefix pipes lineLen
@ -365,7 +368,7 @@ showAllMarkersInLine hasMultilines colorMultilinePrefix withUnicode isError left
--
-- DO NOT use a wildcard here, in case the internal API exposes one more constructor
-- |
replaceLinesWith :: Doc -> Doc -> Doc
replaceLinesWith :: Doc ann -> Doc ann -> Doc ann
replaceLinesWith repl Line = repl
replaceLinesWith _ Fail = Fail
replaceLinesWith _ Empty = Empty
@ -376,22 +379,18 @@ replaceLinesWith repl (Cat c d) = Cat (replaceLinesWith repl c) (re
replaceLinesWith repl (Nest n d) = Nest n (replaceLinesWith repl d)
replaceLinesWith repl (Union c d) = Union (replaceLinesWith repl c) (replaceLinesWith repl d)
replaceLinesWith repl (Column f) = Column (replaceLinesWith repl . f)
replaceLinesWith repl (Columns f) = Columns (replaceLinesWith repl . f)
replaceLinesWith repl (Nesting f) = Nesting (replaceLinesWith repl . f)
replaceLinesWith repl (Color l i c d) = Color l i c (replaceLinesWith repl d)
replaceLinesWith repl (Intensify i d) = Intensify i (replaceLinesWith repl d)
replaceLinesWith repl (Italicize i d) = Italicize i (replaceLinesWith repl d)
replaceLinesWith repl (Underline u d) = Underline u (replaceLinesWith repl d)
replaceLinesWith _ (RestoreFormat c d i b u) = RestoreFormat c d i b u
replaceLinesWith repl (Annotated ann doc) = Annotated ann (replaceLinesWith repl doc)
replaceLinesWith repl (WithPageWidth f) = WithPageWidth (replaceLinesWith repl . f)
-- | Extracts the color of a marker as a 'Doc' coloring function.
markerColor :: Bool -- ^ Whether the marker is in an error context or not.
-- This really makes a difference for a 'This' marker.
-> Marker msg -- ^ The marker to extract the color from.
-> (Doc -> Doc) -- ^ A function used to color a 'Doc'.
markerColor isError (This _) = if isError then red else yellow
markerColor _ (Where _) = dullblue
markerColor _ (Maybe _) = magenta
-> AnsiStyle -- ^ A function used to color a 'Doc'.
markerColor isError (This _) = if isError then color Red else color Yellow
markerColor _ (Where _) = colorDull Blue
markerColor _ (Maybe _) = color Magenta
-- | Retrieves the message held by a marker.
markerMessage :: Marker msg -> msg
@ -400,13 +399,13 @@ markerMessage (Where m) = m
markerMessage (Maybe m) = m
-- | Pretty prints all hints.
prettyAllHints :: Pretty msg => [msg] -> Int -> Bool -> Doc
prettyAllHints [] _ _ = empty
prettyAllHints :: Pretty msg => [msg] -> Int -> Bool -> Doc AnsiStyle
prettyAllHints [] _ _ = mempty
prettyAllHints (h : hs) leftLen withUnicode =
{-
A hint is composed of:
(1) : Hint: <hint message>
-}
let prefix = hardline <+> pipePrefix leftLen withUnicode
in prefix <+> cyan (bold (text "Hint:") <+> replaceLinesWith (prefix <+> text " ") (pretty h))
in prefix <+> annotate (color Cyan) (annotate bold "Hint:" <+> replaceLinesWith (prefix <+> " ") (pretty h))
<> prettyAllHints hs leftLen withUnicode