-- | Provides an ExtendedPrinter that handles colours using standardized ANSI codes.
module Text.Chatty.Extended.ANSI where

import qualified System.Console.ANSI as A
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Text.Chatty.Printer
import Text.Chatty.Extended.Printer

-- | An ExtendedPrinter that uses ANSI colour codes.
newtype AnsiPrinterT m a = AnsiPrinter { runAnsiPrinterT :: Colour -> m a }

instance Monad m => Monad (AnsiPrinterT m) where
  return a = AnsiPrinter $ \s -> return a
  (AnsiPrinter p) >>= f = AnsiPrinter $ \s -> do a <- p s; runAnsiPrinterT (f a) s

instance MonadTrans AnsiPrinterT where
  lift m = AnsiPrinter $ return m

instance Monad m => Functor (AnsiPrinterT m) where
  fmap f a = AnsiPrinter $ \s -> do a' <- runAnsiPrinterT a s; return (f a')

instance MonadIO m => MonadIO (AnsiPrinterT m) where
  liftIO = lift . liftIO

instance MonadPrinter m => MonadPrinter (AnsiPrinterT m) where
  mprint = lift . mprint
  mnoecho = lift . mnoecho
  mflush = lift mflush

instance MonadPrinter m => ExtendedPrinter (AnsiPrinterT m) where
  estart c = AnsiPrinter $ \c1 -> mprint $ A.setSGRCode [A.SetColor A.Foreground (mkColourInt c) (mkColourCode c)]
  efin = AnsiPrinter $ \c1 -> mprint $ A.setSGRCode [A.SetColor A.Foreground (mkColourInt c1) (mkColourCode c1)]

-- | Convert Chatty's colour intensity to ansi-terminal's one
mkColourInt (Dull _) = A.Dull
mkColourInt (Vivid _) = A.Vivid

-- | Convert Chatty's colour tone to ansi-terminal's one
mkColourCode (Dull c) = mkColourCode (Vivid c)
mkColourCode (Vivid c) = case c of
  Green -> A.Green
  Red -> A.Red
  Yellow -> A.Yellow
  Blue -> A.Blue
  Black -> A.Black
  White -> A.White
  Cyan -> A.Cyan
  Magenta -> A.Magenta