module Text.Chatty.Extended.HTML where
import Text.Chatty.Printer
import Text.Chatty.Extended.Printer
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
newtype HtmlPrinterT m a = HtmlPrinter { runHtmlPrinterT :: m a }
instance Monad m => Monad (HtmlPrinterT m) where
return = HtmlPrinter . return
(HtmlPrinter p) >>= f = HtmlPrinter $ do p' <- p; runHtmlPrinterT (f p')
instance MonadTrans HtmlPrinterT where
lift = HtmlPrinter
instance Functor m => Functor (HtmlPrinterT m) where
fmap f (HtmlPrinter p) = HtmlPrinter $ fmap f p
instance MonadIO m => MonadIO (HtmlPrinterT m) where
liftIO = lift . liftIO
instance MonadPrinter m => MonadPrinter (HtmlPrinterT m) where
mprint = lift . mprint . concatMap maskHtml
mnoecho = lift . mnoecho . concatMap maskHtml
mflush = lift mflush
instance MonadPrinter m => ExtendedPrinter (HtmlPrinterT m) where
estart c = lift $ mprint $ concat [""]
efin = lift $ mprint ""
maskHtml :: Char -> String
maskHtml '&' = "&"
maskHtml '<' = "<"
maskHtml '>' = ">"
maskHtml ' ' = " "
maskHtml c = [c]
hexColour (Dull Green) = "004400"
hexColour (Vivid Green) = "00FF00"
hexColour (Dull Red) = "440000"
hexColour (Vivid Red) = "FF0000"
hexColour (Dull Yellow) = "444400"
hexColour (Vivid Yellow) = "FFFF00"
hexColour (Dull Blue) = "000044"
hexColour (Vivid Blue) = "0000FF"
hexColour (Dull Black) = "000000"
hexColour (Vivid Black) = "444444"
hexColour (Dull White) = "888888"
hexColour (Vivid White) = "FFFFFF"
hexColour (Dull Cyan) = "004444"
hexColour (Vivid Cyan) = "00FFFF"
hexColour (Dull Magenta) = "440044"
hexColour (Vivid Magenta) = "FF00FF"