module HsColour ( cssColourise ) where
import ANSI
import Colourise
--import System
{-
import IO (hFlush,stdout)
main = do
p <- System.getProgName
a <- System.getArgs
pref <- readColourPrefs
case a of
[] -> help p
["-h"] -> help p
["-help"] -> help p
["-tty"] -> Prelude.interact (tty pref)
["-html"] -> Prelude.interact (html pref)
["-css"] -> Prelude.interact css
[a] -> do readFile a >>= putStr . tty pref
["-tty",a] -> do readFile a >>= putStr . tty pref
["-html",a] -> do readFile a >>= putStr . html pref
["-css",a] -> do readFile a >>= putStr . css
_ -> help p
hFlush stdout
where
tty pref = concat . map renderTTY . colourise pref
html pref = ("
"++) . (++"
")
. concat . map renderHTML . colourise pref
help p = error ("Usage: "++p++" [-tty|-html|-css] [file.hs]")
-}
-- cssColourise = {- (cssPrefix++) . (++cssSuffix) . -}
cssColourise str = concatMap renderCSS $ colourise cssPref str
renderTTY :: (String,[Highlight]) -> String
renderTTY (s,h) = highlight h s
renderHTML :: (String,[Highlight]) -> String
renderHTML (s,h) = fontify h (escape s)
-- Html stuff
fontify [] s = s
fontify (h:hs) s = font h (fontify hs s)
font Normal s = s
font Bold s = ""++s++""
font Dim s = ""++s++""
font Underscore s = ""++s++""
font Blink s = ""
font ReverseVideo s = s
font Concealed s = s
font (Foreground c) s = ""++s++""
font (Background c) s = ""++s++""
escape ('<':cs) = "<"++escape cs
escape ('>':cs) = ">"++escape cs
escape ('&':cs) = "&"++escape cs
escape (c:cs) = c: escape cs
escape [] = []
-- CSS stuff
cssPref = ColourPrefs
{ keyword = [Note "keyword"]
, keyglyph = [Note "keyglyph"]
, layout = [Note "layout"]
, comment = [Note "comment"]
, conid = [Note "conid"]
, varid = [Note "varid"]
, variddecl= [Note "variddecl"]
, conop = [Note "conop"]
, varop = [Note "varop"]
, string = [Note "str"]
, char = [Note "chr"]
, number = [Note "num"]
, selection = [Note "sel"]
, variantselection = [Note "varsel"]
}
renderCSS :: (String,[Highlight]) -> String
renderCSS ('\n':text, [Note cls]) = "\n" ++ escape text ++ "" --move initial newlines out of span
renderCSS (text,[Note cls]) = "" ++ escape text ++ ""
renderCSS (text,[Normal]) = escape text
cssPrefix = "