{-# LANGUAGE CPP #-}

module Options.Applicative.Help.Pretty
  ( module PP
  , (.$.)
  , groupOrNestLine
  , altSep
  , Ann(..)
  , Doc

  , enclose
  , parens
  , brackets
  , hang
  , indent
  , nest

  , text
  , plain
  , deunderline
  , underline
  , debold
  , bold
  , ondullwhite
  , onwhite
  , ondullcyan
  , oncyan
  , ondullmagenta
  , onmagenta
  , ondullblue
  , onblue
  , ondullyellow
  , onyellow
  , ondullgreen
  , ongreen
  , ondullred
  , onred
  , ondullblack
  , onblack
  , dullwhite
  , white
  , dullcyan
  , cyan
  , dullmagenta
  , magenta
  , dullblue
  , blue
  , dullyellow
  , yellow
  , dullgreen
  , green
  , dullred
  , red
  , dullblack
  , black

  -- TODO Remove these
  -- , (<$>)
  , (</>)
  , (<$$>)
  , (<//>)
  , string

  , isEffectivelyEmpty

  , renderShowS
  ) where

import           Control.Applicative
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup ((<>))
#endif

import           Options.Applicative.Help.Ann
import           Prettyprinter hiding ((<>), Doc, enclose, parens, brackets, hang, indent, nest)
import qualified Prettyprinter as PP
import qualified Prettyprinter.Internal as PPI
import           Prettyprinter.Render.String (renderShowS)
import qualified Options.Applicative.Help.Style as S

import           Prelude

type Doc = PPI.Doc Ann

(.$.) :: Doc -> Doc -> Doc
.$. :: Doc -> Doc -> Doc
(.$.) Doc
x Doc
y = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"(.$.)" (Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y)

-- | Apply the function if we're not at the
--   start of our nesting level.
ifNotAtRoot :: (Doc -> Doc) -> Doc -> Doc
ifNotAtRoot :: (Doc -> Doc) -> Doc -> Doc
ifNotAtRoot Doc -> Doc
f Doc
doc = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"ifNotAtRoot" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
  (Int -> Doc) -> Doc
forall ann. (Int -> Doc ann) -> Doc ann
PPI.Nesting ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    (Int -> Doc) -> Doc
forall ann. (Int -> Doc ann) -> Doc ann
PPI.Column ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
j ->
      if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
        then Doc
doc
        else Doc -> Doc
f Doc
doc


-- | Render flattened text on this line, or start
--   a new line before rendering any text.
--
--   This will also nest subsequent lines in the
--   group.
groupOrNestLine :: Doc -> Doc
groupOrNestLine :: Doc -> Doc
groupOrNestLine Doc
d = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"groupOrNestLine" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
  (Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
PPI.Union
    (Doc -> Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc -> Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Doc -> Doc
flatten
    (Doc -> Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Doc -> Doc) -> Doc -> Doc
ifNotAtRoot (Doc
forall ann. Doc ann
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>)) Doc
d
  where flatten :: Doc -> Doc
        flatten :: Doc -> Doc
flatten Doc
doc = case Doc
doc of
          PPI.FlatAlt Doc
_ Doc
y     -> Doc -> Doc
flatten Doc
y
          PPI.Cat Doc
x Doc
y         -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
PPI.Cat (Doc -> Doc
flatten Doc
x) (Doc -> Doc
flatten Doc
y)
          PPI.Nest Int
i Doc
x        -> Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PPI.Nest Int
i (Doc -> Doc
flatten Doc
x)
          Doc
PPI.Line            -> Doc
forall ann. Doc ann
PPI.Fail
          PPI.Union Doc
x Doc
_       -> Doc -> Doc
flatten Doc
x
          PPI.Column Int -> Doc
f        -> (Int -> Doc) -> Doc
forall ann. (Int -> Doc ann) -> Doc ann
PPI.Column (Doc -> Doc
flatten (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
f)
          PPI.WithPageWidth PageWidth -> Doc
f -> (PageWidth -> Doc) -> Doc
forall ann. (PageWidth -> Doc ann) -> Doc ann
PPI.WithPageWidth (Doc -> Doc
flatten (Doc -> Doc) -> (PageWidth -> Doc) -> PageWidth -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Doc
f)
          PPI.Nesting Int -> Doc
f       -> (Int -> Doc) -> Doc
forall ann. (Int -> Doc ann) -> Doc ann
PPI.Nesting (Doc -> Doc
flatten (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
f)
          PPI.Annotated Ann
ann Doc
x -> Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
PPI.Annotated Ann
ann (Doc -> Doc
flatten Doc
x)

          x :: Doc
x@Doc
PPI.Fail   -> Doc
x
          x :: Doc
x@Doc
PPI.Empty  -> Doc
x
          x :: Doc
x@PPI.Char{} -> Doc
x
          x :: Doc
x@PPI.Text{} -> Doc
x

-- | Separate items in an alternative with a pipe.
--
--   If the first document and the pipe don't fit
--   on the line, then mandatorily flow the next entry
--   onto the following line.
--
--   The (<//>) softbreak ensures that if the document
--   does fit on the line, there is at least a space,
--   but it's possible for y to still appear on the
--   next line.
altSep :: Doc -> Doc -> Doc
altSep :: Doc -> Doc -> Doc
altSep Doc
x Doc
y = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"altSep" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
  Doc -> Doc
forall ann. Doc ann -> Doc ann
group (Doc
x Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc
forall a ann. Pretty a => a -> Doc ann
pretty String
"|" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
line) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
softline' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y


-- (<$>) :: Doc -> Doc -> Doc
-- (<$>) = \x y -> x <> line <> y

(</>) :: Doc -> Doc -> Doc
</> :: Doc -> Doc -> Doc
(</>) Doc
x Doc
y = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"(</>)" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
softline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y

(<$$>) :: Doc -> Doc -> Doc
<$$> :: Doc -> Doc -> Doc
(<$$>) Doc
x Doc
y = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"(<$$>)" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
linebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y

(<//>) :: Doc -> Doc -> Doc
<//> :: Doc -> Doc -> Doc
(<//>) Doc
x Doc
y = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"(<//>)" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
softbreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y

linebreak :: Doc
linebreak :: Doc
linebreak = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
0 String
"linebreak" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc
forall ann. Doc ann
line Doc
forall a. Monoid a => a
mempty

softbreak :: Doc
softbreak :: Doc
softbreak = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
0 String
"softbreak" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall ann. Doc ann -> Doc ann
group Doc
linebreak

-- | Traced version of 'PP.string'.
string :: String -> Doc
string :: String -> Doc
string = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
0 String
"string" (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty

-- | Traced version of 'PP.parens'.
parens :: Doc -> Doc
parens :: Doc -> Doc
parens = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"parens" (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.parens

-- | Traced version of 'PP.brackets'.
brackets :: Doc -> Doc
brackets :: Doc -> Doc
brackets = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"brackets" (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.brackets

-- | Traced version of 'PP.enclose'.
enclose
    :: Doc -- ^ L
    -> Doc -- ^ R
    -> Doc -- ^ x
    -> Doc -- ^ LxR
enclose :: Doc -> Doc -> Doc -> Doc
enclose Doc
l Doc
r Doc
x = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"enclose" (Doc -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
PP.enclose Doc
l Doc
r Doc
x)

-- | Traced version of 'PP.hang'.
hang :: Int -> Doc -> Doc
hang :: Int -> Doc -> Doc
hang Int
n = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"hang" (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PP.hang Int
n

-- | Traced version of 'PP.nest'.
nest :: Int -> Doc -> Doc
nest :: Int -> Doc -> Doc
nest Int
n = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"nest" (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PP.nest Int
n

-- | Traced version of 'PP.indent'.
indent :: Int -> Doc -> Doc
indent :: Int -> Doc -> Doc
indent Int
n = Int -> String -> Doc -> Doc
forall a. CanAnnotate a => Int -> String -> a -> a
annTrace Int
1 String
"indent" (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PP.indent Int
n

-- | Determine if the document is empty when rendered
isEffectivelyEmpty :: Doc -> Bool
isEffectivelyEmpty :: Doc -> Bool
isEffectivelyEmpty Doc
doc = case Doc
doc of
  Doc
PPI.Fail -> Bool
True
  Doc
PPI.Empty -> Bool
True
  PPI.Char Char
_ -> Bool
False
  PPI.Text Int
_ Text
_ -> Bool
False
  Doc
PPI.Line -> Bool
False
  PPI.FlatAlt Doc
_ Doc
d -> Doc -> Bool
isEffectivelyEmpty Doc
d
  PPI.Cat Doc
a Doc
b -> Doc -> Bool
isEffectivelyEmpty Doc
a Bool -> Bool -> Bool
&& Doc -> Bool
isEffectivelyEmpty Doc
b
  PPI.Nest Int
_ Doc
d -> Doc -> Bool
isEffectivelyEmpty Doc
d
  PPI.Union Doc
_ Doc
d -> Doc -> Bool
isEffectivelyEmpty Doc
d
  PPI.Column Int -> Doc
_ -> Bool
True
  PPI.WithPageWidth PageWidth -> Doc
_ -> Bool
False
  PPI.Nesting Int -> Doc
_ -> Bool
False
  PPI.Annotated Ann
_ Doc
d -> Doc -> Bool
isEffectivelyEmpty Doc
d

text :: String -> Doc
text :: String -> Doc
text = String -> Doc
forall a ann. Pretty a => a -> Doc ann
pretty

plain :: Doc -> Doc
plain :: Doc -> Doc
plain = Doc -> Doc
forall a. a -> a
id

deunderline :: Doc -> Doc
deunderline :: Doc -> Doc
deunderline = Doc -> Doc
forall a. a -> a
id

underline :: Doc -> Doc
underline :: Doc -> Doc
underline = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle SetStyle
S.underlined)

debold :: Doc -> Doc
debold :: Doc -> Doc
debold = Doc -> Doc
forall a. a -> a
id

bold :: Doc -> Doc
bold :: Doc -> Doc
bold = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle SetStyle
S.bold)

ondullwhite :: Doc -> Doc
ondullwhite :: Doc -> Doc
ondullwhite = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColorDull Color
S.White))

onwhite :: Doc -> Doc
onwhite :: Doc -> Doc
onwhite = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColor Color
S.White))

ondullcyan :: Doc -> Doc
ondullcyan :: Doc -> Doc
ondullcyan = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColorDull Color
S.Cyan))

oncyan :: Doc -> Doc
oncyan :: Doc -> Doc
oncyan = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColor Color
S.Cyan))

ondullmagenta :: Doc -> Doc
ondullmagenta :: Doc -> Doc
ondullmagenta = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColorDull Color
S.Magenta))

onmagenta :: Doc -> Doc
onmagenta :: Doc -> Doc
onmagenta = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColor Color
S.Magenta))

