1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
-- | 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.
-> Int -- ^ Starting line number (for line anchors).
-> String -- ^ Haskell source code.
-> String -- ^ An HTML document containing the coloured
-- Haskell source code.
hscolour anchor n =
pre
. (if anchor
then renderNewLinesAnchors n
. concatMap (renderAnchors renderToken)
. insertAnchors
else concatMap renderToken)
. tokenise
top'n'tail :: String -> String -> String
top'n'tail title = (cssPrefix title ++) . (++cssSuffix)
pre :: String -> String
pre = ("<pre>"++) . (++"</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 "<span class='" ++ cls2 ++ "'>"
after = if null cls2 then "" else "</span>"
cls2 = cssClass cls
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 title = unlines
["<?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>"++title++"</title>"
,"<link type='text/css' rel='stylesheet' href='hscolour.css' />"
,"</head>"
,"<body>"
]
cssSuffix = unlines
["</body>"
,"</html>"
]
|
