-- | Provides an 'ExtendedPrinter' that handles colours using HTML output.
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

-- | An 'ExtendedPrinter' for HTML output.
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 ["<span style=\"color: #", hexColour c, ";\">"]
  efin = lift $ mprint "</span>"

-- | Convert the given character to its HTML representation.
maskHtml :: Char -> String
maskHtml '&' = "&amp;"
maskHtml '<' = "&lt;"
maskHtml '>' = "&gt;"
maskHtml ' ' = "&nbsp;"
maskHtml c = [c]

-- | Convert the given colour to its CSS representation.
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"