-- |
-- Module    : Aura.Colour
-- Copyright : (c) Colin Woodbury, 2012 - 2021
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Annotate `Doc` text with various colours.

module Aura.Colour
  ( -- * Render to Text
    dtot
    -- * Colours
  , cyan, bCyan, green, yellow, red, magenta
  ) where

import Prettyprinter
import Prettyprinter.Render.Terminal
import RIO

---

-- | Render an assembled `Doc` into strict `Text`.
dtot :: Doc AnsiStyle -> Text
dtot :: Doc AnsiStyle -> Text
dtot = SimpleDocStream AnsiStyle -> Text
renderStrict (SimpleDocStream AnsiStyle -> Text)
-> (Doc AnsiStyle -> SimpleDocStream AnsiStyle)
-> Doc AnsiStyle
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions

-- | Colour a `Doc` cyan.
cyan :: Doc AnsiStyle -> Doc AnsiStyle
cyan :: Doc AnsiStyle -> Doc AnsiStyle
cyan = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Cyan)

-- | Colour a `Doc` cyan and bold.
bCyan :: Doc AnsiStyle -> Doc AnsiStyle
bCyan :: Doc AnsiStyle -> Doc AnsiStyle
bCyan = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Cyan AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> AnsiStyle
bold)

-- | Colour a `Doc` green.
green :: Doc AnsiStyle -> Doc AnsiStyle
green :: Doc AnsiStyle -> Doc AnsiStyle
green = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Green)

-- | Colour a `Doc` yellow.
yellow :: Doc AnsiStyle -> Doc AnsiStyle
yellow :: Doc AnsiStyle -> Doc AnsiStyle
yellow = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow)

-- | Colour a `Doc` red.
red :: Doc AnsiStyle -> Doc AnsiStyle
red :: Doc AnsiStyle -> Doc AnsiStyle
red = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red)

-- | Colour a `Doc` magenta.
magenta :: Doc AnsiStyle -> Doc AnsiStyle
magenta :: Doc AnsiStyle -> Doc AnsiStyle
magenta = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Magenta)