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
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)]
mkColourInt (Dull _) = A.Dull
mkColourInt (Vivid _) = A.Vivid
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