Commit 139ef04b authored by Rufflewind's avatar Rufflewind Committed by Ben Gamari
Browse files

Add "header" to GHC_COLORS

Add "header" to GHC_COLORS and allow colors to be inherited from the
surroundings.

Test Plan: validate

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

GHC Trac Issues: #13718

Differential Revision: https://phabricator.haskell.org/D3599
parent dac49bdc
......@@ -209,10 +209,12 @@ mkLocMessageAnn ann severity locn msg
-- Add prefixes, like Foo.hs:34: warning:
-- <the warning message>
prefix = locn' <> colon <+>
header = locn' <> colon <+>
coloured sevColour sevText <> optAnn
in coloured (Col.sMessage (colScheme dflags)) (hang prefix 4 msg)
in coloured (Col.sMessage (colScheme dflags))
(hang (coloured (Col.sHeader (colScheme dflags)) header) 4
msg)
where
sevText =
......
......@@ -723,19 +723,18 @@ ppUnless False doc = doc
--
-- Only takes effect if colours are enabled.
coloured :: Col.PprColour -> SDoc -> SDoc
coloured col@(Col.PprColour c) sdoc =
coloured col sdoc =
sdocWithDynFlags $ \dflags ->
if shouldUseColor dflags
then SDoc $ \ctx@SDC{ sdocLastColour = Col.PprColour lc } ->
then SDoc $ \ctx@SDC{ sdocLastColour = lastCol } ->
case ctx of
SDC{ sdocStyle = PprUser _ _ Coloured } ->
let ctx' = ctx{ sdocLastColour = col } in
Pretty.zeroWidthText (cReset ++ c)
let ctx' = ctx{ sdocLastColour = lastCol `mappend` col } in
Pretty.zeroWidthText (Col.renderColour col)
Pretty.<> runSDoc sdoc ctx'
Pretty.<> Pretty.zeroWidthText (cReset ++ lc)
Pretty.<> Pretty.zeroWidthText (Col.renderColourAfresh lastCol)
_ -> runSDoc sdoc ctx
else sdoc
where Col.PprColour cReset = Col.colReset
keyword :: SDoc -> SDoc
keyword = coloured Col.colBold
......
......@@ -3,7 +3,7 @@ import Data.Maybe (fromMaybe)
import Util (OverridingBool(..), split)
-- | A colour\/style for use with 'coloured'.
newtype PprColour = PprColour String
newtype PprColour = PprColour { renderColour :: String }
-- | Allow colours to be combined (e.g. bold + red);
-- In case of conflict, right side takes precedence.
......@@ -11,8 +11,12 @@ instance Monoid PprColour where
mempty = PprColour mempty
PprColour s1 `mappend` PprColour s2 = PprColour (s1 `mappend` s2)
renderColourAfresh :: PprColour -> String
renderColourAfresh c = renderColour (colReset `mappend` c)
colCustom :: String -> PprColour
colCustom s = PprColour ("\27[" ++ s ++ "m")
colCustom "" = mempty
colCustom s = PprColour ("\27[" ++ s ++ "m")
colReset :: PprColour
colReset = colCustom "0"
......@@ -46,7 +50,8 @@ colWhiteFg = colCustom "37"
data Scheme =
Scheme
{ sMessage :: PprColour
{ sHeader :: PprColour
, sMessage :: PprColour
, sWarning :: PprColour
, sError :: PprColour
, sFatal :: PprColour
......@@ -56,7 +61,8 @@ data Scheme =
defaultScheme :: Scheme
defaultScheme =
Scheme
{ sMessage = colBold
{ sHeader = mempty
, sMessage = colBold
, sWarning = colBold `mappend` colMagentaFg
, sError = colBold `mappend` colRedFg
, sFatal = colBold `mappend` colRedFg
......@@ -72,7 +78,8 @@ parseScheme "never" (_, cs) = (Never, cs)
parseScheme input (b, cs) =
( b
, Scheme
{ sMessage = fromMaybe (sMessage cs) (lookup "message" table)
{ sHeader = fromMaybe (sHeader cs) (lookup "header" table)
, sMessage = fromMaybe (sMessage cs) (lookup "message" table)
, sWarning = fromMaybe (sWarning cs) (lookup "warning" table)
, sError = fromMaybe (sError cs) (lookup "error" table)
, sFatal = fromMaybe (sFatal cs) (lookup "fatal" table)
......
......@@ -804,14 +804,30 @@ messages and in GHCi:
.. code-block:: none
message=1:warning=1;35:error=1;31:fatal=1;31:margin=1;34
header=:message=1:warning=1;35:error=1;31:fatal=1;31:margin=1;34
Each value is expected to be a `Select Graphic Rendition (SGR) substring
<https://en.wikipedia.org/wiki/ANSI_escape_code#graphics>`_.
<https://en.wikipedia.org/wiki/ANSI_escape_code#graphics>`_. The
formatting of each element can inherit from parent elements. For example,
if ``header`` is left empty, it will inherit the formatting of
``message``. Alternatively if ``header`` is set to ``1`` (bold), it will
be bolded but still inherits the color of ``message``.
Currently, in the primary message, the following inheritance tree is in
place:
- ``message``
- ``header``
- ``warning``
- ``error``
- ``fatal``
In the caret diagnostics, there is currently no inheritance at all between
``margin``, ``warning``, ``error``, and ``fatal``.
The environment variable can also be set to the magical values ``never``
or ``always``, which is equivalent to setting the corresponding
``-fdiagnostics-color`` flag but has lower precedence.
``-fdiagnostics-color`` flag but with lower precedence.
.. ghc-flag:: -f[no-]diagnostics-show-caret
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment