{-# OPTIONS_HADDOCK hide #-}

-- |
--
-- Copyright:
--   This file is part of the package byline. It is subject to the
--   license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/byline
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the
--   terms contained in the LICENSE file.
--
-- License: BSD-2-Clause
module Byline.Internal.Stylized
  ( Stylized (..),
    ToStylizedText (..),
    text,
    fg,
    bg,
    bold,
    underline,
    swapFgBg,
    RenderMode (..),
    render,
    renderText,
  )
where

import Byline.Internal.Color (Color)
import qualified Byline.Internal.Color as Color
import Byline.Internal.Types (Modifier (..), OnlyOne (..), Status (..))
import qualified Data.Text.IO as Text
import qualified System.Console.ANSI as ANSI

-- | A stylized value.  Construct text with modifiers using string
-- literals and the @OverloadedStrings@ extension and/or the 'text'
-- function.
--
-- @since 1.0.0.0
data Stylized a
  = -- | Something to stylize.
    Stylized Modifier a
  | -- | Modify the next stylized value.
    StylizedMod Modifier
  | -- | Multiple stylized values.
    StylizedList [Stylized a]
  deriving (Int -> Stylized a -> ShowS
[Stylized a] -> ShowS
Stylized a -> String
(Int -> Stylized a -> ShowS)
-> (Stylized a -> String)
-> ([Stylized a] -> ShowS)
-> Show (Stylized a)
forall a. Show a => Int -> Stylized a -> ShowS
forall a. Show a => [Stylized a] -> ShowS
forall a. Show a => Stylized a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stylized a] -> ShowS
$cshowList :: forall a. Show a => [Stylized a] -> ShowS
show :: Stylized a -> String
$cshow :: forall a. Show a => Stylized a -> String
showsPrec :: Int -> Stylized a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stylized a -> ShowS
Show, Stylized a -> Stylized a -> Bool
(Stylized a -> Stylized a -> Bool)
-> (Stylized a -> Stylized a -> Bool) -> Eq (Stylized a)
forall a. Eq a => Stylized a -> Stylized a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stylized a -> Stylized a -> Bool
$c/= :: forall a. Eq a => Stylized a -> Stylized a -> Bool
== :: Stylized a -> Stylized a -> Bool
$c== :: forall a. Eq a => Stylized a -> Stylized a -> Bool
Eq, a -> Stylized b -> Stylized a
(a -> b) -> Stylized a -> Stylized b
(forall a b. (a -> b) -> Stylized a -> Stylized b)
-> (forall a b. a -> Stylized b -> Stylized a) -> Functor Stylized
forall a b. a -> Stylized b -> Stylized a
forall a b. (a -> b) -> Stylized a -> Stylized b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Stylized b -> Stylized a
$c<$ :: forall a b. a -> Stylized b -> Stylized a
fmap :: (a -> b) -> Stylized a -> Stylized b
$cfmap :: forall a b. (a -> b) -> Stylized a -> Stylized b
Functor, Stylized a -> Bool
(a -> m) -> Stylized a -> m
(a -> b -> b) -> b -> Stylized a -> b
(forall m. Monoid m => Stylized m -> m)
-> (forall m a. Monoid m => (a -> m) -> Stylized a -> m)
-> (forall m a. Monoid m => (a -> m) -> Stylized a -> m)
-> (forall a b. (a -> b -> b) -> b -> Stylized a -> b)
-> (forall a b. (a -> b -> b) -> b -> Stylized a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stylized a -> b)
-> (forall b a. (b -> a -> b) -> b -> Stylized a -> b)
-> (forall a. (a -> a -> a) -> Stylized a -> a)
-> (forall a. (a -> a -> a) -> Stylized a -> a)
-> (forall a. Stylized a -> [a])
-> (forall a. Stylized a -> Bool)
-> (forall a. Stylized a -> Int)
-> (forall a. Eq a => a -> Stylized a -> Bool)
-> (forall a. Ord a => Stylized a -> a)
-> (forall a. Ord a => Stylized a -> a)
-> (forall a. Num a => Stylized a -> a)
-> (forall a. Num a => Stylized a -> a)
-> Foldable Stylized
forall a. Eq a => a -> Stylized a -> Bool
forall a. Num a => Stylized a -> a
forall a. Ord a => Stylized a -> a
forall m. Monoid m => Stylized m -> m
forall a. Stylized a -> Bool
forall a. Stylized a -> Int
forall a. Stylized a -> [a]
forall a. (a -> a -> a) -> Stylized a -> a
forall m a. Monoid m => (a -> m) -> Stylized a -> m
forall b a. (b -> a -> b) -> b -> Stylized a -> b
forall a b. (a -> b -> b) -> b -> Stylized a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Stylized a -> a
$cproduct :: forall a. Num a => Stylized a -> a
sum :: Stylized a -> a
$csum :: forall a. Num a => Stylized a -> a
minimum :: Stylized a -> a
$cminimum :: forall a. Ord a => Stylized a -> a
maximum :: Stylized a -> a
$cmaximum :: forall a. Ord a => Stylized a -> a
elem :: a -> Stylized a -> Bool
$celem :: forall a. Eq a => a -> Stylized a -> Bool
length :: Stylized a -> Int
$clength :: forall a. Stylized a -> Int
null :: Stylized a -> Bool
$cnull :: forall a. Stylized a -> Bool
toList :: Stylized a -> [a]
$ctoList :: forall a. Stylized a -> [a]
foldl1 :: (a -> a -> a) -> Stylized a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Stylized a -> a
foldr1 :: (a -> a -> a) -> Stylized a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Stylized a -> a
foldl' :: (b -> a -> b) -> b -> Stylized a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Stylized a -> b
foldl :: (b -> a -> b) -> b -> Stylized a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Stylized a -> b
foldr' :: (a -> b -> b) -> b -> Stylized a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Stylized a -> b
foldr :: (a -> b -> b) -> b -> Stylized a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Stylized a -> b
foldMap' :: (a -> m) -> Stylized a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Stylized a -> m
foldMap :: (a -> m) -> Stylized a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Stylized a -> m
fold :: Stylized m -> m
$cfold :: forall m. Monoid m => Stylized m -> m
Foldable, Functor Stylized
Foldable Stylized
Functor Stylized
-> Foldable Stylized
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Stylized a -> f (Stylized b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Stylized (f a) -> f (Stylized a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Stylized a -> m (Stylized b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Stylized (m a) -> m (Stylized a))
-> Traversable Stylized
(a -> f b) -> Stylized a -> f (Stylized b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Stylized (m a) -> m (Stylized a)
forall (f :: * -> *) a.
Applicative f =>
Stylized (f a) -> f (Stylized a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stylized a -> m (Stylized b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stylized a -> f (Stylized b)
sequence :: Stylized (m a) -> m (Stylized a)
$csequence :: forall (m :: * -> *) a. Monad m => Stylized (m a) -> m (Stylized a)
mapM :: (a -> m b) -> Stylized a -> m (Stylized b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stylized a -> m (Stylized b)
sequenceA :: Stylized (f a) -> f (Stylized a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Stylized (f a) -> f (Stylized a)
traverse :: (a -> f b) -> Stylized a -> f (Stylized b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stylized a -> f (Stylized b)
$cp2Traversable :: Foldable Stylized
$cp1Traversable :: Functor Stylized
Traversable)

-- | @since 1.0.0.0
instance Semigroup (Stylized a) where
  -- StylizedText on LHS.
  <> :: Stylized a -> Stylized a -> Stylized a
(<>) a :: Stylized a
a@(Stylized Modifier
_ a
_) b :: Stylized a
b@(Stylized Modifier
_ a
_) = [Stylized a] -> Stylized a
forall a. [Stylized a] -> Stylized a
StylizedList [Stylized a
a, Stylized a
b]
  (<>) (Stylized Modifier
m a
t) (StylizedMod Modifier
m') = Modifier -> a -> Stylized a
forall a. Modifier -> a -> Stylized a
Stylized (Modifier
m Modifier -> Modifier -> Modifier
forall a. Semigroup a => a -> a -> a
<> Modifier
m') a
t
  (<>) a :: Stylized a
a@(Stylized Modifier
_ a
_) (StylizedList [Stylized a]
b) = [Stylized a] -> Stylized a
forall a. [Stylized a] -> Stylized a
StylizedList (Stylized a
a Stylized a -> [Stylized a] -> [Stylized a]
forall a. a -> [a] -> [a]
: [Stylized a]
b)
  -- StylizedMod on LHS.
  (<>) (StylizedMod Modifier
m) (Stylized Modifier
m' a
t) = Modifier -> a -> Stylized a
forall a. Modifier -> a -> Stylized a
Stylized (Modifier
m Modifier -> Modifier -> Modifier
forall a. Semigroup a => a -> a -> a
<> Modifier
m') a
t
  (<>) (StylizedMod Modifier
m) (StylizedMod Modifier
m') = Modifier -> Stylized a
forall a. Modifier -> Stylized a
StylizedMod (Modifier
m Modifier -> Modifier -> Modifier
forall a. Semigroup a => a -> a -> a
<> Modifier
m')
  (<>) m :: Stylized a
m@(StylizedMod Modifier
_) (StylizedList [Stylized a]
l) = [Stylized a] -> Stylized a
forall a. [Stylized a] -> Stylized a
StylizedList ((Stylized a -> Stylized a) -> [Stylized a] -> [Stylized a]
forall a b. (a -> b) -> [a] -> [b]
map (Stylized a
m Stylized a -> Stylized a -> Stylized a
forall a. Semigroup a => a -> a -> a
<>) [Stylized a]
l)
  -- StylizedList on LHS.
  (<>) (StylizedList [Stylized a]
l) t :: Stylized a
t@(Stylized Modifier
_ a
_) = [Stylized a] -> Stylized a
forall a. [Stylized a] -> Stylized a
StylizedList ([Stylized a]
l [Stylized a] -> [Stylized a] -> [Stylized a]
forall a. Semigroup a => a -> a -> a
<> [Stylized a
t])
  (<>) (StylizedList [Stylized a]
l) m :: Stylized a
m@(StylizedMod Modifier
_) = [Stylized a] -> Stylized a
forall a. [Stylized a] -> Stylized a
StylizedList ((Stylized a -> Stylized a) -> [Stylized a] -> [Stylized a]
forall a b. (a -> b) -> [a] -> [b]
map (Stylized a -> Stylized a -> Stylized a
forall a. Semigroup a => a -> a -> a
<> Stylized a
m) [Stylized a]
l)
  (<>) (StylizedList [Stylized a]
l) (StylizedList [Stylized a]
l') = [Stylized a] -> Stylized a
forall a. [Stylized a] -> Stylized a
StylizedList ([Stylized a]
l [Stylized a] -> [Stylized a] -> [Stylized a]
forall a. Semigroup a => a -> a -> a
<> [Stylized a]
l')

-- | @since 1.0.0.0
instance Monoid (Stylized a) where
  mempty :: Stylized a
mempty = [Stylized a] -> Stylized a
forall a. [Stylized a] -> Stylized a
StylizedList []

-- | @since 1.0.0.0
instance IsString (Stylized Text) where
  fromString :: String -> Stylized Text
fromString = Text -> Stylized Text
text (Text -> Stylized Text)
-> (String -> Text) -> String -> Stylized Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText

-- | A class for types that can be converted to 'Stylized' text.
class ToStylizedText a where
  toStylizedText :: a -> Stylized Text

-- | @since 1.0.0.0
instance ToStylizedText (Stylized Text) where
  toStylizedText :: Stylized Text -> Stylized Text
toStylizedText = Stylized Text -> Stylized Text
forall a. a -> a
id

-- | Helper function to create stylized text.  If you enable the
-- @OverloadedStrings@ extension then you can create stylized text
-- directly without using this function.  However, if you are not
-- using any of the other stylized modifiers then this function can be
-- helpful for avoiding "Ambiguous type variable" compile errors.
--
-- This function is also helpful for producing stylized text from an
-- existing @Text@ value.
--
-- @since 1.0.0.0
text :: Text -> Stylized Text
text :: Text -> Stylized Text
text = Modifier -> Text -> Stylized Text
forall a. Modifier -> a -> Stylized a
Stylized Modifier
forall a. Monoid a => a
mempty

-- | Set the foreground color.  For example:
--
-- @
--     "Hello World!" <> fg magenta
-- @
--
-- @since 1.0.0.0
fg :: Color -> Stylized Text
fg :: Color -> Stylized Text
fg Color
c = Modifier -> Stylized Text
forall a. Modifier -> Stylized a
StylizedMod (Modifier
forall a. Monoid a => a
mempty {modColorFG :: OnlyOne Color
modColorFG = Maybe Color -> OnlyOne Color
forall a. Maybe a -> OnlyOne a
OnlyOne (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
c)})

-- | Set the background color.
--
-- @since 1.0.0.0
bg :: Color -> Stylized Text
bg :: Color -> Stylized Text
bg Color
c = Modifier -> Stylized Text
forall a. Modifier -> Stylized a
StylizedMod (Modifier
forall a. Monoid a => a
mempty {modColorBG :: OnlyOne Color
modColorBG = Maybe Color -> OnlyOne Color
forall a. Maybe a -> OnlyOne a
OnlyOne (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
c)})

-- | Produce bold text.
--
-- @since 1.0.0.0
bold :: Stylized Text
bold :: Stylized Text
bold = Modifier -> Stylized Text
forall a. Modifier -> Stylized a
StylizedMod (Modifier
forall a. Monoid a => a
mempty {modBold :: Status
modBold = Status
On})

-- | Produce underlined text.
--
-- @since 1.0.0.0
underline :: Stylized Text
underline :: Stylized Text
underline = Modifier -> Stylized Text
forall a. Modifier -> Stylized a
StylizedMod (Modifier
forall a. Monoid a => a
mempty {modUnderline :: Status
modUnderline = Status
On})

-- | Produce swapped foreground/background text.
--
-- @since 1.0.0.0
swapFgBg :: Stylized Text
swapFgBg :: Stylized Text
swapFgBg = Modifier -> Stylized Text
forall a. Modifier -> Stylized a
StylizedMod (Modifier
forall a. Monoid a => a
mempty {modSwapFgBg :: Status
modSwapFgBg = Status
On})

-- | How to render stylized text.
--
-- @since 1.0.0.0
data RenderMode
  = -- | Text only, no modifiers.
    Plain
  | -- | Allow up to 8 colors.
    Simple
  | -- | Allow up to 216 colors.
    Term256
  | -- | A terminal that supports full RGB colors.
    TermRGB

-- | Instructions for formatting stylized text after the 'RenderMode'
-- has already been considered.
--
-- @since 1.0.0.0
data RenderInstruction
  = RenderText Text
  | RenderSGR [ANSI.SGR]

-- | Send stylized text to the given handle.
--
-- @since 1.0.0.0
render :: RenderMode -> Handle -> Stylized Text -> IO ()
render :: RenderMode -> Handle -> Stylized Text -> IO ()
render RenderMode
mode Handle
h Stylized Text
stylized = (RenderInstruction -> IO ()) -> [RenderInstruction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenderInstruction -> IO ()
go (RenderMode -> Stylized Text -> [RenderInstruction]
renderInstructions RenderMode
mode Stylized Text
stylized)
  where
    go :: RenderInstruction -> IO ()
    go :: RenderInstruction -> IO ()
go (RenderText Text
t) = Handle -> Text -> IO ()
Text.hPutStr Handle
h Text
t
    go (RenderSGR [SGR]
s) = Handle -> [SGR] -> IO ()
ANSI.hSetSGR Handle
h [SGR]
s

-- | Render all modifiers as escape characters and return the
-- resulting text.  The text produced from this function is formatted
-- for output by Haskeline.
--
-- @since 1.0.0.0
renderText :: RenderMode -> Stylized Text -> Text
renderText :: RenderMode -> Stylized Text -> Text
renderText RenderMode
mode Stylized Text
stylized = (RenderInstruction -> Text) -> [RenderInstruction] -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RenderInstruction -> Text
go (RenderMode -> Stylized Text -> [RenderInstruction]
renderInstructions RenderMode
mode Stylized Text
stylized)
  where
    go :: RenderInstruction -> Text
    go :: RenderInstruction -> Text
go = \case
      RenderText Text
t -> Text
t
      RenderSGR [SGR]
s ->
        -- NOTE: The \STX character below is not a real terminal
        -- escape character.  Instead it is intercepted by Haskeline.
        -- See: https://github.com/judah/haskeline/wiki/ControlSequencesInPrompt
        String -> Text
forall a. ToText a => a -> Text
toText ([SGR] -> String
ANSI.setSGRCode [SGR]
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\STX"

-- | Internal function to turn stylized text into render instructions.
--
-- @since 1.0.0.0
renderInstructions :: RenderMode -> Stylized Text -> [RenderInstruction]
renderInstructions :: RenderMode -> Stylized Text -> [RenderInstruction]
renderInstructions RenderMode
mode = \case
  Stylized Modifier
m Text
t -> RenderMode -> (Text, Modifier) -> [RenderInstruction]
renderMod RenderMode
mode (Text
t, Modifier
m)
  StylizedMod Modifier
_ -> []
  StylizedList [Stylized Text]
xs -> (Stylized Text -> [RenderInstruction])
-> [Stylized Text] -> [RenderInstruction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RenderMode -> Stylized Text -> [RenderInstruction]
renderInstructions RenderMode
mode) [Stylized Text]
xs
  where
    renderMod :: RenderMode -> (Text, Modifier) -> [RenderInstruction]
    renderMod :: RenderMode -> (Text, Modifier) -> [RenderInstruction]
renderMod RenderMode
mode (Text
t, Modifier
m) =
      case RenderMode
mode of
        RenderMode
Plain ->
          -- Only render text, no modifiers.
          [Text -> RenderInstruction
RenderText Text
t]
        RenderMode
Simple ->
          -- Terminal supports basic 16 colors.
          let color :: ConsoleLayer -> Color -> SGR
color ConsoleLayer
l = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
l ColorIntensity
ANSI.Dull (Color -> SGR) -> (Color -> Color) -> Color -> SGR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Color
Color.colorAsANSI
           in Text
-> Modifier
-> (ConsoleLayer -> Color -> SGR)
-> [RenderInstruction]
renderToSGR Text
t Modifier
m ConsoleLayer -> Color -> SGR
color
        RenderMode
Term256 ->
          -- Terminal supports the 256-color palette.
          let color :: ConsoleLayer -> Color -> SGR
color ConsoleLayer
l = ConsoleLayer -> Word8 -> SGR
ANSI.SetPaletteColor ConsoleLayer
l (Word8 -> SGR) -> (Color -> Word8) -> Color -> SGR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Word8
Color.colorAsIndex256
           in Text
-> Modifier
-> (ConsoleLayer -> Color -> SGR)
-> [RenderInstruction]
renderToSGR Text
t Modifier
m ConsoleLayer -> Color -> SGR
color
        RenderMode
TermRGB ->
          -- Super terminal!
          let color :: ConsoleLayer -> Color -> SGR
color ConsoleLayer
l Color
c = case Color -> Either Color (Colour Float)
Color.colorAsRGB Color
c of
                Left Color
ac -> ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
l ColorIntensity
ANSI.Dull Color
ac
                Right Colour Float
rgb -> ConsoleLayer -> Colour Float -> SGR
ANSI.SetRGBColor ConsoleLayer
l Colour Float
rgb
           in Text
-> Modifier
-> (ConsoleLayer -> Color -> SGR)
-> [RenderInstruction]
renderToSGR Text
t Modifier
m ConsoleLayer -> Color -> SGR
color
    renderToSGR ::
      Text ->
      Modifier ->
      (ANSI.ConsoleLayer -> Color -> ANSI.SGR) ->
      [RenderInstruction]
    renderToSGR :: Text
-> Modifier
-> (ConsoleLayer -> Color -> SGR)
-> [RenderInstruction]
renderToSGR Text
t Modifier
m ConsoleLayer -> Color -> SGR
f =
      [ [SGR] -> RenderInstruction
RenderSGR (Modifier -> (ConsoleLayer -> Color -> SGR) -> [SGR]
modToSGR Modifier
m ConsoleLayer -> Color -> SGR
f),
        Text -> RenderInstruction
RenderText Text
t,
        [SGR] -> RenderInstruction
RenderSGR [SGR
ANSI.Reset]
      ]

-- | Convert a modifier into a series of ANSI.SGR codes.
--
-- @since 1.0.0.0
modToSGR ::
  -- | The modifier to render as an SGR code.
  Modifier ->
  -- | A function that knows how to render colors.
  (ANSI.ConsoleLayer -> Color -> ANSI.SGR) ->
  -- | The resulting SGR codes.
  [ANSI.SGR]
modToSGR :: Modifier -> (ConsoleLayer -> Color -> SGR) -> [SGR]
modToSGR Modifier
mod ConsoleLayer -> Color -> SGR
colorF =
  [Maybe SGR] -> [SGR]
forall a. [Maybe a] -> [a]
catMaybes
    [ ConsoleLayer -> Color -> SGR
colorF ConsoleLayer
ANSI.Foreground (Color -> SGR) -> Maybe Color -> Maybe SGR
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Modifier -> OnlyOne Color) -> Maybe Color
getColor Modifier -> OnlyOne Color
modColorFG,
      ConsoleLayer -> Color -> SGR
colorF ConsoleLayer
ANSI.Background (Color -> SGR) -> Maybe Color -> Maybe SGR
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Modifier -> OnlyOne Color) -> Maybe Color
getColor Modifier -> OnlyOne Color
modColorBG,
      ConsoleIntensity -> SGR
ANSI.SetConsoleIntensity (ConsoleIntensity -> SGR) -> Maybe ConsoleIntensity -> Maybe SGR
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ConsoleIntensity
getIntensity,
      Underlining -> SGR
ANSI.SetUnderlining (Underlining -> SGR) -> Maybe Underlining -> Maybe SGR
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Underlining
getUnderlining,
      Bool -> SGR
ANSI.SetSwapForegroundBackground (Bool -> SGR) -> Maybe Bool -> Maybe SGR
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
getSwapForegroundBackground
    ]
  where
    getColor :: (Modifier -> OnlyOne Color) -> Maybe Color
    getColor :: (Modifier -> OnlyOne Color) -> Maybe Color
getColor Modifier -> OnlyOne Color
f = OnlyOne Color -> Maybe Color
forall a. OnlyOne a -> Maybe a
unOne (Modifier -> OnlyOne Color
f Modifier
mod)
    getIntensity :: Maybe ANSI.ConsoleIntensity
    getIntensity :: Maybe ConsoleIntensity
getIntensity = case Modifier -> Status
modBold Modifier
mod of
      Status
Off -> Maybe ConsoleIntensity
forall a. Maybe a
Nothing
      Status
On -> ConsoleIntensity -> Maybe ConsoleIntensity
forall a. a -> Maybe a
Just ConsoleIntensity
ANSI.BoldIntensity
    getUnderlining :: Maybe ANSI.Underlining
    getUnderlining :: Maybe Underlining
getUnderlining = case Modifier -> Status
modUnderline Modifier
mod of
      Status
Off -> Maybe Underlining
forall a. Maybe a
Nothing
      Status
On -> Underlining -> Maybe Underlining
forall a. a -> Maybe a
Just Underlining
ANSI.SingleUnderline
    getSwapForegroundBackground :: Maybe Bool
    getSwapForegroundBackground :: Maybe Bool
getSwapForegroundBackground = case Modifier -> Status
modSwapFgBg Modifier
mod of
      Status
Off -> Maybe Bool
forall a. Maybe a
Nothing
      Status
On -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True