diff options
Diffstat (limited to 'compiler/utils/PprColour.hs')
| -rw-r--r-- | compiler/utils/PprColour.hs | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/compiler/utils/PprColour.hs b/compiler/utils/PprColour.hs index 1b97303b93..ba7435d5c2 100644 --- a/compiler/utils/PprColour.hs +++ b/compiler/utils/PprColour.hs @@ -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) |