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 prefs :: ColourPrefs
prefs anchor :: Bool
anchor n :: 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 (ColourPrefs -> (TokenType, String) -> String
renderToken ColourPrefs
prefs))
([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 (ColourPrefs -> (TokenType, String) -> String
renderToken ColourPrefs
prefs))
([(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 title :: 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 = ("<pre style=\"font-family:Consolas, Monaco, Monospace;\">"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]
++"</pre>")
renderToken :: ColourPrefs -> (TokenType,String) -> String
renderToken :: ColourPrefs -> (TokenType, String) -> String
renderToken prefs :: ColourPrefs
prefs (cls :: TokenType
cls,text :: String
text) =
[Highlight] -> String -> String
stylise (ColourPrefs -> TokenType -> [Highlight]
colourise ColourPrefs
prefs TokenType
cls) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
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
stylise :: [Highlight] -> String -> String
stylise :: [Highlight] -> String -> String
stylise hs :: [Highlight]
hs s :: String
s = "<span style=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Highlight -> String) -> [Highlight] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Highlight -> String
style [Highlight]
hs String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\">" String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++ "</span>"
cssPrefix :: String -> String
cssPrefix title :: String
title = [String] -> String
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>"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
titleString -> String -> String
forall a. [a] -> [a] -> [a]
++"</title>"
,"</head>"
,"<body style=\"background-color: #131313; color: #ffffff;\">"
]
cssSuffix :: String
cssSuffix = [String] -> String
unlines
["</body>"
,"</html>"
]
style :: Highlight -> String
style :: Highlight -> String
style Normal = ""
style Bold = "font-weight: bold;"
style Dim = "font-weight: lighter;"
style Underscore = "text-decoration: underline;"
style Blink = "text-decoration: blink;"
style ReverseVideo = ""
style Concealed = "text-decoration: line-through;"
style (Foreground c :: Colour
c) = "color: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Colour -> String
csscolour Colour
cString -> String -> String
forall a. [a] -> [a] -> [a]
++";"
style (Background c :: Colour
c) = "background-color: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Colour -> String
csscolour Colour
cString -> String -> String
forall a. [a] -> [a] -> [a]
++";"
style Italic = "font-style: italic;"
csscolour :: Colour -> String
csscolour :: Colour -> String
csscolour Black = "#000000"
csscolour Red = "#ff0000"
csscolour Green = "#00ff00"
csscolour Yellow = "#ffff00"
csscolour Blue = "#0000ff"
csscolour Magenta = "#ff00ff"
csscolour Cyan = "#00ffff"
csscolour White = "#ffffff"
csscolour (Rgb r :: Word8
r g :: Word8
g b :: Word8
b) = String -> Word8 -> Word8 -> Word8 -> String
forall r. PrintfType r => String -> r
printf "#%02x%02x%02x" Word8
r Word8
g Word8
b