module Language.Haskell.HsColour.HTML
( hscolour
, top'n'tail
, renderAnchors, renderComment, renderNewLinesAnchors, escape
) where
import Language.Haskell.HsColour.Anchors
import Language.Haskell.HsColour.Classify as Classify
import Language.Haskell.HsColour.Colourise
import Char(isAlphaNum)
import Text.Printf
hscolour :: ColourPrefs
-> Bool
-> String
-> String
hscolour :: ColourPrefs -> Bool -> String -> Stringhscolour pref :: ColourPrefspref 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 :: ColourPrefs -> (TokenType, String) -> StringrenderToken pref :: ColourPrefspref))
(.) :: (b -> c) -> (a -> b) -> a -> c. insertAnchors ::
[(TokenType, String)] -> [Either Anchor (TokenType, String)]insertAnchors
else concatMap :: (a -> [b]) -> [a] -> [b]concatMap (renderToken :: ColourPrefs -> (TokenType, String) -> StringrenderToken pref :: ColourPrefspref))
(.) :: (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 = (htmlHeader :: String -> StringhtmlHeader title :: Stringtitle (++) :: [a] -> [a] -> [a]++) (.) :: (b -> c) -> (a -> b) -> a -> c. ((++) :: [a] -> [a] -> [a]++htmlClose :: StringhtmlClose)
pre :: String -> String
pre :: String -> Stringpre = ("<pre>"(++) :: [a] -> [a] -> [a]++) (.) :: (b -> c) -> (a -> b) -> a -> c. ((++) :: [a] -> [a] -> [a]++"</pre>")
renderToken :: ColourPrefs -> (TokenType,String) -> String
renderToken :: ColourPrefs -> (TokenType, String) -> StringrenderToken pref :: ColourPrefspref (t :: TokenTypet,s :: Strings) = fontify :: [Highlight] -> String -> Stringfontify (colourise :: ColourPrefs -> TokenType -> [Highlight]colourise pref :: ColourPrefspref t :: TokenTypet)
(if t :: TokenTypet (==) :: Eq a => a -> a -> Bool== Comment :: TokenTypeComment then renderComment :: String -> StringrenderComment s :: Strings else escape :: String -> Stringescape s :: Strings)
renderAnchors :: (a -> String) -> Either String a -> String
renderAnchors :: (a -> String) -> Either String a -> StringrenderAnchors _ (Left v :: Stringv) = "<a name=\""(++) :: [a] -> [a] -> [a]++v :: Stringv(++) :: [a] -> [a] -> [a]++"\"></a>"
renderAnchors render :: a -> Stringrender (Right r :: ar) = render :: a -> Stringrender r :: ar
renderComment :: String -> String
renderComment :: String -> StringrenderComment xs :: Stringxs@('h':'t':'t':'p':':':'/':'/':_) =
renderLink :: [Char] -> [Char]renderLink a :: [Char]a (++) :: [a] -> [a] -> [a]++ renderComment :: String -> StringrenderComment b :: [Char]b
where
isUrlChar :: Char -> BoolisUrlChar x :: Charx = isAlphaNum :: Char -> BoolisAlphaNum x :: Charx (||) :: Bool -> Bool -> Bool|| x :: Charx elem :: Eq a => a -> [a] -> Bool`elem` ":/?#[]@!$&'()*+,;=-._~%"
(a :: [Char]a,b :: [Char]b) = span :: (a -> Bool) -> [a] -> ([a], [a])span isUrlChar :: Char -> BoolisUrlChar xs :: [Char]xs
renderLink :: [Char] -> [Char]renderLink link :: [Char]link = "<a href=\"" (++) :: [a] -> [a] -> [a]++ link :: [Char]link (++) :: [a] -> [a] -> [a]++ "\">" (++) :: [a] -> [a] -> [a]++ escape :: String -> Stringescape link :: [Char]link (++) :: [a] -> [a] -> [a]++ "</a>"
renderComment (x :: Charx:xs :: [Char]xs) = escape :: String -> Stringescape [x :: Charx] (++) :: [a] -> [a] -> [a]++ renderComment :: String -> StringrenderComment xs :: [Char]xs
renderComment [] = [] :: [a][]
renderNewLinesAnchors :: String -> String
renderNewLinesAnchors :: String -> StringrenderNewLinesAnchors = unlines :: [String] -> Stringunlines (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map render :: a -> Stringrender (.) :: (b -> c) -> (a -> b) -> a -> c. zip :: [a] -> [b] -> [(a, b)]zip [1..] (.) :: (b -> c) -> (a -> b) -> a -> c. lines :: String -> [String]lines
where render :: Show a => (a, [Char]) -> [Char]render (line :: aline, s :: [Char]s) = "<a name=\"line-" (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow line :: aline (++) :: [a] -> [a] -> [a]++ "\"></a>" (++) :: [a] -> [a] -> [a]++ s :: Strings
fontify :: [Highlight] -> String -> String
fontify :: [Highlight] -> String -> Stringfontify [] s :: Strings = s :: Strings
fontify (h :: Highlighth:hs :: [Highlight]hs) s :: Strings = font :: Highlight -> String -> Stringfont h :: Highlighth (fontify :: [Highlight] -> String -> Stringfontify hs :: [Highlight]hs s :: Strings)
font :: Highlight -> String -> String
font :: Highlight -> String -> Stringfont Normal s :: Strings = s :: Strings
font Bold s :: Strings = "<b>"(++) :: [a] -> [a] -> [a]++s :: Strings(++) :: [a] -> [a] -> [a]++"</b>"
font Dim s :: Strings = "<em>"(++) :: [a] -> [a] -> [a]++s :: Strings(++) :: [a] -> [a] -> [a]++"</em>"
font Underscore s :: Strings = "<u>"(++) :: [a] -> [a] -> [a]++s :: Strings(++) :: [a] -> [a] -> [a]++"</u>"
font Blink s :: Strings = "<blink>"(++) :: [a] -> [a] -> [a]++s :: Strings(++) :: [a] -> [a] -> [a]++"</blink>"
font ReverseVideo s :: Strings = s :: Strings
font Concealed s :: Strings = s :: Strings
font (Foreground (Rgb r :: Word8r g :: Word8g b :: Word8b)) s :: Strings = printf :: PrintfType r => String -> rprintf "<font color=\"#%02x%02x%02x\">%s</font>" r :: ar g :: Word8g b :: [Char]b s :: Strings
font (Background (Rgb r :: Word8r g :: Word8g b :: Word8b)) s :: Strings = printf :: PrintfType r => String -> rprintf "<font bgcolor=\"#%02x%02x%02x\">%s</font>" r :: ar g :: Word8g b :: [Char]b s :: Strings
font (Foreground c :: Colourc) s :: Strings = "<font color="(++) :: [a] -> [a] -> [a]++show :: Show a => a -> Stringshow c :: Colourc(++) :: [a] -> [a] -> [a]++">"(++) :: [a] -> [a] -> [a]++s :: Strings(++) :: [a] -> [a] -> [a]++"</font>"
font (Background c :: Colourc) s :: Strings = "<font bgcolor="(++) :: [a] -> [a] -> [a]++show :: Show a => a -> Stringshow c :: Colourc(++) :: [a] -> [a] -> [a]++">"(++) :: [a] -> [a] -> [a]++s :: Strings(++) :: [a] -> [a] -> [a]++"</font>"
font Italic s :: Strings = "<i>"(++) :: [a] -> [a] -> [a]++s :: Strings(++) :: [a] -> [a] -> [a]++"</i>"
escape :: String -> String
escape :: String -> Stringescape ('<':cs :: [Char]cs) = "<"(++) :: [a] -> [a] -> [a]++escape :: String -> Stringescape cs :: [Char]cs
escape ('>':cs :: [Char]cs) = ">"(++) :: [a] -> [a] -> [a]++escape :: String -> Stringescape cs :: [Char]cs
escape ('&':cs :: [Char]cs) = "&"(++) :: [a] -> [a] -> [a]++escape :: String -> Stringescape cs :: [Char]cs
escape (c :: Charc:cs :: [Char]cs) = c :: Colourc(:) :: a -> [a] -> [a]: escape :: String -> Stringescape cs :: [Char]cs
escape [] = [] :: [a][]
htmlHeader :: String -> String
htmlHeader :: String -> StringhtmlHeader title :: Stringtitle = unlines :: [String] -> Stringunlines
[ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">"
, "<html>"
, "<head>"
,"<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->"
, "<title>"(++) :: [a] -> [a] -> [a]++title :: Stringtitle(++) :: [a] -> [a] -> [a]++"</title>"
, "</head>"
, "<body>"
]
htmlClose :: String
htmlClose :: StringhtmlClose = "\n</body>\n</html>"