ColorText supports background colors and inverted colors (untested)

parser-typechecker/src/Unison/CommandLine/DisplayValues.hs

@@ -93,7 +93,14 @@ displayPretty pped terms typeOf eval types tm = go tm
   goConsole = \case
     DD.ConsoleTextPlain (Term.Text' txt) -> pure $ P.text txt
     DD.ConsoleTextForeground color txt -> goColor color <$> goConsole txt
-    DD.ConsoleTextBackground color txt -> goColor color <$> goConsole txt
+    DD.ConsoleTextBackground color txt -> do
+      txt <- goConsole txt
+      color <- pure $ goColor color
+      pure $ P.background color txt
+    DD.ConsoleTextBold txt -> P.bold <$> goConsole txt
+    DD.ConsoleTextUnderline txt -> P.underline <$> goConsole txt
+    DD.ConsoleTextInvert txt -> P.invert <$> goConsole txt
+    _ -> displayTerm pped terms typeOf eval types tm
 
 -- pattern DocBlob txt <- Term.App' (Term.Constructor' DocRef DocBlobId) (Term.Text' txt)
 

parser-typechecker/src/Unison/Util/ColorText.hs

@@ -3,7 +3,8 @@
 
 module Unison.Util.ColorText (
   ColorText, Color(..), style, toANSI, toPlain, toHTML, defaultColors,
-  black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite, bold, underline,
+  black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite,
+  bold, underline, invert, background, unstyled,
   module Unison.Util.AnnotatedText)
 where
 
@@ -22,8 +23,8 @@ type ColorText = AnnotatedText Color
 data Color
   =  Black | Red | Green | Yellow | Blue | Purple | Cyan | White
   | HiBlack| HiRed | HiGreen | HiYellow | HiBlue | HiPurple | HiCyan | HiWhite
-  | Bold | Underline
-  deriving (Eq, Ord, Bounded, Enum, Show, Read)
+  | Bold | Underline | Invert Color | Background Color Color | Default
+  deriving (Eq, Ord, Show, Read)
 
 black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite, bold, underline :: ColorText -> ColorText
 black = style Black
@@ -45,6 +46,15 @@ hiWhite = style HiWhite
 bold = style Bold
 underline = style Underline
 
+unstyled :: ColorText -> ColorText
+unstyled = style Default
+
+background :: Color -> ColorText -> ColorText
+background c ct = ct <&> Background c
+
+invert :: ColorText -> ColorText
+invert ct = ct <&> Invert
+
 style :: Color -> ColorText -> ColorText
 style = annotate
 
@@ -82,7 +92,16 @@ toANSI (AnnotatedText chunks) =
       )
   resetANSI = pure . ANSI.setSGRCode $ [ANSI.Reset]
   toANSI :: Color -> Seq String
-  toANSI c = pure . ANSI.setSGRCode $ case c of
+  toANSI c = pure $ ANSI.setSGRCode (toANSI' c)
+
+  toANSI' :: Color -> [ANSI.SGR]
+  toANSI' c = case c of
+    Default  -> []
+    Background c c2 -> (setBg <$> toANSI' c) <> toANSI' c2 where
+      setBg (ANSI.SetColor ANSI.Foreground intensity color) =
+             ANSI.SetColor ANSI.Background intensity color
+      setBg sgr = sgr
+    Invert c -> [ANSI.SetSwapForegroundBackground True] <> toANSI' c
     Black    -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Black]
     Red      -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Red]
     Green    -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Green]

parser-typechecker/src/Unison/Util/Pretty.hs

@@ -8,6 +8,7 @@ module Unison.Util.Pretty (
    align,
    align',
    alternations,
+   background,
    backticked,
    backticked',
    boxForkLeft,
@@ -50,6 +51,7 @@ module Unison.Util.Pretty (
    indentN,
    indentNonEmptyN,
    indentNAfterNewline,
+   invert,
    isMultiLine,
    leftPad,
    lines,
@@ -114,6 +116,7 @@ import           Data.Char                      ( isSpace )
 import           Data.List                      ( intersperse )
 import           Prelude                 hiding ( lines , map )
 import           Unison.Util.AnnotatedText      ( annotateMaybe )
+import qualified Unison.Util.AnnotatedText     as AT
 import qualified Unison.Util.ColorText         as CT
 import qualified Unison.Util.SyntaxText        as ST
 import           Unison.Util.Monoid             ( intercalateMap )
@@ -774,6 +777,18 @@ hiWhite = map CT.hiWhite
 bold = map CT.bold
 underline = map CT.underline
 
+-- invert the foreground and background colors
+invert :: Pretty CT.ColorText -> Pretty CT.ColorText
+invert = map CT.invert
+
+-- set the background color, ex: `background hiBlue`, `background yellow`
+background :: (Pretty CT.ColorText -> Pretty CT.ColorText) -> Pretty CT.ColorText -> Pretty CT.ColorText
+background f p =
+  -- hack: discover the color of `f` by calling it on a dummy string
+  case f (Pretty mempty (Lit "-")) of
+    Pretty _ (Lit (AT.AnnotatedText (toList -> [AT.Segment _ (Just c)]))) -> map (CT.background c) p
+    _ -> p
+
 plural :: Foldable f
        => f a -> Pretty ColorText -> Pretty ColorText
 plural f p = case length f of