{-# LANGUAGE CPP #-}
{-# LANGUAGE NoOverloadedStrings #-}
module Skylighting.Format.HTML (
formatHtmlInline
, formatHtmlBlock
, formatHtml4Block
, styleToCss
) where
import Data.List (intersperse, sort)
import qualified Data.Map as Map
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
import Data.String (fromString)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
formatHtmlInline :: FormatOptions -> [SourceLine] -> Html
formatHtmlInline :: FormatOptions -> [SourceLine] -> Html
formatHtmlInline FormatOptions
opts = FormatOptions -> Html -> Html
wrapCode FormatOptions
opts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (forall a. ToMarkup a => a -> Html
toHtml String
"\n")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FormatOptions -> Token -> Html
tokenToHtml FormatOptions
opts))
formatHtmlBlock :: FormatOptions -> [SourceLine] -> Html
formatHtmlBlock :: FormatOptions -> [SourceLine] -> Html
formatHtmlBlock = HtmlVersion -> FormatOptions -> [SourceLine] -> Html
formatHtmlBlockFor HtmlVersion
Html5
formatHtml4Block :: FormatOptions -> [SourceLine] -> Html
formatHtml4Block :: FormatOptions -> [SourceLine] -> Html
formatHtml4Block = HtmlVersion -> FormatOptions -> [SourceLine] -> Html
formatHtmlBlockFor HtmlVersion
Html4
data HtmlVersion = Html4 | Html5
deriving (Int -> HtmlVersion -> ShowS
[HtmlVersion] -> ShowS
HtmlVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HtmlVersion] -> ShowS
$cshowList :: [HtmlVersion] -> ShowS
show :: HtmlVersion -> String
$cshow :: HtmlVersion -> String
showsPrec :: Int -> HtmlVersion -> ShowS
$cshowsPrec :: Int -> HtmlVersion -> ShowS
Show, HtmlVersion -> HtmlVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HtmlVersion -> HtmlVersion -> Bool
$c/= :: HtmlVersion -> HtmlVersion -> Bool
== :: HtmlVersion -> HtmlVersion -> Bool
$c== :: HtmlVersion -> HtmlVersion -> Bool
Eq)
formatHtmlBlockFor :: HtmlVersion -> FormatOptions -> [SourceLine] -> Html
formatHtmlBlockFor :: HtmlVersion -> FormatOptions -> [SourceLine] -> Html
formatHtmlBlockFor HtmlVersion
htmlVersion FormatOptions
opts [SourceLine]
ls =
Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (forall a. ToValue a => a -> AttributeValue
toValue String
"sourceCode") forall a b. (a -> b) -> a -> b
$
Html -> Html
H.pre forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords [Text]
classes)
forall a b. (a -> b) -> a -> b
$ FormatOptions -> Html -> Html
wrapCode FormatOptions
opts
forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (forall a. ToMarkup a => a -> Html
toHtml String
"\n")
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (HtmlVersion -> FormatOptions -> LineNo -> SourceLine -> Html
sourceLineToHtml HtmlVersion
htmlVersion FormatOptions
opts) [LineNo
startNum..] [SourceLine]
ls
where classes :: [Text]
classes = String -> Text
Text.pack String
"sourceCode" forall a. a -> [a] -> [a]
:
[String -> Text
Text.pack String
"numberSource" | FormatOptions -> Bool
numberLines FormatOptions
opts] forall a. [a] -> [a] -> [a]
++
[Text
x | Text
x <- FormatOptions -> [Text]
containerClasses FormatOptions
opts
, Text
x forall a. Eq a => a -> a -> Bool
/= String -> Text
Text.pack String
"sourceCode"]
startNum :: LineNo
startNum = Int -> LineNo
LineNo forall a b. (a -> b) -> a -> b
$ FormatOptions -> Int
startNumber FormatOptions
opts
wrapCode :: FormatOptions -> Html -> Html
wrapCode :: FormatOptions -> Html -> Html
wrapCode FormatOptions
opts Html
h = Html -> Html
H.code forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"sourceCode"
forall a. a -> [a] -> [a]
: FormatOptions -> [Text]
codeClasses FormatOptions
opts)
forall h. Attributable h => h -> (Bool, Attribute) -> h
!? (Int
startZero forall a. Eq a => a -> a -> Bool
/= Int
0, AttributeValue -> Attribute
A.style (forall a. ToValue a => a -> AttributeValue
toValue String
counterOverride))
forall a b. (a -> b) -> a -> b
$ Html
h
where counterOverride :: String
counterOverride = String
"counter-reset: source-line " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
startZero forall a. Semigroup a => a -> a -> a
<> String
";"
startZero :: Int
startZero = FormatOptions -> Int
startNumber FormatOptions
opts forall a. Num a => a -> a -> a
- Int
1
sourceLineToHtml :: HtmlVersion -> FormatOptions -> LineNo -> SourceLine -> Html
sourceLineToHtml :: HtmlVersion -> FormatOptions -> LineNo -> SourceLine -> Html
sourceLineToHtml HtmlVersion
htmlVersion FormatOptions
opts LineNo
lno SourceLine
cont =
Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
lineNum
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
lineRef
forall h. Attributable h => h -> Attribute -> h
! (if FormatOptions -> Bool
numberLines FormatOptions
opts Bool -> Bool -> Bool
|| HtmlVersion
htmlVersion forall a. Eq a => a -> a -> Bool
== HtmlVersion
Html4
then forall a. Monoid a => a
mempty
else Tag -> AttributeValue -> Attribute
customAttribute (forall a. IsString a => String -> a
fromString String
"aria-hidden")
(forall a. IsString a => String -> a
fromString String
"true"))
forall h. Attributable h => h -> Attribute -> h
! (if FormatOptions -> Bool
numberLines FormatOptions
opts
then forall a. Monoid a => a
mempty
else Tag -> AttributeValue -> Attribute
customAttribute (forall a. IsString a => String -> a
fromString String
"tabindex")
(forall a. IsString a => String -> a
fromString String
"-1"))
forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FormatOptions -> Token -> Html
tokenToHtml FormatOptions
opts) SourceLine
cont
where lineNum :: AttributeValue
lineNum = forall a. ToValue a => a -> AttributeValue
toValue String
prefixedLineNo
lineRef :: AttributeValue
lineRef = forall a. ToValue a => a -> AttributeValue
toValue (Char
'#'forall a. a -> [a] -> [a]
:String
prefixedLineNo)
prefixedLineNo :: String
prefixedLineNo = Text -> String
Text.unpack (FormatOptions -> Text
lineIdPrefix FormatOptions
opts) forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (LineNo -> Int
lineNo LineNo
lno)
tokenToHtml :: FormatOptions -> Token -> Html
tokenToHtml :: FormatOptions -> Token -> Html
tokenToHtml FormatOptions
_ (TokenType
NormalTok, Text
txt) = forall a. ToMarkup a => a -> Html
toHtml Text
txt
tokenToHtml FormatOptions
opts (TokenType
toktype, Text
txt) =
if FormatOptions -> Bool
titleAttributes FormatOptions
opts
then Html
sp forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TokenType
toktype)
else Html
sp
where sp :: Html
sp = Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ TokenType -> String
short TokenType
toktype) forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Text
txt
short :: TokenType -> String
short :: TokenType -> String
short TokenType
KeywordTok = String
"kw"
short TokenType
DataTypeTok = String
"dt"
short TokenType
DecValTok = String
"dv"
short TokenType
BaseNTok = String
"bn"
short TokenType
FloatTok = String
"fl"
short TokenType
CharTok = String
"ch"
short TokenType
StringTok = String
"st"
short TokenType
CommentTok = String
"co"
short TokenType
OtherTok = String
"ot"
short TokenType
AlertTok = String
"al"
short TokenType
FunctionTok = String
"fu"
short TokenType
RegionMarkerTok = String
"re"
short TokenType
ErrorTok = String
"er"
short TokenType
ConstantTok = String
"cn"
short TokenType
SpecialCharTok = String
"sc"
short TokenType
VerbatimStringTok = String
"vs"
short TokenType
SpecialStringTok = String
"ss"
short TokenType
ImportTok = String
"im"
short TokenType
DocumentationTok = String
"do"
short TokenType
AnnotationTok = String
"an"
short TokenType
CommentVarTok = String
"cv"
short TokenType
VariableTok = String
"va"
short TokenType
ControlFlowTok = String
"cf"
short TokenType
OperatorTok = String
"op"
short TokenType
BuiltInTok = String
"bu"
short TokenType
ExtensionTok = String
"ex"
short TokenType
PreprocessorTok = String
"pp"
short TokenType
AttributeTok = String
"at"
short TokenType
InformationTok = String
"in"
short TokenType
WarningTok = String
"wa"
short TokenType
NormalTok = String
""
styleToCss :: Style -> String
styleToCss :: Style -> String
styleToCss Style
f = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
[String]
divspec forall a. [a] -> [a] -> [a]
++ [String]
numberspec forall a. [a] -> [a] -> [a]
++ [String]
colorspec forall a. [a] -> [a] -> [a]
++ [String]
linkspec forall a. [a] -> [a] -> [a]
++
forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map (TokenType, TokenStyle) -> String
toCss (forall k a. Map k a -> [(k, a)]
Map.toList (Style -> Map TokenType TokenStyle
tokenStyles Style
f)))
where colorspec :: [String]
colorspec = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ [
String
"div.sourceCode\n {"
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Color
c -> String
"color: " forall a. [a] -> [a] -> [a]
++ forall a. FromColor a => Color -> a
fromColor Color
c forall a. [a] -> [a] -> [a]
++ String
";") (Style -> Maybe Color
defaultColor Style
f)
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Color
c -> String
"background-color: " forall a. [a] -> [a] -> [a]
++ forall a. FromColor a => Color -> a
fromColor Color
c forall a. [a] -> [a] -> [a]
++ String
";") (Style -> Maybe Color
backgroundColor Style
f)
, String
"}"
]
numberspec :: [String]
numberspec = [
String
"pre.numberSource code"
, String
" { counter-reset: source-line 0; }"
, String
"pre.numberSource code > span"
, String
" { position: relative; left: -4em; counter-increment: source-line; }"
, String
"pre.numberSource code > span > a:first-child::before"
, String
" { content: counter(source-line);"
, String
" position: relative; left: -1em; text-align: right; vertical-align: baseline;"
, String
" border: none; display: inline-block;"
, String
" -webkit-touch-callout: none; -webkit-user-select: none;"
, String
" -khtml-user-select: none; -moz-user-select: none;"
, String
" -ms-user-select: none; user-select: none;"
, String
" padding: 0 4px; width: 4em;"
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Color
c -> String
" background-color: " forall a. [a] -> [a] -> [a]
++ forall a. FromColor a => Color -> a
fromColor Color
c forall a. [a] -> [a] -> [a]
++ String
";\n")
(Style -> Maybe Color
lineNumberBackgroundColor Style
f) forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Color
c -> String
" color: " forall a. [a] -> [a] -> [a]
++ forall a. FromColor a => Color -> a
fromColor Color
c forall a. [a] -> [a] -> [a]
++ String
";\n")
(Style -> Maybe Color
lineNumberColor Style
f) forall a. [a] -> [a] -> [a]
++
String
" }"
, String
"pre.numberSource { margin-left: 3em; " forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Color
c -> String
"border-left: 1px solid " forall a. [a] -> [a] -> [a]
++ forall a. FromColor a => Color -> a
fromColor Color
c forall a. [a] -> [a] -> [a]
++ String
"; ") (Style -> Maybe Color
lineNumberColor Style
f) forall a. [a] -> [a] -> [a]
++
String
" padding-left: 4px; }"
]
divspec :: [String]
divspec = [
String
"pre > code.sourceCode { white-space: pre; position: relative; }"
, String
"pre > code.sourceCode > span { display: inline-block; line-height: 1.25; }"
, String
"pre > code.sourceCode > span:empty { height: 1.2em; }"
, String
".sourceCode { overflow: visible; }"
, String
"code.sourceCode > span { color: inherit; text-decoration: inherit; }"
, String
"div.sourceCode { margin: 1em 0; }"
, String
"pre.sourceCode { margin: 0; }"
, String
"@media screen {"
, String
"div.sourceCode { overflow: auto; }"
, String
"}"
, String
"@media print {"
, String
"pre > code.sourceCode { white-space: pre-wrap; }"
, String
"pre > code.sourceCode > span { text-indent: -5em; padding-left: 5em; }"
, String
"}"
]
linkspec :: [String]
linkspec = [ String
"@media screen {"
, String
"pre > code.sourceCode > span > a:first-child::before { text-decoration: underline; }"
, String
"}"
]
toCss :: (TokenType, TokenStyle) -> String
toCss :: (TokenType, TokenStyle) -> String
toCss (TokenType
t,TokenStyle
tf) = String
"code span" forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TokenType -> String
short TokenType
t) then String
"" else (Char
'.' forall a. a -> [a] -> [a]
: TokenType -> String
short TokenType
t)) forall a. [a] -> [a] -> [a]
++ String
" { "
forall a. [a] -> [a] -> [a]
++ String
colorspec forall a. [a] -> [a] -> [a]
++ String
backgroundspec forall a. [a] -> [a] -> [a]
++ String
weightspec forall a. [a] -> [a] -> [a]
++ String
stylespec
forall a. [a] -> [a] -> [a]
++ String
decorationspec forall a. [a] -> [a] -> [a]
++ String
"} /* " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
showTokenType TokenType
t forall a. [a] -> [a] -> [a]
++ String
" */"
where colorspec :: String
colorspec = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Color
col -> String
"color: " forall a. [a] -> [a] -> [a]
++ forall a. FromColor a => Color -> a
fromColor Color
col forall a. [a] -> [a] -> [a]
++ String
"; ") forall a b. (a -> b) -> a -> b
$ TokenStyle -> Maybe Color
tokenColor TokenStyle
tf
backgroundspec :: String
backgroundspec = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Color
col -> String
"background-color: " forall a. [a] -> [a] -> [a]
++ forall a. FromColor a => Color -> a
fromColor Color
col forall a. [a] -> [a] -> [a]
++ String
"; ") forall a b. (a -> b) -> a -> b
$ TokenStyle -> Maybe Color
tokenBackground TokenStyle
tf
weightspec :: String
weightspec = if TokenStyle -> Bool
tokenBold TokenStyle
tf then String
"font-weight: bold; " else String
""
stylespec :: String
stylespec = if TokenStyle -> Bool
tokenItalic TokenStyle
tf then String
"font-style: italic; " else String
""
decorationspec :: String
decorationspec = if TokenStyle -> Bool
tokenUnderline TokenStyle
tf then String
"text-decoration: underline; " else String
""
showTokenType :: a -> String
showTokenType a
t' = case forall a. [a] -> [a]
reverse (forall a. Show a => a -> String
show a
t') of
Char
'k':Char
'o':Char
'T':String
xs -> forall a. [a] -> [a]
reverse String
xs
String
_ -> String
""