module Language.Haskell.HsColour.InlineCSS (hscolour,top'n'tail) where
import Language.Haskell.HsColour.Anchors
import Language.Haskell.HsColour.Classify as Classify
import Language.Haskell.HsColour.Colourise
import Language.Haskell.HsColour.HTML (renderAnchors, renderComment,
renderNewLinesAnchors, escape)
import Text.Printf
hscolour :: ColourPrefs
-> Bool
-> Int
-> String
-> String
hscolour :: ColourPrefs -> Bool -> Int -> String -> String
hscolour ColourPrefs
prefs Bool
anchor Int
n =
String -> String
pre
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
anchor
then Int -> String -> String
renderNewLinesAnchors Int
n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. (a -> String) -> Either String a -> String
renderAnchors (ColourPrefs -> (TokenType, String) -> String
renderToken ColourPrefs
prefs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TokenType, String)] -> [Either String (TokenType, String)]
insertAnchors
else forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ColourPrefs -> (TokenType, String) -> String
renderToken ColourPrefs
prefs))
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 forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++String
cssSuffix)
pre :: String -> String
pre :: String -> String
pre = (String
"<pre style=\"font-family:Consolas, Monaco, Monospace;\">"forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++String
"</pre>")
renderToken :: ColourPrefs -> (TokenType,String) -> String
renderToken :: ColourPrefs -> (TokenType, String) -> String
renderToken ColourPrefs
prefs (TokenType
cls,String
text) =
[Highlight] -> String -> String
stylise (ColourPrefs -> TokenType -> [Highlight]
colourise ColourPrefs
prefs TokenType
cls) forall a b. (a -> b) -> a -> b
$
if TokenType
cls forall a. Eq a => a -> a -> Bool
== TokenType
Comment then String -> String
renderComment String
text else String -> String
escape String
text
stylise :: [Highlight] -> String -> String
stylise :: [Highlight] -> String -> String
stylise [Highlight]
hs String
s = String
"<span style=\"" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Highlight -> String
style [Highlight]
hs forall a. [a] -> [a] -> [a]
++ String
"\">" forall a. [a] -> [a] -> [a]
++String
sforall a. [a] -> [a] -> [a]
++ String
"</span>"
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>"forall a. [a] -> [a] -> [a]
++String
titleforall a. [a] -> [a] -> [a]
++String
"</title>"
,String
"</head>"
,String
"<body style=\"background-color: #131313; color: #ffffff;\">"
]
cssSuffix :: String
cssSuffix = [String] -> String
unlines
[String
"</body>"
,String
"</html>"
]
style :: Highlight -> String
style :: Highlight -> String
style Highlight
Normal = String
""
style Highlight
Bold = String
"font-weight: bold;"
style Highlight
Dim = String
"font-weight: lighter;"
style Highlight
Underscore = String
"text-decoration: underline;"
style Highlight
Blink = String
"text-decoration: blink;"
style Highlight
ReverseVideo = String
""
style Highlight
Concealed = String
"text-decoration: line-through;"
style (Foreground Colour
c) = String
"color: "forall a. [a] -> [a] -> [a]
++Colour -> String
csscolour Colour
cforall a. [a] -> [a] -> [a]
++String
";"
style (Background Colour
c) = String
"background-color: "forall a. [a] -> [a] -> [a]
++Colour -> String
csscolour Colour
cforall a. [a] -> [a] -> [a]
++String
";"
style Highlight
Italic = String
"font-style: italic;"
csscolour :: Colour -> String
csscolour :: Colour -> String
csscolour Colour
Black = String
"#000000"
csscolour Colour
Red = String
"#ff0000"
csscolour Colour
Green = String
"#00ff00"
csscolour Colour
Yellow = String
"#ffff00"
csscolour Colour
Blue = String
"#0000ff"
csscolour Colour
Magenta = String
"#ff00ff"
csscolour Colour
Cyan = String
"#00ffff"
csscolour Colour
White = String
"#ffffff"
csscolour (Rgb Word8
r Word8
g Word8
b) = forall r. PrintfType r => String -> r
printf String
"#%02x%02x%02x" Word8
r Word8
g Word8
b