module Skylighting.Format.HTML (
formatHtmlInline
, formatHtmlBlock
, styleToCss
) where
import Data.List (intersperse, sort)
import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.String (fromString)
import qualified Data.Text as Text
import Skylighting.Types
import Text.Blaze.Html
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
formatHtmlInline :: FormatOptions -> [SourceLine] -> Html
formatHtmlInline opts = wrapCode opts
. mconcat . intersperse (toHtml "\n")
. map (mapM_ (tokenToHtml opts))
formatHtmlBlock :: FormatOptions -> [SourceLine] -> Html
formatHtmlBlock opts ls =
H.div ! A.class_ (toValue "sourceCode") $
H.pre ! A.class_ (toValue $ Text.unwords classes)
$ wrapCode opts
$ mconcat . intersperse (toHtml "\n")
$ zipWith (sourceLineToHtml opts) [startNum..] ls
where classes = Text.pack "sourceCode" :
[Text.pack "numberSource" | numberLines opts] ++
[x | x <- containerClasses opts
, x /= Text.pack "sourceCode"]
startNum = LineNo $ startNumber opts
wrapCode :: FormatOptions -> Html -> Html
wrapCode opts h = H.code ! A.class_ (toValue $ Text.unwords
$ Text.pack "sourceCode"
: codeClasses opts) $ h
sourceLineToHtml :: FormatOptions -> LineNo -> SourceLine -> Html
sourceLineToHtml opts lno cont =
(if lineAnchors opts
then H.a ! A.class_ sourceLine
! A.id lineNum
! A.href lineRef
! dataAttrib
else H.a ! A.class_ sourceLine
! A.id lineNum
! dataAttrib) $ mapM_ (tokenToHtml opts) cont
where sourceLine = toValue "sourceLine"
lineNum = toValue prefixedLineNo
lineRef = toValue ('#':prefixedLineNo)
prefixedLineNo = Text.unpack (lineIdPrefix opts) <> show (lineNo lno)
dataAttrib = A.title (toValue (show (lineNo lno)))
tokenToHtml :: FormatOptions -> Token -> Html
tokenToHtml _ (NormalTok, txt) = toHtml txt
tokenToHtml opts (toktype, txt) =
if titleAttributes opts
then sp ! A.title (toValue $ show toktype)
else sp
where sp = H.span ! A.class_ (toValue $ short toktype) $ toHtml txt
short :: TokenType -> String
short KeywordTok = "kw"
short DataTypeTok = "dt"
short DecValTok = "dv"
short BaseNTok = "bn"
short FloatTok = "fl"
short CharTok = "ch"
short StringTok = "st"
short CommentTok = "co"
short OtherTok = "ot"
short AlertTok = "al"
short FunctionTok = "fu"
short RegionMarkerTok = "re"
short ErrorTok = "er"
short ConstantTok = "cn"
short SpecialCharTok = "sc"
short VerbatimStringTok = "vs"
short SpecialStringTok = "ss"
short ImportTok = "im"
short DocumentationTok = "do"
short AnnotationTok = "an"
short CommentVarTok = "cv"
short VariableTok = "va"
short ControlFlowTok = "cf"
short OperatorTok = "op"
short BuiltInTok = "bu"
short ExtensionTok = "ex"
short PreprocessorTok = "pp"
short AttributeTok = "at"
short InformationTok = "in"
short WarningTok = "wa"
short NormalTok = ""
styleToCss :: Style -> String
styleToCss f = unlines $
divspec ++ numberspec ++ colorspec ++ linkspec ++
sort (map toCss (Map.toList (tokenStyles f)))
where colorspec = [
"div.sourceCode\n { "
++ case (defaultColor f, backgroundColor f) of
(Nothing, Nothing) -> ""
(Just c, Nothing) -> "color: " ++ fromColor c ++ ";"
(Nothing, Just c) -> "background-color: " ++ fromColor c ++ ";"
(Just c1, Just c2) -> "color: " ++ fromColor c1
++ "; background-color: " ++ fromColor c2 ++ ";"
++ " }"]
numberspec = [
"pre.numberSource a.sourceLine"
, " { position: relative; left: -4em; }"
, "pre.numberSource a.sourceLine::before"
, " { content: attr(title);"
, " position: relative; left: -1em; text-align: right; vertical-align: baseline;"
, " border: none; pointer-events: all; display: inline-block;"
, " -webkit-touch-callout: none; -webkit-user-select: none;"
, " -khtml-user-select: none; -moz-user-select: none;"
, " -ms-user-select: none; user-select: none;"
, " padding: 0 4px; width: 4em;"
, maybe "" (\c -> " background-color: " ++ fromColor c ++ ";\n")
(lineNumberBackgroundColor f) ++
maybe "" (\c -> " color: " ++ fromColor c ++ ";\n")
(lineNumberColor f) ++
" }"
, "pre.numberSource { margin-left: 3em; " ++
maybe "" (\c -> "border-left: 1px solid " ++ fromColor c ++ "; ") (lineNumberColor f) ++
" padding-left: 4px; }"
]
divspec = [
"a.sourceLine { display: inline-block; line-height: 1.25; }"
, "a.sourceLine { pointer-events: none; color: inherit; text-decoration: inherit; }"
, "a.sourceLine:empty { height: 1.2em; }"
, ".sourceCode { overflow: visible; }"
, "code.sourceCode { white-space: pre; position: relative; }"
, "div.sourceCode { margin: 1em 0; }"
, "pre.sourceCode { margin: 0; }"
, "@media screen {"
, "div.sourceCode { overflow: auto; }"
, "}"
, "@media print {"
, "code.sourceCode { white-space: pre-wrap; }"
, "a.sourceLine { text-indent: -1em; padding-left: 1em; }"
, "}"
]
linkspec = [ "@media screen {"
, "a.sourceLine::before { text-decoration: underline; }"
, "}"
]
toCss :: (TokenType, TokenStyle) -> String
toCss (t,tf) = "code span." ++ short t ++ " { "
++ colorspec ++ backgroundspec ++ weightspec ++ stylespec
++ decorationspec ++ "} /* " ++ showTokenType t ++ " */"
where colorspec = maybe "" (\col -> "color: " ++ fromColor col ++ "; ") $ tokenColor tf
backgroundspec = maybe "" (\col -> "background-color: " ++ fromColor col ++ "; ") $ tokenBackground tf
weightspec = if tokenBold tf then "font-weight: bold; " else ""
stylespec = if tokenItalic tf then "font-style: italic; " else ""
decorationspec = if tokenUnderline tf then "text-decoration: underline; " else ""
showTokenType t' = case reverse (show t') of
'k':'o':'T':xs -> reverse xs
_ -> ""