ondullblue :: Doc -> Doc
ondullblue :: Doc -> Doc
ondullblue = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColorDull Color
S.Blue))

onblue :: Doc -> Doc
onblue :: Doc -> Doc
onblue = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColor Color
S.Blue))

ondullyellow :: Doc -> Doc
ondullyellow :: Doc -> Doc
ondullyellow = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColorDull Color
S.Yellow))

onyellow :: Doc -> Doc
onyellow :: Doc -> Doc
onyellow = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColor Color
S.Yellow))

ondullgreen :: Doc -> Doc
ondullgreen :: Doc -> Doc
ondullgreen = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColorDull Color
S.Green))

ongreen :: Doc -> Doc
ongreen :: Doc -> Doc
ongreen = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColor Color
S.Green))

ondullred :: Doc -> Doc
ondullred :: Doc -> Doc
ondullred = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColorDull Color
S.Red))

onred :: Doc -> Doc
onred :: Doc -> Doc
onred = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColor Color
S.Red))

ondullblack :: Doc -> Doc
ondullblack :: Doc -> Doc
ondullblack = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColorDull Color
S.Black))

onblack :: Doc -> Doc
onblack :: Doc -> Doc
onblack = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.bgColor Color
S.Black))

dullwhite :: Doc -> Doc
dullwhite :: Doc -> Doc
dullwhite = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.colorDull Color
S.White))

