-- | Formats Haskell source code as HTML with CSS.
module Language.Haskell.HsColour.CSS (hscolour) where
import Language.Haskell.HsColour.Anchors
import Language.Haskell.HsColour.Classify as Classify
import Language.Haskell.HsColour.HTML (renderAnchors, renderComment,
renderNewLinesAnchors, escape)
-- | Formats Haskell source code as a complete HTML document with CSS.
hscolour :: Bool -- ^ Whether to include anchors.
-> Bool -- ^ Whether output should be partial
-- (= no stylesheet link will be included.)
-> String -- ^ Haskell source code.
-> String -- ^ An HTML document containing the coloured
-- Haskell source code.
hscolour anchor partial =
(if partial then id else top'n'tail)
. pre
. (if anchor
then renderNewLinesAnchors
. concatMap (renderAnchors renderToken)
. insertAnchors
else concatMap renderToken)
. tokenise
top'n'tail :: String -> String
top'n'tail = (cssPrefix++) . (++cssSuffix)
pre :: String -> String
pre = (""++) . (++"
")
renderToken :: (TokenType,String) -> String
renderToken (cls,text) =
before ++ (if cls == Comment then renderComment text else escape text) ++ after
where
before = if null cls2 then "" else ""
after = if null cls2 then "" else ""
cls2 = cssClass cls
cssClass Keyword = "keyword"
cssClass Keyglyph = "keyglyph"
cssClass Layout = "layout"
cssClass Comment = "comment"
cssClass Conid = "conid"
cssClass Varid = "varid"
cssClass Conop = "conop"
cssClass Varop = "varop"
cssClass String = "str"
cssClass Char = "chr"
cssClass Number = "num"
cssClass Cpp = "cpp"
cssClass Error = "sel"
cssClass Definition = "definition"
cssClass _ = ""
cssPrefix = unlines
[""
,""
,""
,""
,"Haskell Code by HsColour"
,""
,""
,""
]
cssSuffix = unlines
[""
,""
]