{-# LANGUAGE LambdaCase #-}
{-|
Module      : Colog.Polysemy.Formatting.Color
Description : Terminal colour support for log messages.
-}
module Colog.Polysemy.Formatting.Color
  ( Color(..)
  , UseColor(..)
  , termColorSupport
  , getWithFG
  ) where

import qualified Data.Text.Lazy.Builder as TLB
import System.Console.ANSI
       ( Color(..)
       , ColorIntensity(Vivid)
       , ConsoleLayer(Foreground)
       , SGR(..)
       , hSupportsANSIColor
       , setSGRCode
       )
import System.IO (Handle)
import Formatting

-- | A 'Bool'-isomorphic type for expressing whether output should use color or not.
data UseColor = DoUseColor | DontUseColor

-- | Detect whether the terminal at the given handle (e.g. @stdout@) supports color output.
termColorSupport :: Handle -> IO UseColor
termColorSupport :: Handle -> IO UseColor
termColorSupport Handle
h =
  Handle -> IO Bool
hSupportsANSIColor Handle
h IO Bool -> (Bool -> IO UseColor) -> IO UseColor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> UseColor -> IO UseColor
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseColor
DoUseColor
    Bool
False -> UseColor -> IO UseColor
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseColor
DontUseColor

-- | Generate a function for setting the foreground color.
getWithFG
  :: UseColor -- ^ Whether to actually use color, or ignore any given color.
  -> Color -- ^ The color to set the foreground text to
  -> TLB.Builder -> TLB.Builder
getWithFG :: UseColor -> Color -> Builder -> Builder
getWithFG UseColor
DontUseColor Color
_ Builder
txt = Builder
txt
getWithFG UseColor
DoUseColor Color
color Builder
txt =
  Format Builder (String -> Builder -> String -> Builder)
-> String -> Builder -> String -> Builder
forall a. Format Builder a -> a
bformat (Format
  (Builder -> String -> Builder)
  (String -> Builder -> String -> Builder)
forall r. Format r (String -> r)
string Format
  (Builder -> String -> Builder)
  (String -> Builder -> String -> Builder)
-> Format Builder (Builder -> String -> Builder)
-> Format Builder (String -> Builder -> String -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (String -> Builder) (Builder -> String -> Builder)
forall r. Format r (Builder -> r)
builder Format (String -> Builder) (Builder -> String -> Builder)
-> Format Builder (String -> Builder)
-> Format Builder (Builder -> String -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (String -> Builder)
forall r. Format r (String -> r)
string)
    ([SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
color])
    Builder
txt
    ([SGR] -> String
setSGRCode [SGR
Reset])