white :: Doc -> Doc
white :: Doc -> Doc
white = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.color Color
S.White))

dullcyan :: Doc -> Doc
dullcyan :: Doc -> Doc
dullcyan = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.colorDull Color
S.Cyan))

cyan :: Doc -> Doc
cyan :: Doc -> Doc
cyan = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.color Color
S.Cyan))

dullmagenta :: Doc -> Doc
dullmagenta :: Doc -> Doc
dullmagenta = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.colorDull Color
S.Magenta))

magenta :: Doc -> Doc
magenta :: Doc -> Doc
magenta = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.color Color
S.Magenta))

dullblue :: Doc -> Doc
dullblue :: Doc -> Doc
dullblue = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.colorDull Color
S.Blue))

blue :: Doc -> Doc
blue :: Doc -> Doc
blue = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.color Color
S.Blue))

dullyellow :: Doc -> Doc
dullyellow :: Doc -> Doc
dullyellow = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.colorDull Color
S.Yellow))

yellow :: Doc -> Doc
yellow :: Doc -> Doc
yellow = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.color Color
S.Yellow))

dullgreen :: Doc -> Doc
dullgreen :: Doc -> Doc
dullgreen = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.colorDull Color
S.Green))

green :: Doc -> Doc
green :: Doc -> Doc
green = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.color Color
S.Green))

dullred :: Doc -> Doc
dullred :: Doc -> Doc
dullred = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.colorDull Color
S.Red))

red :: Doc -> Doc
red :: Doc -> Doc
red = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.color Color
S.Red))

dullblack :: Doc -> Doc
dullblack :: Doc -> Doc
dullblack = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.colorDull Color
S.Black))

black :: Doc -> Doc
black :: Doc -> Doc
black = Ann -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate (SetStyle -> Ann
AnnStyle (Color -> SetStyle
S.color Color
S.Black))