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)
hscolour :: Bool
-> Int
-> String
-> String
hscolour :: Bool -> Int -> String -> String
hscolour Bool
anchor Int
n =
String -> String
pre
(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
anchor
then Int -> String -> String
renderNewLinesAnchors Int
n
(String -> String)
-> ([(TokenType, String)] -> String)
-> [(TokenType, String)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String (TokenType, String) -> String)
-> [Either String (TokenType, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((TokenType, String) -> String)
-> Either String (TokenType, String) -> String
forall a. (a -> String) -> Either String a -> String
renderAnchors (TokenType, String) -> String
renderToken)
([Either String (TokenType, String)] -> String)
-> ([(TokenType, String)] -> [Either String (TokenType, String)])
-> [(TokenType, String)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TokenType, String)] -> [Either String (TokenType, String)]
insertAnchors
else ((TokenType, String) -> String) -> [(TokenType, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TokenType, String) -> String
renderToken)
([(TokenType, String)] -> String)
-> (String -> [(TokenType, String)]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(TokenType, String)]
tokenise
top'n'tail :: String -> String -> String
top'n'tail :: String -> String -> String
top'n'tail String
title = (String -> String
cssPrefix String
title String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cssSuffix)
pre :: String -> String
pre :: String -> String
pre = (String
"<pre>"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"</pre>")
renderToken :: (TokenType,String) -> String
renderToken :: (TokenType, String) -> String
renderToken (TokenType
cls,String
text) =
String
before String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if TokenType
cls TokenType -> TokenType -> Bool
forall a. Eq a => a -> a -> Bool
== TokenType
Comment then String -> String
renderComment String
text else String -> String
escape String
text) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
after
where
before :: String
before = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cls2 then String
"" else String
"<span class='" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cls2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'>"
after :: String
after = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cls2 then String
"" else String
"</span>"
cls2 :: String
cls2 = TokenType -> String
cssClass TokenType
cls
cssClass :: TokenType -> String
cssClass TokenType
Keyword = String
"hs-keyword"
cssClass TokenType
Keyglyph = String
"hs-keyglyph"
cssClass TokenType
Layout = String
"hs-layout"
cssClass TokenType
Comment = String
"hs-comment"
cssClass TokenType
Conid = String
"hs-conid"
cssClass TokenType
Varid = String
"hs-varid"
cssClass TokenType
Conop = String
"hs-conop"
cssClass TokenType
Varop = String
"hs-varop"
cssClass TokenType
String = String
"hs-str"
cssClass TokenType
Char = String
"hs-chr"
cssClass TokenType
Number = String
"hs-num"
cssClass TokenType
Cpp = String
"hs-cpp"
cssClass TokenType
Error = String
"hs-sel"
cssClass TokenType
Definition = String
"hs-definition"
cssClass TokenType
_ = String
""
cssPrefix :: String -> String
cssPrefix String
title = [String] -> String
unlines
[String
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
,String
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
,String
"<html>"
,String
"<head>"
,String
"<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->"
,String
"<title>"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
titleString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"</title>"
,String
"<link type='text/css' rel='stylesheet' href='hscolour.css' />"
,String
"</head>"
,String
"<body>"
]
cssSuffix :: String
cssSuffix = [String] -> String
unlines
[String
"</body>"
,String
"</html>"
]