Language/Haskell/HsColour/CSS.hs

-- | Formats Haskell source code as HTML with CSS.
module Language.Haskell.HsColour.CSS 
  ( hscolour
  , top'n'tail
  , renderToken 
  , pre 
  ) 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.
         -> String -- ^ Haskell source code.
         -> String -- ^ An HTML document containing the coloured 
                   --   Haskell source code.
hscolour :: Bool -> String -> Stringhscolour anchor :: Boolanchor =
  pre :: String -> Stringpre
  (.) :: (b -> c) -> (a -> b) -> a -> c. (if anchor :: Boolanchor 
        then renderNewLinesAnchors :: String -> StringrenderNewLinesAnchors
             (.) :: (b -> c) -> (a -> b) -> a -> c. concatMap :: (a -> [b]) -> [a] -> [b]concatMap (renderAnchors :: (a -> String) -> Either String a -> StringrenderAnchors renderToken :: (TokenType, String) -> StringrenderToken)
             (.) :: (b -> c) -> (a -> b) -> a -> c. insertAnchors ::
  [(TokenType, String)] -> [Either Anchor (TokenType, String)]insertAnchors
        else concatMap :: (a -> [b]) -> [a] -> [b]concatMap renderToken :: (TokenType, String) -> StringrenderToken)
  (.) :: (b -> c) -> (a -> b) -> a -> c. tokenise :: String -> [(TokenType, String)]tokenise

top'n'tail :: String -> String -> String
top'n'tail :: String -> String -> Stringtop'n'tail title :: Stringtitle  = (cssPrefix :: [Char] -> StringcssPrefix title :: Stringtitle (++) :: [a] -> [a] -> [a]++) (.) :: (b -> c) -> (a -> b) -> a -> c. ((++) :: [a] -> [a] -> [a]++cssSuffix :: StringcssSuffix)

pre :: String -> String
pre :: String -> Stringpre = ("<pre>"(++) :: [a] -> [a] -> [a]++) (.) :: (b -> c) -> (a -> b) -> a -> c. ((++) :: [a] -> [a] -> [a]++"</pre>")

renderToken :: (TokenType,String) -> String
renderToken :: (TokenType, String) -> StringrenderToken (cls :: TokenTypecls,text :: Stringtext) =
        before :: [Char]before (++) :: [a] -> [a] -> [a]++ (if cls :: TokenTypecls (==) :: Eq a => a -> a -> Bool== Comment :: TokenTypeComment then renderComment :: String -> StringrenderComment text :: Stringtext else escape :: String -> Stringescape text :: Stringtext) (++) :: [a] -> [a] -> [a]++ after :: [Char]after
    where
        before :: [Char]before = if null :: [a] -> Boolnull cls2 :: [Char]cls2 then "" else "<span class='" (++) :: [a] -> [a] -> [a]++ cls2 :: [Char]cls2 (++) :: [a] -> [a] -> [a]++ "'>"
        after :: [Char]after  = if null :: [a] -> Boolnull cls2 :: [Char]cls2 then "" else "</span>"
        cls2 :: [Char]cls2 = cssClass :: TokenType -> [Char]cssClass cls :: TokenTypecls


cssClass :: TokenType -> [Char]cssClass Keyword  = "hs-keyword"
cssClass Keyglyph = "hs-keyglyph"
cssClass Layout   = "hs-layout"
cssClass Comment  = "hs-comment"
cssClass Conid    = "hs-conid"
cssClass Varid    = "hs-varid"
cssClass Conop    = "hs-conop"
cssClass Varop    = "hs-varop"
cssClass String   = "hs-str"
cssClass Char     = "hs-chr"
cssClass Number   = "hs-num"
cssClass Cpp      = "hs-cpp"
cssClass Error    = "hs-sel"
cssClass Definition = "hs-definition"
cssClass _        = ""


cssPrefix :: [Char] -> StringcssPrefix title :: [Char]title = unlines :: [String] -> Stringunlines
    ["<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
    ,"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
    ,"<html>"
    ,"<head>"
    ,"<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->"
    ,"<title>"(++) :: [a] -> [a] -> [a]++title :: Stringtitle(++) :: [a] -> [a] -> [a]++"</title>"
    ,"<link type='text/css' rel='stylesheet' href='hscolour.css' />"
    ,"</head>"
    ,"<body>"
    ]
    
cssSuffix :: StringcssSuffix = unlines :: [String] -> Stringunlines
    ["</body>"
    ,"</html>"
    ]