{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Skylighting.Format.HTML.Lucid
( formatHtmlInline
, formatHtmlBlock
) where
import Data.Foldable (traverse_)
import qualified Data.List as L
import qualified Data.Text as T
import Lucid
import Skylighting.Types
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
formatHtmlInline :: FormatOptions -> [SourceLine] -> Html ()
formatHtmlInline :: FormatOptions -> [SourceLine] -> HtmlT Identity ()
formatHtmlInline FormatOptions
opts =
FormatOptions -> HtmlT Identity () -> HtmlT Identity ()
wrapCode FormatOptions
opts (HtmlT Identity () -> HtmlT Identity ())
-> ([SourceLine] -> HtmlT Identity ())
-> [SourceLine]
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HtmlT Identity ()] -> HtmlT Identity ()
forall a. Monoid a => [a] -> a
mconcat ([HtmlT Identity ()] -> HtmlT Identity ())
-> ([SourceLine] -> [HtmlT Identity ()])
-> [SourceLine]
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceLine -> HtmlT Identity ())
-> [SourceLine] -> [HtmlT Identity ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> HtmlT Identity ()) -> SourceLine -> HtmlT Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FormatOptions -> Token -> HtmlT Identity ()
tokenToHtml FormatOptions
opts))
formatHtmlBlock :: FormatOptions -> [SourceLine] -> Html ()
formatHtmlBlock :: FormatOptions -> [SourceLine] -> HtmlT Identity ()
formatHtmlBlock FormatOptions
opts [SourceLine]
ls =
[Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"sourceCode"]
(HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
pre_ [[Text] -> Attribute
classes_ [Text]
classes]
(HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ FormatOptions -> HtmlT Identity () -> HtmlT Identity ()
wrapCode FormatOptions
opts
(HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [HtmlT Identity ()] -> HtmlT Identity ()
forall a. Monoid a => [a] -> a
mconcat
([HtmlT Identity ()] -> HtmlT Identity ())
-> [HtmlT Identity ()] -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> [HtmlT Identity ()] -> [HtmlT Identity ()]
forall a. a -> [a] -> [a]
L.intersperse HtmlT Identity ()
"\n"
([HtmlT Identity ()] -> [HtmlT Identity ()])
-> [HtmlT Identity ()] -> [HtmlT Identity ()]
forall a b. (a -> b) -> a -> b
$ (LineNo -> SourceLine -> HtmlT Identity ())
-> [LineNo] -> [SourceLine] -> [HtmlT Identity ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (FormatOptions -> LineNo -> SourceLine -> HtmlT Identity ()
sourceLineToHtml FormatOptions
opts) [LineNo
startNum..] [SourceLine]
ls
where
classes :: [T.Text]
classes :: [Text]
classes = Text
"sourceCode"
Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text
"numberSource" | FormatOptions -> Bool
numberLines FormatOptions
opts]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
x | Text
x <- FormatOptions -> [Text]
containerClasses FormatOptions
opts, Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"sourceCode"]
startNum :: LineNo
startNum :: LineNo
startNum = Int -> LineNo
LineNo (Int -> LineNo) -> Int -> LineNo
forall a b. (a -> b) -> a -> b
$ FormatOptions -> Int
startNumber FormatOptions
opts
wrapCode :: FormatOptions -> Html () -> Html ()
wrapCode :: FormatOptions -> HtmlT Identity () -> HtmlT Identity ()
wrapCode FormatOptions
opts HtmlT Identity ()
h =
[Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
code_ [[Text] -> Attribute
classes_ ([Text] -> Attribute) -> [Text] -> Attribute
forall a b. (a -> b) -> a -> b
$ Text
"sourceCode" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: FormatOptions -> [Text]
codeClasses FormatOptions
opts] HtmlT Identity ()
h
sourceLineToHtml :: FormatOptions -> LineNo -> SourceLine -> Html ()
sourceLineToHtml :: FormatOptions -> LineNo -> SourceLine -> HtmlT Identity ()
sourceLineToHtml FormatOptions
opts LineNo
lno SourceLine
cont = [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
id_ Text
prefixedLineNo] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
[Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ Text
lineRef] HtmlT Identity ()
""
(Token -> HtmlT Identity ()) -> SourceLine -> HtmlT Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FormatOptions -> Token -> HtmlT Identity ()
tokenToHtml FormatOptions
opts) SourceLine
cont
where
lineRef :: T.Text
lineRef :: Text
lineRef = Char -> Text -> Text
T.cons Char
'#' Text
prefixedLineNo
prefixedLineNo :: T.Text
prefixedLineNo :: Text
prefixedLineNo = FormatOptions -> Text
lineIdPrefix FormatOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ LineNo -> Int
lineNo LineNo
lno)
tokenToHtml :: FormatOptions -> Token -> Html ()
tokenToHtml :: FormatOptions -> Token -> HtmlT Identity ()
tokenToHtml FormatOptions
_ (TokenType
NormalTok, Text
txt) = Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
txt
tokenToHtml FormatOptions
opts (TokenType
toktype, Text
txt)
| FormatOptions -> Bool
titleAttributes FormatOptions
opts = HtmlT Identity ()
sp
| Bool
otherwise = HtmlT Identity ()
sp
where
sp :: Html ()
sp :: HtmlT Identity ()
sp = [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
class_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ TokenType -> Text
short TokenType
toktype] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
txt
short :: TokenType -> T.Text
short :: TokenType -> Text
short TokenType
KeywordTok = Text
"kw"
short TokenType
DataTypeTok = Text
"dt"
short TokenType
DecValTok = Text
"dv"
short TokenType
BaseNTok = Text
"bn"
short TokenType
FloatTok = Text
"fl"
short TokenType
CharTok = Text
"ch"
short TokenType
StringTok = Text
"st"
short TokenType
CommentTok = Text
"co"
short TokenType
OtherTok = Text
"ot"
short TokenType
AlertTok = Text
"al"
short TokenType
FunctionTok = Text
"fu"
short TokenType
RegionMarkerTok = Text
"re"
short TokenType
ErrorTok = Text
"er"
short TokenType
ConstantTok = Text
"cn"
short TokenType
SpecialCharTok = Text
"sc"
short TokenType
VerbatimStringTok = Text
"vs"
short TokenType
SpecialStringTok = Text
"ss"
short TokenType
ImportTok = Text
"im"
short TokenType
DocumentationTok = Text
"do"
short TokenType
AnnotationTok = Text
"an"
short TokenType
CommentVarTok = Text
"cv"
short TokenType
VariableTok = Text
"va"
short TokenType
ControlFlowTok = Text
"cf"
short TokenType
OperatorTok = Text
"op"
short TokenType
BuiltInTok = Text
"bu"
short TokenType
ExtensionTok = Text
"ex"
short TokenType
PreprocessorTok = Text
"pp"
short TokenType
AttributeTok = Text
"at"
short TokenType
InformationTok = Text
"in"
short TokenType
WarningTok = Text
"wa"
short TokenType
NormalTok = Text
""