{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.HTML (
writeHtml4,
writeHtml4String,
writeHtml5,
writeHtml5String,
writeHtmlStringForEPUB,
writeS5,
writeSlidy,
writeSlideous,
writeDZSlides,
writeRevealJs,
tagWithAttributes
) where
import Control.Monad.State.Strict
import Data.Char (ord)
import Data.List (intercalate, intersperse, partition, delete, (\\))
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Network.HTTP (urlEncode)
import Network.URI (URI (..), parseURIReference)
import Numeric (showHex)
import Text.DocLayout (render, literal)
import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent)
import Text.DocTemplates (FromContext (lookupContext), Context (..))
import Text.Blaze.Html hiding (contents)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight,
styleToCss)
import Text.Pandoc.ImageSize
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Slides
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML (escapeStringForXML, fromEntities, toEntities,
html5Attributes, html4Attributes, rdfaAttributes)
import qualified Text.Blaze.XHtml5 as H5
import qualified Text.Blaze.XHtml5.Attributes as A5
import Control.Monad.Except (throwError)
import System.FilePath (takeBaseName)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Text.Blaze.XHtml1.Transitional as H
import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Class.PandocPure (runPure)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.MIME (mediaCategory)
import Text.TeXMath
import Text.XML.Light (elChildren, unode, unqual)
import qualified Text.XML.Light as XML
import Text.XML.Light.Output
data WriterState = WriterState
{ WriterState -> [Html]
stNotes :: [Html]
, WriterState -> Bool
stMath :: Bool
, WriterState -> Bool
stQuotes :: Bool
, WriterState -> Bool
stHighlighting :: Bool
, WriterState -> Bool
stHtml5 :: Bool
, WriterState -> Maybe EPUBVersion
stEPUBVersion :: Maybe EPUBVersion
, WriterState -> HTMLSlideVariant
stSlideVariant :: HTMLSlideVariant
, WriterState -> Int
stSlideLevel :: Int
, WriterState -> Bool
stInSection :: Bool
, WriterState -> Int
stCodeBlockNum :: Int
}
defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState = WriterState :: [Html]
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe EPUBVersion
-> HTMLSlideVariant
-> Int
-> Bool
-> Int
-> WriterState
WriterState {stNotes :: [Html]
stNotes= [], stMath :: Bool
stMath = Bool
False, stQuotes :: Bool
stQuotes = Bool
False,
stHighlighting :: Bool
stHighlighting = Bool
False,
stHtml5 :: Bool
stHtml5 = Bool
False,
stEPUBVersion :: Maybe EPUBVersion
stEPUBVersion = Maybe EPUBVersion
forall a. Maybe a
Nothing,
stSlideVariant :: HTMLSlideVariant
stSlideVariant = HTMLSlideVariant
NoSlides,
stSlideLevel :: Int
stSlideLevel = 1,
stInSection :: Bool
stInSection = Bool
False,
stCodeBlockNum :: Int
stCodeBlockNum = 0}
strToHtml :: Text -> Html
strToHtml :: Text -> Html
strToHtml = [Char] -> Html
strToHtml' ([Char] -> Html) -> (Text -> [Char]) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
where
strToHtml' :: [Char] -> Html
strToHtml' ('\'':xs :: [Char]
xs) = [Char] -> Html
preEscapedString "\'" Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` [Char] -> Html
strToHtml' [Char]
xs
strToHtml' ('"' :xs :: [Char]
xs) = [Char] -> Html
preEscapedString "\"" Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` [Char] -> Html
strToHtml' [Char]
xs
strToHtml' (x :: Char
x:xs :: [Char]
xs) | Char -> Bool
needsVariationSelector Char
x
= [Char] -> Html
preEscapedString [Char
x, '\xFE0E'] Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend`
case [Char]
xs of
('\xFE0E':ys :: [Char]
ys) -> [Char] -> Html
strToHtml' [Char]
ys
_ -> [Char] -> Html
strToHtml' [Char]
xs
strToHtml' xs :: [Char]
xs@(_:_) = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"' Bool -> Bool -> Bool
||
Char -> Bool
needsVariationSelector Char
c) [Char]
xs of
(_ ,[]) -> [Char] -> Html
forall a. ToMarkup a => a -> Html
toHtml [Char]
xs
(ys :: [Char]
ys,zs :: [Char]
zs) -> [Char] -> Html
forall a. ToMarkup a => a -> Html
toHtml [Char]
ys Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` [Char] -> Html
strToHtml' [Char]
zs
strToHtml' [] = ""
needsVariationSelector :: Char -> Bool
needsVariationSelector :: Char -> Bool
needsVariationSelector '↩' = Bool
True
needsVariationSelector '↔' = Bool
True
needsVariationSelector _ = Bool
False
nl :: WriterOptions -> Html
nl :: WriterOptions -> Html
nl opts :: WriterOptions
opts = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapNone
then Html
forall a. Monoid a => a
mempty
else [Char] -> Html
preEscapedString "\n"
writeHtml5String :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeHtml5String :: WriterOptions -> Pandoc -> m Text
writeHtml5String = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
True }
writeHtml5 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
writeHtml5 :: WriterOptions -> Pandoc -> m Html
writeHtml5 = WriterState -> WriterOptions -> Pandoc -> m Html
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
True }
writeHtml4String :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeHtml4String :: WriterOptions -> Pandoc -> m Text
writeHtml4String = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
False }
writeHtml4 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
writeHtml4 :: WriterOptions -> Pandoc -> m Html
writeHtml4 = WriterState -> WriterOptions -> Pandoc -> m Html
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
False }
writeHtmlStringForEPUB :: PandocMonad m
=> EPUBVersion -> WriterOptions -> Pandoc
-> m Text
writeHtmlStringForEPUB :: EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB version :: EPUBVersion
version o :: WriterOptions
o = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3,
stEPUBVersion :: Maybe EPUBVersion
stEPUBVersion = EPUBVersion -> Maybe EPUBVersion
forall a. a -> Maybe a
Just EPUBVersion
version } WriterOptions
o
writeRevealJs :: PandocMonad m
=> WriterOptions -> Pandoc -> m Text
writeRevealJs :: WriterOptions -> Pandoc -> m Text
writeRevealJs = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
RevealJsSlides
writeS5 :: PandocMonad m
=> WriterOptions -> Pandoc -> m Text
writeS5 :: WriterOptions -> Pandoc -> m Text
writeS5 = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
S5Slides
writeSlidy :: PandocMonad m
=> WriterOptions -> Pandoc -> m Text
writeSlidy :: WriterOptions -> Pandoc -> m Text
writeSlidy = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
SlidySlides
writeSlideous :: PandocMonad m
=> WriterOptions -> Pandoc -> m Text
writeSlideous :: WriterOptions -> Pandoc -> m Text
writeSlideous = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
SlideousSlides
writeDZSlides :: PandocMonad m
=> WriterOptions -> Pandoc -> m Text
writeDZSlides :: WriterOptions -> Pandoc -> m Text
writeDZSlides = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
DZSlides
writeHtmlSlideShow' :: PandocMonad m
=> HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' :: HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' variant :: HTMLSlideVariant
variant = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
WriterState
defaultWriterState{ stSlideVariant :: HTMLSlideVariant
stSlideVariant = HTMLSlideVariant
variant
, stHtml5 :: Bool
stHtml5 = case HTMLSlideVariant
variant of
RevealJsSlides -> Bool
True
S5Slides -> Bool
False
SlidySlides -> Bool
False
DZSlides -> Bool
True
SlideousSlides -> Bool
False
NoSlides -> Bool
False
}
renderHtml' :: Html -> Text
renderHtml' :: Html -> Text
renderHtml' = Text -> Text
TL.toStrict (Text -> Text) -> (Html -> Text) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml
writeHtmlString' :: PandocMonad m
=> WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' :: WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' st :: WriterState
st opts :: WriterOptions
opts d :: Pandoc
d = do
(body :: Html
body, context :: Context Text
context) <- StateT WriterState m (Html, Context Text)
-> WriterState -> m (Html, Context Text)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
pandocToHtml WriterOptions
opts Pandoc
d) WriterState
st
(if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
then Text -> Text
toEntities
else Text -> Text
forall a. a -> a
id) (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Nothing -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Html -> Text
renderHtml' Html
body
Just tpl :: Template Text
tpl -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField "lang" Context Text
context :: Maybe Text)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report LogMessage
NoLangSpecified
Context Text
context' <-
case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField "pagetitle" Context Text
context of
Just (Text
s :: Text) | Bool -> Bool
not (Text -> Bool
T.null Text
s) -> Context Text -> m (Context Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Context Text
context
_ -> do
let fallback :: Text
fallback = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$
case Text -> Context Text -> Maybe [Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext "sourcefile"
(WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
Nothing -> "Untitled"
Just [] -> "Untitled"
Just (x :: Text
x:_) -> [Char] -> [Char]
takeBaseName ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
x
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
NoTitleElement Text
fallback
Context Text -> m (Context Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Context Text -> m (Context Text))
-> Context Text -> m (Context Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField "pagetitle" Text
fallback Context Text
context
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl
(Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "body" (Html -> Text
renderHtml' Html
body) Context Text
context')
writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' :: WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' st :: WriterState
st opts :: WriterOptions
opts d :: Pandoc
d =
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Just _ -> Text -> Html
preEscapedText (Text -> Html) -> m Text -> m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' WriterState
st WriterOptions
opts Pandoc
d
Nothing
| WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
-> Text -> Html
preEscapedText (Text -> Html) -> m Text -> m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' WriterState
st WriterOptions
opts Pandoc
d
| Bool
otherwise -> do
(body :: Html
body, _) <- StateT WriterState m (Html, Context Text)
-> WriterState -> m (Html, Context Text)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
pandocToHtml WriterOptions
opts Pandoc
d) WriterState
st
Html -> m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
body
pandocToHtml :: PandocMonad m
=> WriterOptions
-> Pandoc
-> StateT WriterState m (Html, Context Text)
pandocToHtml :: WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
pandocToHtml opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
let slideLevel :: Int
slideLevel = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Block] -> Int
getSlideLevel [Block]
blocks) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Maybe Int
writerSlideLevel WriterOptions
opts
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stSlideLevel :: Int
stSlideLevel = Int
slideLevel }
Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
((Html -> Doc Text)
-> StateT WriterState m Html -> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Html -> Text) -> Html -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml') (StateT WriterState m Html -> StateT WriterState m (Doc Text))
-> ([Block] -> StateT WriterState m Html)
-> [Block]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts)
((Html -> Doc Text)
-> StateT WriterState m Html -> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Html -> Text) -> Html -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml') (StateT WriterState m Html -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m Html)
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts)
Meta
meta
let stringifyHTML :: [Inline] -> Text
stringifyHTML = Text -> Text
escapeStringForXML (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify
let authsMeta :: [Text]
authsMeta = ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
stringifyHTML ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
let dateMeta :: Text
dateMeta = [Inline] -> Text
stringifyHTML ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docDate Meta
meta
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
let sects :: [Block]
sects = WriterOptions -> [Block] -> [Block]
adjustNumbers WriterOptions
opts ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$
Bool -> Maybe Int -> [Block] -> [Block]
makeSections (WriterOptions -> Bool
writerNumberSections WriterOptions
opts) Maybe Int
forall a. Maybe a
Nothing ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$
if HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
NoSlides
then [Block]
blocks
else Int -> [Block] -> [Block]
prepSlides Int
slideLevel [Block]
blocks
Maybe Text
toc <- if WriterOptions -> Bool
writerTableOfContents WriterOptions
opts Bool -> Bool -> Bool
&& HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
S5Slides
then (Html -> Text) -> Maybe Html -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Text
renderHtml' (Maybe Html -> Maybe Text)
-> StateT WriterState m (Maybe Html)
-> StateT WriterState m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> StateT WriterState m (Maybe Html)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Maybe Html)
tableOfContents WriterOptions
opts [Block]
sects
else Maybe Text -> StateT WriterState m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
Html
blocks' <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
sects
WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
Html
notes <- WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
footnoteSection WriterOptions
opts ([Html] -> [Html]
forall a. [a] -> [a]
reverse (WriterState -> [Html]
stNotes WriterState
st))
let thebody :: Html
thebody = Html
blocks' Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
notes
let math :: Html
math = case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
MathJax url :: Text
url
| HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
RevealJsSlides ->
Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
url)
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ "text/javascript"
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ case HTMLSlideVariant
slideVariant of
SlideousSlides ->
[Char] -> Html
preEscapedString
"MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);"
_ -> Html
forall a. Monoid a => a
mempty
KaTeX url :: Text
url -> do
Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
!
AttributeValue -> Attribute
A.src (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "katex.min.js") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
forall a. Monoid a => a
mempty
WriterOptions -> Html
nl WriterOptions
opts
let katexFlushLeft :: Text
katexFlushLeft =
case Text -> Context Text -> Maybe [Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext "classoption" Context Text
metadata of
Just clsops :: [Text]
clsops | "fleqn" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Text]
clsops :: [Text]) -> "true"
_ -> "false"
Html -> Html
H.script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
"document.addEventListener(\"DOMContentLoaded\", function () {"
, " var mathElements = document.getElementsByClassName(\"math\");"
, " for (var i = 0; i < mathElements.length; i++) {"
, " var texText = mathElements[i].firstChild;"
, " if (mathElements[i].tagName == \"SPAN\") {"
, " katex.render(texText.data, mathElements[i], {"
, " displayMode: mathElements[i].classList.contains('display'),"
, " throwOnError: false,"
, " fleqn: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
katexFlushLeft
, " });"
, "}}});"
]
WriterOptions -> Html
nl WriterOptions
opts
Html
H.link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel "stylesheet" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
!
AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "katex.min.css")
_ -> case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext "mathml-script"
(WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
Just s :: Text
s | Bool -> Bool
not (WriterState -> Bool
stHtml5 WriterState
st) ->
Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ "text/javascript"
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
preEscapedString
("/*<![CDATA[*/\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
"/*]]>*/\n")
| Bool
otherwise -> Html
forall a. Monoid a => a
mempty
Nothing -> Html
forall a. Monoid a => a
mempty
let context :: Context Text
context = (if WriterState -> Bool
stHighlighting WriterState
st
then case WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts of
Just sty :: Style
sty -> Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "highlighting-css"
([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Style -> [Char]
styleToCss Style
sty)
Nothing -> Context Text -> Context Text
forall a. a -> a
id
else Context Text -> Context Text
forall a. a -> a
id) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
(if WriterState -> Bool
stMath WriterState
st
then Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "math" (Html -> Text
renderHtml' Html
math)
else Context Text -> Context Text
forall a. a -> a
id) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
(case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
MathJax u :: Text
u -> Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "mathjax" Bool
True (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "mathjaxurl"
((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='?') Text
u)
_ -> Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "mathjax" Bool
False) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "quotes" (WriterState -> Bool
stQuotes WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
(Context Text -> Context Text)
-> (Text -> Context Text -> Context Text)
-> Maybe Text
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "toc") Maybe Text
toc (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
(Context Text -> Context Text)
-> (Text -> Context Text -> Context Text)
-> Maybe Text
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "table-of-contents") Maybe Text
toc (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> [Text] -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "author-meta" [Text]
authsMeta (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
(Context Text -> Context Text)
-> (Text -> Context Text -> Context Text)
-> Maybe Text
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "date-meta")
(Text -> Maybe Text
normalizeDate Text
dateMeta) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "pagetitle"
([Inline] -> Text
stringifyHTML ([Inline] -> Text) -> (Meta -> [Inline]) -> Meta -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Inline]
docTitle (Meta -> Text) -> Meta -> Text
forall a b. (a -> b) -> a -> b
$ Meta
meta) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "idprefix" (WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "slidy-url"
("https://www.w3.org/Talks/Tools/Slidy2" :: Text) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "slideous-url" ("slideous" :: Text) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "revealjs-url" ("reveal.js" :: Text) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "s5-url" ("s5/default" :: Text) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "html5" (WriterState -> Bool
stHtml5 WriterState
st)
Context Text
metadata
(Html, Context Text) -> StateT WriterState m (Html, Context Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
thebody, Context Text
context)
prefixedId :: WriterOptions -> Text -> Attribute
prefixedId :: WriterOptions -> Text -> Attribute
prefixedId opts :: WriterOptions
opts s :: Text
s =
case Text
s of
"" -> Attribute
forall a. Monoid a => a
mempty
_ -> AttributeValue -> Attribute
A.id (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
toList :: PandocMonad m
=> (Html -> Html)
-> WriterOptions
-> [Html]
-> StateT WriterState m Html
toList :: (Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList listop :: Html -> Html
listop opts :: WriterOptions
opts items :: [Html]
items = do
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
if WriterOptions -> Bool
writerIncremental WriterOptions
opts
then if HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
RevealJsSlides
then Html -> Html
listop ([Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
items) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "incremental"
else Html -> Html
listop (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (Html -> Html) -> [Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "fragment") [Html]
items
else Html -> Html
listop (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
items
unordList :: PandocMonad m
=> WriterOptions -> [Html] -> StateT WriterState m Html
unordList :: WriterOptions -> [Html] -> StateT WriterState m Html
unordList opts :: WriterOptions
opts = (Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.ul WriterOptions
opts ([Html] -> StateT WriterState m Html)
-> ([Html] -> [Html]) -> [Html] -> StateT WriterState m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Html] -> [Html]
toListItems WriterOptions
opts
ordList :: PandocMonad m
=> WriterOptions -> [Html] -> StateT WriterState m Html
ordList :: WriterOptions -> [Html] -> StateT WriterState m Html
ordList opts :: WriterOptions
opts = (Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.ol WriterOptions
opts ([Html] -> StateT WriterState m Html)
-> ([Html] -> [Html]) -> [Html] -> StateT WriterState m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Html] -> [Html]
toListItems WriterOptions
opts
defList :: PandocMonad m
=> WriterOptions -> [Html] -> StateT WriterState m Html
defList :: WriterOptions -> [Html] -> StateT WriterState m Html
defList opts :: WriterOptions
opts items :: [Html]
items = (Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.dl WriterOptions
opts ([Html]
items [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [WriterOptions -> Html
nl WriterOptions
opts])
isTaskListItem :: [Block] -> Bool
isTaskListItem :: [Block] -> Bool
isTaskListItem (Plain (Str "☐":Space:_):_) = Bool
True
isTaskListItem (Plain (Str "☒":Space:_):_) = Bool
True
isTaskListItem (Para (Str "☐":Space:_):_) = Bool
True
isTaskListItem (Para (Str "☒":Space:_):_) = Bool
True
isTaskListItem _ = Bool
False
listItemToHtml :: PandocMonad m
=> WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml :: WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml opts :: WriterOptions
opts bls :: [Block]
bls
| Plain (Str "☐":Space:is :: [Inline]
is) : bs :: [Block]
bs <- [Block]
bls = Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *) a.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
False Html -> Html
forall a. a -> a
id [Inline]
is [Block]
bs
| Plain (Str "☒":Space:is :: [Inline]
is) : bs :: [Block]
bs <- [Block]
bls = Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *) a.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
True Html -> Html
forall a. a -> a
id [Inline]
is [Block]
bs
| Para (Str "☐":Space:is :: [Inline]
is) : bs :: [Block]
bs <- [Block]
bls = Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *) a.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
False Html -> Html
H.p [Inline]
is [Block]
bs
| Para (Str "☒":Space:is :: [Inline]
is) : bs :: [Block]
bs <- [Block]
bls = Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *) a.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
True Html -> Html
H.p [Inline]
is [Block]
bs
| Bool
otherwise = WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
bls
where
taskListItem :: Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem checked :: Bool
checked constr :: Html -> MarkupM a
constr is :: [Inline]
is bs :: [Block]
bs = do
let checkbox :: Html
checkbox = if Bool
checked
then Html
checkbox' Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.checked ""
else Html
checkbox'
checkbox' :: Html
checkbox' = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ "checkbox" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.disabled "" Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
Html
isContents <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
is
Html
bsContents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
bs
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> MarkupM a
constr (Html
checkbox Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
isContents) MarkupM a -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
bsContents
tableOfContents :: PandocMonad m => WriterOptions -> [Block]
-> StateT WriterState m (Maybe Html)
tableOfContents :: WriterOptions -> [Block] -> StateT WriterState m (Maybe Html)
tableOfContents _ [] = Maybe Html -> StateT WriterState m (Maybe Html)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Html
forall a. Maybe a
Nothing
tableOfContents opts :: WriterOptions
opts sects :: [Block]
sects = do
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
let opts' :: WriterOptions
opts' = case HTMLSlideVariant
slideVariant of
RevealJsSlides ->
WriterOptions
opts{ writerIdentifierPrefix :: Text
writerIdentifierPrefix =
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts }
_ -> WriterOptions
opts
case WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
opts [Block]
sects of
bl :: Block
bl@(BulletList (_:_)) -> Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html)
-> StateT WriterState m Html -> StateT WriterState m (Maybe Html)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts' Block
bl
_ -> Maybe Html -> StateT WriterState m (Maybe Html)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Html
forall a. Maybe a
Nothing
footnoteSection :: PandocMonad m
=> WriterOptions -> [Html] -> StateT WriterState m Html
opts :: WriterOptions
opts notes :: [Html]
notes = do
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
let hrtag :: Html
hrtag = if Bool
html5 then Html
H5.hr else Html
H.hr
Maybe EPUBVersion
epubVersion <- (WriterState -> Maybe EPUBVersion)
-> StateT WriterState m (Maybe EPUBVersion)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
let container :: Html -> Html
container x :: Html
x
| Bool
html5
, Maybe EPUBVersion
epubVersion Maybe EPUBVersion -> Maybe EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion -> Maybe EPUBVersion
forall a. a -> Maybe a
Just EPUBVersion
EPUB3
= Html -> Html
H5.section (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "footnotes"
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute "epub:type" "footnotes" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
| Bool
html5 = Html -> Html
H5.section (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "footnotes"
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute "role" "doc-endnotes"
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
| HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
NoSlides = Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "footnotes slide" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
| Bool
otherwise = Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "footnotes" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
if [Html] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Html]
notes
then Html
forall a. Monoid a => a
mempty
else WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html -> Html
container (WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
hrtag Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Html -> Html
H.ol ([Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
notes Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts) Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts)
parseMailto :: Text -> Maybe (Text, Text)
parseMailto :: Text -> Maybe (Text, Text)
parseMailto s :: Text
s =
case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==':') Text
s of
(xs :: Text
xs,Text -> Maybe (Char, Text)
T.uncons -> Just (':',addr :: Text
addr)) | Text -> Text
T.toLower Text
xs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "mailto" -> do
let (name' :: Text
name', rest :: Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='@') Text
addr
let domain :: Text
domain = Int -> Text -> Text
T.drop 1 Text
rest
(Text, Text) -> Maybe (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name', Text
domain)
_ -> [Char] -> Maybe (Text, Text)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Prelude.fail "not a mailto: URL"
obfuscateLink :: PandocMonad m
=> WriterOptions -> Attr -> Html -> Text
-> StateT WriterState m Html
obfuscateLink :: WriterOptions -> Attr -> Html -> Text -> StateT WriterState m Html
obfuscateLink opts :: WriterOptions
opts attr :: Attr
attr txt :: Html
txt s :: Text
s | WriterOptions -> ObfuscationMethod
writerEmailObfuscation WriterOptions
opts ObfuscationMethod -> ObfuscationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ObfuscationMethod
NoObfuscation =
WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
s) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
txt
obfuscateLink opts :: WriterOptions
opts attr :: Attr
attr (Text -> Text
TL.toStrict (Text -> Text) -> (Html -> Text) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml -> Text
txt) s :: Text
s =
let meth :: ObfuscationMethod
meth = WriterOptions -> ObfuscationMethod
writerEmailObfuscation WriterOptions
opts
s' :: Text
s' = Text -> Text
T.toLower (Int -> Text -> Text
T.take 7 Text
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop 7 Text
s
in case Text -> Maybe (Text, Text)
parseMailto Text
s' of
(Just (name' :: Text
name', domain :: Text
domain)) ->
let domain' :: Text
domain' = Text -> Text -> Text -> Text
T.replace "." " dot " Text
domain
at' :: Text
at' = Char -> Text
obfuscateChar '@'
(linkText :: Text
linkText, altText :: Text
altText) =
if Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Text -> Text
T.drop 7 Text
s'
then ("e", Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
domain')
else ("'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'",
Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
domain' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")")
(_, classNames :: [Text]
classNames, _) = Attr
attr
classNamesStr :: Text
classNamesStr = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
classNames
in case ObfuscationMethod
meth of
ReferenceObfuscation ->
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
Text -> Html
preEscapedText (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ "<a href=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
s'
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\" class=\"email\">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</a>"
JavascriptObfuscation ->
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
(Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ "text/javascript" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
Text -> Html
preEscapedText ("\n<!--\nh='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Text
obfuscateString Text
domain Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "';a='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
at' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "';n='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Text
obfuscateString Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "';e=n+a+h;\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
"document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\" clas'+'s=\"em' + 'ail" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
classNamesStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\">'+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
linkText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "+'<\\/'+'a'+'>');\n// -->\n")) Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Html -> Html
H.noscript (Text -> Html
preEscapedText (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Text
obfuscateString Text
altText)
_ -> PandocError -> StateT WriterState m Html
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT WriterState m Html)
-> PandocError -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ "Unknown obfuscation method: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObfuscationMethod -> Text
forall a. Show a => a -> Text
tshow ObfuscationMethod
meth
_ -> WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
s) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
txt
obfuscateChar :: Char -> Text
obfuscateChar :: Char -> Text
obfuscateChar char :: Char
char =
let num :: Int
num = Char -> Int
ord Char
char
numstr :: [Char]
numstr = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
num then Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num else "x" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Int
num ""
in "&#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
numstr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ";"
obfuscateString :: Text -> Text
obfuscateString :: Text -> Text
obfuscateString = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
obfuscateChar (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fromEntities
tagWithAttributes :: WriterOptions
-> Bool
-> Bool
-> Text
-> Attr
-> Text
tagWithAttributes :: WriterOptions -> Bool -> Bool -> Text -> Attr -> Text
tagWithAttributes opts :: WriterOptions
opts html5 :: Bool
html5 selfClosing :: Bool
selfClosing tagname :: Text
tagname attr :: Attr
attr =
let mktag :: PandocPure Text
mktag = (Text -> Text
TL.toStrict (Text -> Text) -> (Html -> Text) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml (Html -> Text) -> PandocPure Html -> PandocPure Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT WriterState PandocPure Html
-> WriterState -> PandocPure Html
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
(WriterOptions -> Attr -> Html -> StateT WriterState PandocPure Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr (Tag -> Bool -> Html
customLeaf (Text -> Tag
textTag Text
tagname) Bool
selfClosing))
WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
html5 })
in case PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure PandocPure Text
mktag of
Left _ -> Text
forall a. Monoid a => a
mempty
Right t :: Text
t -> Text
t
addAttrs :: PandocMonad m
=> WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs :: WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs opts :: WriterOptions
opts attr :: Attr
attr h :: Html
h = (Html -> Attribute -> Html) -> Html -> [Attribute] -> Html
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (!) Html
h ([Attribute] -> Html)
-> StateT WriterState m [Attribute] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Attr -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts Attr
attr
toAttrs :: PandocMonad m
=> [(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs :: [(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs kvs :: [(Text, Text)]
kvs = do
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
Maybe EPUBVersion
mbEpubVersion <- (WriterState -> Maybe EPUBVersion)
-> StateT WriterState m (Maybe EPUBVersion)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
[Attribute] -> StateT WriterState m [Attribute]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attribute] -> StateT WriterState m [Attribute])
-> [Attribute] -> StateT WriterState m [Attribute]
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Maybe Attribute) -> [(Text, Text)] -> [Attribute]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(x :: Text
x,y :: Text
y) ->
if Bool
html5
then
if Text
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (Set Text
html5Attributes Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> Set Text
rdfaAttributes)
Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':') Text
x
Bool -> Bool -> Bool
|| "data-" Text -> Text -> Bool
`T.isPrefixOf` Text
x
Bool -> Bool -> Bool
|| "aria-" Text -> Text -> Bool
`T.isPrefixOf` Text
x
then Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just (Attribute -> Maybe Attribute) -> Attribute -> Maybe Attribute
forall a b. (a -> b) -> a -> b
$ Tag -> AttributeValue -> Attribute
customAttribute (Text -> Tag
textTag Text
x) (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
y)
else Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just (Attribute -> Maybe Attribute) -> Attribute -> Maybe Attribute
forall a b. (a -> b) -> a -> b
$ Tag -> AttributeValue -> Attribute
customAttribute (Text -> Tag
textTag ("data-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x))
(Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
y)
else
if Maybe EPUBVersion
mbEpubVersion Maybe EPUBVersion -> Maybe EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion -> Maybe EPUBVersion
forall a. a -> Maybe a
Just EPUBVersion
EPUB2 Bool -> Bool -> Bool
&&
Bool -> Bool
not (Text
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (Set Text
html4Attributes Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> Set Text
rdfaAttributes) Bool -> Bool -> Bool
||
"xml:" Text -> Text -> Bool
`T.isPrefixOf` Text
x)
then Maybe Attribute
forall a. Maybe a
Nothing
else Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just (Attribute -> Maybe Attribute) -> Attribute -> Maybe Attribute
forall a b. (a -> b) -> a -> b
$ Tag -> AttributeValue -> Attribute
customAttribute (Text -> Tag
textTag Text
x) (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
y))
[(Text, Text)]
kvs
attrsToHtml :: PandocMonad m
=> WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml :: WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml opts :: WriterOptions
opts (id' :: Text
id',classes' :: [Text]
classes',keyvals :: [(Text, Text)]
keyvals) = do
[Attribute]
attrs <- [(Text, Text)] -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs [(Text, Text)]
keyvals
[Attribute] -> StateT WriterState m [Attribute]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attribute] -> StateT WriterState m [Attribute])
-> [Attribute] -> StateT WriterState m [Attribute]
forall a b. (a -> b) -> a -> b
$
[WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts Text
id' | Bool -> Bool
not (Text -> Bool
T.null Text
id')] [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++
[AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
classes') | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes')] [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++ [Attribute]
attrs
imgAttrsToHtml :: PandocMonad m
=> WriterOptions -> Attr -> StateT WriterState m [Attribute]
imgAttrsToHtml :: WriterOptions -> Attr -> StateT WriterState m [Attribute]
imgAttrsToHtml opts :: WriterOptions
opts attr :: Attr
attr = do
[Attribute]
attrs <- WriterOptions -> Attr -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts (Text
ident,[Text]
cls,[(Text, Text)]
kvs')
[Attribute]
dimattrs <- [(Text, Text)] -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs (Attr -> [(Text, Text)]
dimensionsToAttrList Attr
attr)
[Attribute] -> StateT WriterState m [Attribute]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attribute] -> StateT WriterState m [Attribute])
-> [Attribute] -> StateT WriterState m [Attribute]
forall a b. (a -> b) -> a -> b
$ [Attribute]
attrs [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++ [Attribute]
dimattrs
where
(ident :: Text
ident,cls :: [Text]
cls,kvs :: [(Text, Text)]
kvs) = Attr
attr
kvs' :: [(Text, Text)]
kvs' = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text, Text) -> Bool
forall a b. (Eq a, IsString a) => (a, b) -> Bool
isNotDim [(Text, Text)]
kvs
isNotDim :: (a, b) -> Bool
isNotDim ("width", _) = Bool
False
isNotDim ("height", _) = Bool
False
isNotDim _ = Bool
True
dimensionsToAttrList :: Attr -> [(Text, Text)]
dimensionsToAttrList :: Attr -> [(Text, Text)]
dimensionsToAttrList attr :: Attr
attr = [(Text, Text)] -> [(Text, Text)]
consolidateStyles ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Direction -> [(Text, Text)]
go Direction
Width [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Direction -> [(Text, Text)]
go Direction
Height
where
consolidateStyles :: [(Text, Text)] -> [(Text, Text)]
consolidateStyles :: [(Text, Text)] -> [(Text, Text)]
consolidateStyles xs :: [(Text, Text)]
xs =
case ((Text, Text) -> Bool)
-> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Text, Text) -> Bool
forall a b. (Eq a, IsString a) => (a, b) -> Bool
isStyle [(Text, Text)]
xs of
([], _) -> [(Text, Text)]
xs
(ss :: [(Text, Text)]
ss, rest :: [(Text, Text)]
rest) -> ("style", Text -> [Text] -> Text
T.intercalate ";" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd [(Text, Text)]
ss) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
isStyle :: (a, b) -> Bool
isStyle ("style", _) = Bool
True
isStyle _ = Bool
False
go :: Direction -> [(Text, Text)]
go dir :: Direction
dir = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
(Just (Pixel a :: Integer
a)) -> [(Direction -> Text
forall a. Show a => a -> Text
tshow Direction
dir, Integer -> Text
forall a. Show a => a -> Text
tshow Integer
a)]
(Just x :: Dimension
x) -> [("style", Direction -> Text
forall a. Show a => a -> Text
tshow Direction
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
x)]
Nothing -> []
figure :: PandocMonad m
=> WriterOptions -> Attr -> [Inline] -> (Text, Text)
-> StateT WriterState m Html
figure :: WriterOptions
-> Attr -> [Inline] -> (Text, Text) -> StateT WriterState m Html
figure opts :: WriterOptions
opts attr :: Attr
attr txt :: [Inline]
txt (s :: Text
s,tit :: Text
tit) = do
Html
img <- WriterOptions -> Inline -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Text -> Inline
Str ""] (Text
s,Text
tit))
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
let tocapt :: Html -> Html
tocapt = if Bool
html5
then Html -> Html
H5.figcaption
else Html -> Html
H.p (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "caption"
Html
capt <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
then Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
else Html -> Html
tocapt (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
txt
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ if Bool
html5
then Html -> Html
H5.figure (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat
[WriterOptions -> Html
nl WriterOptions
opts, Html
img, Html
capt, WriterOptions -> Html
nl WriterOptions
opts]
else Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "figure" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat
[WriterOptions -> Html
nl WriterOptions
opts, Html
img, WriterOptions -> Html
nl WriterOptions
opts, Html
capt, WriterOptions -> Html
nl WriterOptions
opts]
adjustNumbers :: WriterOptions -> [Block] -> [Block]
adjustNumbers :: WriterOptions -> [Block] -> [Block]
adjustNumbers opts :: WriterOptions
opts doc :: [Block]
doc =
if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==0) (WriterOptions -> [Int]
writerNumberOffset WriterOptions
opts)
then [Block]
doc
else (Block -> Block) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
go [Block]
doc
where
go :: Block -> Block
go (Header level :: Int
level (ident :: Text
ident,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) lst :: [Inline]
lst) =
Int -> Attr -> [Inline] -> Block
Header Int
level (Text
ident,[Text]
classes,((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (Text, Text)
forall a. (Eq a, IsString a) => (a, Text) -> (a, Text)
fixnum [(Text, Text)]
kvs) [Inline]
lst
go x :: Block
x = Block
x
fixnum :: (a, Text) -> (a, Text)
fixnum ("number",num :: Text
num) = ("number",
[Int] -> Text
showSecNum ([Int] -> Text) -> [Int] -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
(WriterOptions -> [Int]
writerNumberOffset WriterOptions
opts [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat 0)
((Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> (Text -> Maybe Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead) ([Text] -> [Int]) -> [Text] -> [Int]
forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='.') Text
num))
fixnum x :: (a, Text)
x = (a, Text)
x
showSecNum :: [Int] -> Text
showSecNum = Text -> [Text] -> Text
T.intercalate "." ([Text] -> Text) -> ([Int] -> [Text]) -> [Int] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow
blockToHtml :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html
blockToHtml :: WriterOptions -> Block -> StateT WriterState m Html
blockToHtml _ Null = Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
blockToHtml opts :: WriterOptions
opts (Plain lst :: [Inline]
lst) = WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
blockToHtml opts :: WriterOptions
opts (Para [Image attr :: Attr
attr@(_,classes :: [Text]
classes,_) txt :: [Inline]
txt (src :: Text
src,tit :: Text
tit)])
| "stretch" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
case HTMLSlideVariant
slideVariant of
RevealJsSlides ->
WriterOptions -> Inline -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
txt (Text
src, Text
tit))
_ -> WriterOptions
-> Attr -> [Inline] -> (Text, Text) -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Attr -> [Inline] -> (Text, Text) -> StateT WriterState m Html
figure WriterOptions
opts Attr
attr [Inline]
txt (Text
src, Text
tit)
blockToHtml opts :: WriterOptions
opts (Para [Image attr :: Attr
attr txt :: [Inline]
txt (s :: Text
s,Text -> Text -> Maybe Text
T.stripPrefix "fig:" -> Just tit :: Text
tit)]) =
WriterOptions
-> Attr -> [Inline] -> (Text, Text) -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Attr -> [Inline] -> (Text, Text) -> StateT WriterState m Html
figure WriterOptions
opts Attr
attr [Inline]
txt (Text
s,Text
tit)
blockToHtml opts :: WriterOptions
opts (Para lst :: [Inline]
lst) = do
Html
contents <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
case Html
contents of
Empty _ | Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs WriterOptions
opts) -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
_ -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.p Html
contents
blockToHtml opts :: WriterOptions
opts (LineBlock lns :: [[Inline]]
lns) =
if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapNone
then WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts (Block -> StateT WriterState m Html)
-> Block -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
else do
Html
htmlLines <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts ([Inline] -> StateT WriterState m Html)
-> [Inline] -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
lns
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "line-block" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
htmlLines
blockToHtml opts :: WriterOptions
opts (Div (ident :: Text
ident, "section":dclasses :: [Text]
dclasses, dkvs :: [(Text, Text)]
dkvs)
(Header level :: Int
level
hattr :: Attr
hattr@(hident :: Text
hident,hclasses :: [Text]
hclasses,hkvs :: [(Text, Text)]
hkvs) ils :: [Inline]
ils : xs :: [Block]
xs)) = do
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
Int
slideLevel <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stSlideLevel
let slide :: Bool
slide = HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
NoSlides Bool -> Bool -> Bool
&&
Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
slideLevel
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
let titleSlide :: Bool
titleSlide = Bool
slide Bool -> Bool -> Bool
&& Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
slideLevel
let level' :: Int
level' = if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
slideLevel Bool -> Bool -> Bool
&& HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
SlidySlides
then 1
else Int
level
Html
header' <- if [Inline]
ils [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str "\0"]
then Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
else WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts (Int -> Attr -> [Inline] -> Block
Header Int
level' Attr
hattr [Inline]
ils)
let isSec :: Block -> Bool
isSec (Div (_,"section":_,_) _) = Bool
True
isSec (Div _ zs :: [Block]
zs) = (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isSec [Block]
zs
isSec _ = Bool
False
let isPause :: Block -> Bool
isPause (Para [Str ".",Space,Str ".",Space,Str "."]) = Bool
True
isPause _ = Bool
False
let fragmentClass :: Text
fragmentClass = case HTMLSlideVariant
slideVariant of
RevealJsSlides -> "fragment"
_ -> "incremental"
let inDiv :: [Block] -> [Block]
inDiv zs :: [Block]
zs = Format -> Text -> Block
RawBlock (Text -> Format
Format "html") ("<div class=\""
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fragmentClass Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\">") Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:
([Block]
zs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Format -> Text -> Block
RawBlock (Text -> Format
Format "html") "</div>"])
let breakOnPauses :: [Block] -> [Block]
breakOnPauses zs :: [Block]
zs = case (Block -> Bool) -> [Block] -> [[Block]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy Block -> Bool
isPause [Block]
zs of
[] -> []
y :: [Block]
y:ys :: [[Block]]
ys -> [Block]
y [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ ([Block] -> [Block]) -> [[Block]] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Block] -> [Block]
inDiv [[Block]]
ys
let (titleBlocks :: [Block]
titleBlocks, innerSecs :: [Block]
innerSecs) =
if Bool
titleSlide
then let (as :: [Block]
as, bs :: [Block]
bs) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isSec [Block]
xs
in ([Block] -> [Block]
breakOnPauses [Block]
as, [Block]
bs)
else ([], [Block] -> [Block]
breakOnPauses [Block]
xs)
let secttag :: Html -> Html
secttag = if Bool
html5
then Html -> Html
H5.section
else Html -> Html
H.div
Html
titleContents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
titleBlocks
Bool
inSection <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInSection
Html
innerContents <- do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stInSection :: Bool
stInSection = Bool
True }
Html
res <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
innerSecs
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stInSection :: Bool
stInSection = Bool
inSection }
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
res
let classes' :: [Text]
classes' = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
["title-slide" | Bool
titleSlide] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ["slide" | Bool
slide] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
["section" | (Bool
slide Bool -> Bool -> Bool
|| WriterOptions -> Bool
writerSectionDivs WriterOptions
opts) Bool -> Bool -> Bool
&&
Bool -> Bool
not Bool
html5 ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
["level" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
level | Bool
slide Bool -> Bool -> Bool
|| WriterOptions -> Bool
writerSectionDivs WriterOptions
opts ]
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
dclasses
let attr :: Attr
attr = (Text
ident, [Text]
classes', [(Text, Text)]
dkvs)
if Bool
titleSlide
then do
Html
t <- WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
Html -> Html
secttag (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
header' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
titleContents Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Html
nl WriterOptions
opts
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
if HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inSection Bool -> Bool -> Bool
&&
Bool -> Bool
not ([Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
innerSecs)
then Html -> Html
H5.section (WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
t Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
innerContents)
else Html
t Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
innerSecs
then Html
forall a. Monoid a => a
mempty
else Html
innerContents Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Html
nl WriterOptions
opts
else if WriterOptions -> Bool
writerSectionDivs WriterOptions
opts Bool -> Bool -> Bool
|| Bool
slide Bool -> Bool -> Bool
||
(Text
hident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
ident Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
hident Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
ident)) Bool -> Bool -> Bool
||
([Text]
hclasses [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text]
dclasses) Bool -> Bool -> Bool
|| ([(Text, Text)]
hkvs [(Text, Text)] -> [(Text, Text)] -> Bool
forall a. Eq a => a -> a -> Bool
/= [(Text, Text)]
dkvs)
then WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr
(Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
secttag
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
header' Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>
if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
innerSecs
then Html
forall a. Monoid a => a
mempty
else Html
innerContents Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Html
nl WriterOptions
opts
else do
let attr' :: Attr
attr' = (Text
ident, [Text]
classes' [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
hclasses, [(Text, Text)]
dkvs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Text, Text)]
hkvs)
Html
t <- WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr' Html
header'
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html
t Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>
if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
innerSecs
then Html
forall a. Monoid a => a
mempty
else WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
innerContents
blockToHtml opts :: WriterOptions
opts (Div attr :: Attr
attr@(ident :: Text
ident, classes :: [Text]
classes, kvs' :: [(Text, Text)]
kvs') bs :: [Block]
bs) = do
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
let kvs :: [(Text, Text)]
kvs = [(Text
k,Text
v) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs', Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "width"] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("style", "width:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ";") | "column" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes,
("width", w :: Text
w) <- [(Text, Text)]
kvs'] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("role", "doc-bibliography") | Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "refs" Bool -> Bool -> Bool
&& Bool
html5] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("role", "doc-biblioentry")
| "ref-item" Text -> Text -> Bool
`T.isPrefixOf` Text
ident Bool -> Bool -> Bool
&& Bool
html5]
let speakerNotes :: Bool
speakerNotes = "notes" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
let opts' :: WriterOptions
opts' = if | Bool
speakerNotes -> WriterOptions
opts{ writerIncremental :: Bool
writerIncremental = Bool
False }
| "incremental" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> WriterOptions
opts{ writerIncremental :: Bool
writerIncremental = Bool
True }
| "nonincremental" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> WriterOptions
opts{ writerIncremental :: Bool
writerIncremental = Bool
False }
| Bool
otherwise -> WriterOptions
opts
classes' :: [Text]
classes' = case HTMLSlideVariant
slideVariant of
NoSlides -> [Text]
classes
_ -> (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\k :: Text
k -> Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "incremental" Bool -> Bool -> Bool
&& Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "nonincremental") [Text]
classes
Html
contents <- if "columns" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes'
then
[Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html)
-> StateT WriterState m [Html] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m Html)
-> [Block] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts) [Block]
bs
else WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts' [Block]
bs
let contents' :: Html
contents' = WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
let (divtag :: Html -> Html
divtag, classes'' :: [Text]
classes'') = if Bool
html5 Bool -> Bool -> Bool
&& "section" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes'
then (Html -> Html
H5.section, (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "section") [Text]
classes')
else (Html -> Html
H.div, [Text]
classes')
if Bool
speakerNotes
then case HTMLSlideVariant
slideVariant of
RevealJsSlides -> WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts' Attr
attr (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
Html -> Html
H5.aside Html
contents'
DZSlides -> do
Html
t <- WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts' Attr
attr (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
Html -> Html
H5.div Html
contents'
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html
t Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
H5.customAttribute "role" "note"
NoSlides -> WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts' Attr
attr (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
Html -> Html
H.div Html
contents'
_ -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
else WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ident, [Text]
classes'', [(Text, Text)]
kvs) (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
Html -> Html
divtag Html
contents'
blockToHtml opts :: WriterOptions
opts (RawBlock f :: Format
f str :: Text
str) = do
Bool
ishtml <- Format -> StateT WriterState m Bool
forall (m :: * -> *).
PandocMonad m =>
Format -> StateT WriterState m Bool
isRawHtml Format
f
if Bool
ishtml
then Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
preEscapedText Text
str
else if (Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "tex") Bool -> Bool -> Bool
&&
HTMLMathMethod -> Bool
allowsMathEnvironments (WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts) Bool -> Bool -> Bool
&&
Text -> Bool
isMathEnvironment Text
str
then WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts (Block -> StateT WriterState m Html)
-> Block -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Plain [MathType -> Text -> Inline
Math MathType
DisplayMath Text
str]
else do
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered (Format -> Text -> Block
RawBlock Format
f Text
str)
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
blockToHtml _ HorizontalRule = do
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ if Bool
html5 then Html
H5.hr else Html
H.hr
blockToHtml opts :: WriterOptions
opts (CodeBlock (id' :: Text
id',classes :: [Text]
classes,keyvals :: [(Text, Text)]
keyvals) rawCode :: Text
rawCode) = do
Text
id'' <- if Text -> Bool
T.null Text
id'
then do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stCodeBlockNum :: Int
stCodeBlockNum = WriterState -> Int
stCodeBlockNum WriterState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 }
Int
codeblocknum <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stCodeBlockNum
Text -> StateT WriterState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "cb" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
codeblocknum)
else Text -> StateT WriterState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id')
let tolhs :: Bool
tolhs = Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts Bool -> Bool -> Bool
&&
(Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\c :: Text
c -> Text -> Text
T.toLower Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "haskell") [Text]
classes Bool -> Bool -> Bool
&&
(Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\c :: Text
c -> Text -> Text
T.toLower Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "literate") [Text]
classes
classes' :: [Text]
classes' = if Bool
tolhs
then (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Text
c -> if Text -> Text
T.toLower Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "haskell"
then "literatehaskell"
else Text
c) [Text]
classes
else [Text]
classes
adjCode :: Text
adjCode = if Bool
tolhs
then [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
rawCode
else Text
rawCode
hlCode :: Either Text Html
hlCode = if Maybe Style -> Bool
forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
then SyntaxMap
-> (FormatOptions -> [SourceLine] -> Html)
-> Attr
-> Text
-> Either Text Html
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts) FormatOptions -> [SourceLine] -> Html
formatHtmlBlock
(Text
id'',[Text]
classes',[(Text, Text)]
keyvals) Text
adjCode
else Text -> Either Text Html
forall a b. a -> Either a b
Left ""
case Either Text Html
hlCode of
Left msg :: Text
msg -> do
Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
id',[Text]
classes,[(Text, Text)]
keyvals)
(Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.pre (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.code (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
adjCode
Right h :: Html
h -> (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True }) StateT WriterState m ()
-> StateT WriterState m Html -> StateT WriterState m Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts{writerIdentifierPrefix :: Text
writerIdentifierPrefix = ""} (Text
id'',[],[(Text, Text)]
keyvals) Html
h
blockToHtml opts :: WriterOptions
opts (BlockQuote blocks :: [Block]
blocks) = do
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
if HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
NoSlides
then let inc :: Bool
inc = Bool -> Bool
not (WriterOptions -> Bool
writerIncremental WriterOptions
opts) in
case [Block]
blocks of
[BulletList lst :: [[Block]]
lst] -> WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml (WriterOptions
opts {writerIncremental :: Bool
writerIncremental = Bool
inc})
([[Block]] -> Block
BulletList [[Block]]
lst)
[OrderedList attribs :: ListAttributes
attribs lst :: [[Block]]
lst] ->
WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml (WriterOptions
opts {writerIncremental :: Bool
writerIncremental = Bool
inc})
(ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attribs [[Block]]
lst)
[DefinitionList lst :: [([Inline], [[Block]])]
lst] ->
WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml (WriterOptions
opts {writerIncremental :: Bool
writerIncremental = Bool
inc})
([([Inline], [[Block]])] -> Block
DefinitionList [([Inline], [[Block]])]
lst)
_ -> do Html
contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.blockquote
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
else do
Html
contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.blockquote (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
blockToHtml opts :: WriterOptions
opts (Header level :: Int
level attr :: Attr
attr@(_,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) lst :: [Inline]
lst) = do
Html
contents <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
let secnum :: Text
secnum = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "number" [(Text, Text)]
kvs
let contents' :: Html
contents' = if WriterOptions -> Bool
writerNumberSections WriterOptions
opts Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
secnum)
Bool -> Bool -> Bool
&& "unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes
then (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "header-section-number"
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
secnum) Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Html
strToHtml " " Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents
else Html
contents
WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr
(Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ case Int
level of
1 -> Html -> Html
H.h1 Html
contents'
2 -> Html -> Html
H.h2 Html
contents'
3 -> Html -> Html
H.h3 Html
contents'
4 -> Html -> Html
H.h4 Html
contents'
5 -> Html -> Html
H.h5 Html
contents'
6 -> Html -> Html
H.h6 Html
contents'
_ -> Html -> Html
H.p (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "heading" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
contents'
blockToHtml opts :: WriterOptions
opts (BulletList lst :: [[Block]]
lst) = do
[Html]
contents <- ([Block] -> StateT WriterState m Html)
-> [[Block]] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml WriterOptions
opts) [[Block]]
lst
let isTaskList :: Bool
isTaskList = Bool -> Bool
not ([[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
lst) Bool -> Bool -> Bool
&& ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isTaskListItem [[Block]]
lst
(if Bool
isTaskList then (Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "task-list") else Html -> Html
forall a. a -> a
id) (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
unordList WriterOptions
opts [Html]
contents
blockToHtml opts :: WriterOptions
opts (OrderedList (startnum :: Int
startnum, numstyle :: ListNumberStyle
numstyle, _) lst :: [[Block]]
lst) = do
[Html]
contents <- ([Block] -> StateT WriterState m Html)
-> [[Block]] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml WriterOptions
opts) [[Block]]
lst
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
let numstyle' :: Text
numstyle' = case ListNumberStyle
numstyle of
Example -> "decimal"
_ -> Text -> Text
camelCaseToHyphenated (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ListNumberStyle -> Text
forall a. Show a => a -> Text
tshow ListNumberStyle
numstyle
let attribs :: [Attribute]
attribs = [AttributeValue -> Attribute
A.start (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ Int -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Int
startnum | Int
startnum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1] [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++
[AttributeValue -> Attribute
A.class_ "example" | ListNumberStyle
numstyle ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
Example] [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++
(if ListNumberStyle
numstyle ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
/= ListNumberStyle
DefaultStyle
then if Bool
html5
then [AttributeValue -> Attribute
A.type_ (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$
case ListNumberStyle
numstyle of
Decimal -> "1"
LowerAlpha -> "a"
UpperAlpha -> "A"
LowerRoman -> "i"
UpperRoman -> "I"
_ -> "1"]
else [AttributeValue -> Attribute
A.style (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ "list-style-type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
numstyle']
else [])
Html
l <- WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
ordList WriterOptions
opts [Html]
contents
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ (Html -> Attribute -> Html) -> Html -> [Attribute] -> Html
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (!) Html
l [Attribute]
attribs
blockToHtml opts :: WriterOptions
opts (DefinitionList lst :: [([Inline], [[Block]])]
lst) = do
[Html]
contents <- (([Inline], [[Block]]) -> StateT WriterState m Html)
-> [([Inline], [[Block]])] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(term :: [Inline]
term, defs :: [[Block]]
defs) ->
do Html
term' <- (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Html -> Html
H.dt (StateT WriterState m Html -> StateT WriterState m Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
term
[Html]
defs' <- ([Block] -> StateT WriterState m Html)
-> [[Block]] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\x :: Html
x -> Html -> Html
H.dd (Html
x Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts)) (StateT WriterState m Html -> StateT WriterState m Html)
-> ([Block] -> StateT WriterState m Html)
-> [Block]
-> StateT WriterState m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts) [[Block]]
defs
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Html
nl WriterOptions
opts Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Html
term' Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: WriterOptions -> Html
nl WriterOptions
opts Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
:
Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse (WriterOptions -> Html
nl WriterOptions
opts) [Html]
defs') [([Inline], [[Block]])]
lst
WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
defList WriterOptions
opts [Html]
contents
blockToHtml opts :: WriterOptions
opts (Table capt :: [Inline]
capt aligns :: [Alignment]
aligns widths :: [Double]
widths headers :: [[Block]]
headers rows' :: [[[Block]]]
rows') = do
Html
captionDoc <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
capt
then Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
else do
Html
cs <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
capt
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.caption Html
cs Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
let percent :: a -> [Char]
percent w :: a
w = Integer -> [Char]
forall a. Show a => a -> [Char]
show (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (100a -> a -> a
forall a. Num a => a -> a -> a
*a
w) :: Integer) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> "%"
let coltags :: Html
coltags = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== 0.0) [Double]
widths
then Html
forall a. Monoid a => a
mempty
else do
Html -> Html
H.colgroup (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
WriterOptions -> Html
nl WriterOptions
opts
(Double -> Html) -> [Double] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\w :: Double
w -> do
if Bool
html5
then Html
H.col Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.style ([Char] -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue ([Char] -> AttributeValue) -> [Char] -> AttributeValue
forall a b. (a -> b) -> a -> b
$ "width: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
Double -> [Char]
forall a. RealFrac a => a -> [Char]
percent Double
w)
else Html
H.col Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.width ([Char] -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue ([Char] -> AttributeValue) -> [Char] -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. RealFrac a => a -> [Char]
percent Double
w)
WriterOptions -> Html
nl WriterOptions
opts) [Double]
widths
WriterOptions -> Html
nl WriterOptions
opts
Html
head' <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
else do
Html
contents <- WriterOptions
-> [Alignment] -> Int -> [[Block]] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> [Alignment] -> Int -> [[Block]] -> StateT WriterState m Html
tableRowToHtml WriterOptions
opts [Alignment]
aligns 0 [[Block]]
headers
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.thead (WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents) Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
Html
body' <- ([Html] -> Html)
-> StateT WriterState m [Html] -> StateT WriterState m Html
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\x :: [Html]
x -> Html -> Html
H.tbody (WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
x)) (StateT WriterState m [Html] -> StateT WriterState m Html)
-> StateT WriterState m [Html] -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
(Int -> [[Block]] -> StateT WriterState m Html)
-> [Int] -> [[[Block]]] -> StateT WriterState m [Html]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (WriterOptions
-> [Alignment] -> Int -> [[Block]] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> [Alignment] -> Int -> [[Block]] -> StateT WriterState m Html
tableRowToHtml WriterOptions
opts [Alignment]
aligns) [1..] [[[Block]]]
rows'
let tbl :: Html
tbl = Html -> Html
H.table (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
captionDoc Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
coltags Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
head' Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
body' Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
let totalWidth :: Double
totalWidth = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ if Double
totalWidth Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Double
totalWidth Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== 1
then Html
tbl
else Html
tbl Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.style ([Char] -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue ([Char] -> AttributeValue) -> [Char] -> AttributeValue
forall a b. (a -> b) -> a -> b
$ "width:" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
Int -> [Char]
forall a. Show a => a -> [Char]
show (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
totalWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* 100) :: Int) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> "%;")
tableRowToHtml :: PandocMonad m
=> WriterOptions
-> [Alignment]
-> Int
-> [[Block]]
-> StateT WriterState m Html
tableRowToHtml :: WriterOptions
-> [Alignment] -> Int -> [[Block]] -> StateT WriterState m Html
tableRowToHtml opts :: WriterOptions
opts aligns :: [Alignment]
aligns rownum :: Int
rownum cols' :: [[Block]]
cols' = do
let mkcell :: Html -> Html
mkcell = if Int
rownum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Html -> Html
H.th else Html -> Html
H.td
let rowclass :: AttributeValue
rowclass = case Int
rownum of
0 -> "header"
x :: Int
x | Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` 2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> "odd"
_ -> "even"
[Html]
cols'' <- (Alignment -> [Block] -> StateT WriterState m Html)
-> [Alignment] -> [[Block]] -> StateT WriterState m [Html]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
(\alignment :: Alignment
alignment item :: [Block]
item -> WriterOptions
-> (Html -> Html)
-> Alignment
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (Html -> Html)
-> Alignment
-> [Block]
-> StateT WriterState m Html
tableItemToHtml WriterOptions
opts Html -> Html
mkcell Alignment
alignment [Block]
item)
[Alignment]
aligns [[Block]]
cols'
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ (Html -> Html
H.tr (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
rowclass (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
cols'')
Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
alignmentToString :: Alignment -> [Char]
alignmentToString :: Alignment -> [Char]
alignmentToString alignment :: Alignment
alignment = case Alignment
alignment of
AlignLeft -> "left"
AlignRight -> "right"
AlignCenter -> "center"
AlignDefault -> ""
tableItemToHtml :: PandocMonad m
=> WriterOptions
-> (Html -> Html)
-> Alignment
-> [Block]
-> StateT WriterState m Html
tableItemToHtml :: WriterOptions
-> (Html -> Html)
-> Alignment
-> [Block]
-> StateT WriterState m Html
tableItemToHtml opts :: WriterOptions
opts tag' :: Html -> Html
tag' align' :: Alignment
align' item :: [Block]
item = do
Html
contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
item
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
let alignStr :: [Char]
alignStr = Alignment -> [Char]
alignmentToString Alignment
align'
let attribs :: Attribute
attribs = if Bool
html5
then AttributeValue -> Attribute
A.style ([Char] -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue ([Char] -> AttributeValue) -> [Char] -> AttributeValue
forall a b. (a -> b) -> a -> b
$ "text-align: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
alignStr [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ";")
else AttributeValue -> Attribute
A.align ([Char] -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue [Char]
alignStr)
let tag'' :: Html -> Html
tag'' = if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
alignStr
then Html -> Html
tag'
else Html -> Html
tag' (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Attribute
attribs
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
tag'' Html
contents Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> Html
nl WriterOptions
opts
toListItems :: WriterOptions -> [Html] -> [Html]
toListItems :: WriterOptions -> [Html] -> [Html]
toListItems opts :: WriterOptions
opts items :: [Html]
items = (Html -> Html) -> [Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (WriterOptions -> Html -> Html
toListItem WriterOptions
opts) [Html]
items [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [WriterOptions -> Html
nl WriterOptions
opts]
toListItem :: WriterOptions -> Html -> Html
toListItem :: WriterOptions -> Html -> Html
toListItem opts :: WriterOptions
opts item :: Html
item = WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html -> Html
H.li Html
item
blockListToHtml :: PandocMonad m
=> WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml :: WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml opts :: WriterOptions
opts lst :: [Block]
lst =
[Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Html] -> [Html]) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse (WriterOptions -> Html
nl WriterOptions
opts) ([Html] -> [Html]) -> ([Html] -> [Html]) -> [Html] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Bool) -> [Html] -> [Html]
forall a. (a -> Bool) -> [a] -> [a]
filter Html -> Bool
forall a. MarkupM a -> Bool
nonempty
([Html] -> Html)
-> StateT WriterState m [Html] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m Html)
-> [Block] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts) [Block]
lst
where nonempty :: MarkupM a -> Bool
nonempty (Empty _) = Bool
False
nonempty _ = Bool
True
inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml :: WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml opts :: WriterOptions
opts lst :: [Inline]
lst = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html)
-> StateT WriterState m [Html] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT WriterState m Html)
-> [Inline] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Inline -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts) [Inline]
lst
annotateMML :: XML.Element -> Text -> XML.Element
annotateMML :: Element -> Text -> Element
annotateMML e :: Element
e tex :: Text
tex = Element -> Element
math ([Char] -> [Element] -> Element
forall t. Node t => [Char] -> t -> Element
unode "semantics" [Element
cs, [Char] -> ([Attr], [Char]) -> Element
forall t. Node t => [Char] -> t -> Element
unode "annotation" ([Attr]
annotAttrs, Text -> [Char]
T.unpack Text
tex)])
where
cs :: Element
cs = case Element -> [Element]
elChildren Element
e of
[] -> [Char] -> () -> Element
forall t. Node t => [Char] -> t -> Element
unode "mrow" ()
[x :: Element
x] -> Element
x
xs :: [Element]
xs -> [Char] -> [Element] -> Element
forall t. Node t => [Char] -> t -> Element
unode "mrow" [Element]
xs
math :: Element -> Element
math childs :: Element
childs = QName -> [Attr] -> [Content] -> Maybe Integer -> Element
XML.Element QName
q [Attr]
as [Element -> Content
XML.Elem Element
childs] Maybe Integer
l
where
(XML.Element q :: QName
q as :: [Attr]
as _ l :: Maybe Integer
l) = Element
e
annotAttrs :: [Attr]
annotAttrs = [QName -> [Char] -> Attr
XML.Attr ([Char] -> QName
unqual "encoding") "application/x-tex"]
inlineToHtml :: PandocMonad m
=> WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml :: WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml opts :: WriterOptions
opts inline :: Inline
inline = do
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
case Inline
inline of
(Str str :: Text
str) -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
strToHtml Text
str
Space -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
strToHtml " "
SoftBreak -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
WrapNone -> Text -> Html
preEscapedText " "
WrapAuto -> Text -> Html
preEscapedText " "
WrapPreserve -> Text -> Html
preEscapedText "\n"
LineBreak -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ do
if Bool
html5 then Html
H5.br else Html
H.br
Text -> Html
strToHtml "\n"
(Span (id' :: Text
id',classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) ils :: [Inline]
ils) ->
let spanLikeTag :: Maybe (Html -> Html)
spanLikeTag = case [Text]
classes of
(c :: Text
c:_) -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
c Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
htmlSpanLikeElements)
(Html -> Html) -> Maybe (Html -> Html)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Html -> Html) -> Maybe (Html -> Html))
-> (Html -> Html) -> Maybe (Html -> Html)
forall a b. (a -> b) -> a -> b
$ Tag -> Html -> Html
customParent (Text -> Tag
textTag Text
c)
_ -> Maybe (Html -> Html)
forall a. Maybe a
Nothing
in case Maybe (Html -> Html)
spanLikeTag of
Just tag :: Html -> Html
tag -> do
Html
h <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils
WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
id',[Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
classes',[(Text, Text)]
kvs') (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
tag Html
h
Nothing -> do
Html
h <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils
WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
id',[Text]
classes',[(Text, Text)]
kvs') (Html -> Html
H.span Html
h)
where
styles :: [Text]
styles = ["font-style:normal;"
| "csl-no-emph" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ["font-weight:normal;"
| "csl-no-strong" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ["font-variant:normal;"
| "csl-no-smallcaps" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
kvs' :: [(Text, Text)]
kvs' = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
styles
then [(Text, Text)]
kvs
else ("style", [Text] -> Text
T.concat [Text]
styles) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
classes' :: [Text]
classes' = [ Text
c | Text
c <- [Text]
classes
, Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ "csl-no-emph"
, "csl-no-strong"
, "csl-no-smallcaps"
]
]
(Emph lst :: [Inline]
lst) -> Html -> Html
H.em (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
(Strong lst :: [Inline]
lst) -> Html -> Html
H.strong (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
(Code attr :: Attr
attr@(ids :: Text
ids,cs :: [Text]
cs,kvs :: [(Text, Text)]
kvs) str :: Text
str)
-> case Either Text Html
hlCode of
Left msg :: Text
msg -> do
Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ids,[Text]
cs',[(Text, Text)]
kvs) (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
(Html -> Html) -> Maybe (Html -> Html) -> Html -> Html
forall a. a -> Maybe a -> a
fromMaybe Html -> Html
H.code Maybe (Html -> Html)
sampOrVar (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
Text -> Html
strToHtml Text
str
Right h :: Html
h -> do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True }
WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ids,[],[(Text, Text)]
kvs) (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
(Html -> Html) -> Maybe (Html -> Html) -> Html -> Html
forall a. a -> Maybe a -> a
fromMaybe Html -> Html
forall a. a -> a
id Maybe (Html -> Html)
sampOrVar Html
h
where hlCode :: Either Text Html
hlCode = if Maybe Style -> Bool
forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
then SyntaxMap
-> (FormatOptions -> [SourceLine] -> Html)
-> Attr
-> Text
-> Either Text Html
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight
(WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts)
FormatOptions -> [SourceLine] -> Html
formatHtmlInline Attr
attr Text
str
else Text -> Either Text Html
forall a b. a -> Either a b
Left ""
(sampOrVar :: Maybe (Html -> Html)
sampOrVar,cs' :: [Text]
cs')
| "sample" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cs =
((Html -> Html) -> Maybe (Html -> Html)
forall a. a -> Maybe a
Just Html -> Html
H.samp,"sample" Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
`delete` [Text]
cs)
| "variable" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cs =
((Html -> Html) -> Maybe (Html -> Html)
forall a. a -> Maybe a
Just Html -> Html
H.var,"variable" Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
`delete` [Text]
cs)
| Bool
otherwise = (Maybe (Html -> Html)
forall a. Maybe a
Nothing,[Text]
cs)
(Strikeout lst :: [Inline]
lst) -> Html -> Html
H.del (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
(SmallCaps lst :: [Inline]
lst) -> (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "smallcaps") (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
(Superscript lst :: [Inline]
lst) -> Html -> Html
H.sup (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
(Subscript lst :: [Inline]
lst) -> Html -> Html
H.sub (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
(Quoted quoteType :: QuoteType
quoteType lst :: [Inline]
lst) ->
let (leftQuote :: Html
leftQuote, rightQuote :: Html
rightQuote) = case QuoteType
quoteType of
SingleQuote -> (Text -> Html
strToHtml "‘",
Text -> Html
strToHtml "’")
DoubleQuote -> (Text -> Html
strToHtml "“",
Text -> Html
strToHtml "”")
in if WriterOptions -> Bool
writerHtmlQTags WriterOptions
opts
then do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stQuotes :: Bool
stQuotes = Bool
True }
let (maybeAttr :: Maybe Attr
maybeAttr, lst' :: [Inline]
lst') = case [Inline]
lst of
[Span attr :: Attr
attr@(_, _, kvs :: [(Text, Text)]
kvs) cs :: [Inline]
cs]
| ((Text, Text) -> Bool) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
=="cite") (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
kvs
-> (Attr -> Maybe Attr
forall a. a -> Maybe a
Just Attr
attr, [Inline]
cs)
cs :: [Inline]
cs -> (Maybe Attr
forall a. Maybe a
Nothing, [Inline]
cs)
Html -> Html
H.q (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst'
StateT WriterState m Html
-> (Html -> StateT WriterState m Html) -> StateT WriterState m Html
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Html -> StateT WriterState m Html)
-> (Attr -> Html -> StateT WriterState m Html)
-> Maybe Attr
-> Html
-> StateT WriterState m Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts) Maybe Attr
maybeAttr
else (\x :: Html
x -> Html
leftQuote Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
x Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
rightQuote)
(Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
(Math t :: MathType
t str :: Text
str) -> do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: WriterState
st -> WriterState
st {stMath :: Bool
stMath = Bool
True})
let mathClass :: AttributeValue
mathClass = Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ ("math " :: Text) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
if MathType
t MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
InlineMath then "inline" else "display"
case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
WebTeX url :: Text
url -> do
let imtag :: Html
imtag = if Bool
html5 then Html
H5.img else Html
H.img
let s :: Text
s = case MathType
t of
InlineMath -> "\\textstyle "
DisplayMath -> "\\displaystyle "
let m :: Html
m = Html
imtag Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.style "vertical-align:middle"
Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([Char] -> [Char]
urlEncode (Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str)))
Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.alt (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
str)
Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
str)
let brtag :: Html
brtag = if Bool
html5 then Html
H5.br else Html
H.br
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ case MathType
t of
InlineMath -> Html
m
DisplayMath -> Html
brtag Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
m Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
brtag
GladTeX ->
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
Tag -> Html -> Html
customParent (Text -> Tag
textTag "eq") (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
!
Tag -> AttributeValue -> Attribute
customAttribute "env"
(Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ if MathType
t MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
InlineMath
then ("math" :: Text)
else "displaymath") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
strToHtml Text
str
MathML -> do
let conf :: ConfigPP
conf = (QName -> Bool) -> ConfigPP -> ConfigPP
useShortEmptyTags (Bool -> QName -> Bool
forall a b. a -> b -> a
const Bool
False)
ConfigPP
defaultConfigPP
Either Inline Element
res <- m (Either Inline Element)
-> StateT WriterState m (Either Inline Element)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either Inline Element)
-> StateT WriterState m (Either Inline Element))
-> m (Either Inline Element)
-> StateT WriterState m (Either Inline Element)
forall a b. (a -> b) -> a -> b
$ (DisplayType -> [Exp] -> Element)
-> MathType -> Text -> m (Either Inline Element)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeMathML MathType
t Text
str
case Either Inline Element
res of
Right r :: Element
r -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
preEscapedString ([Char] -> Html) -> [Char] -> Html
forall a b. (a -> b) -> a -> b
$
ConfigPP -> Element -> [Char]
ppcElement ConfigPP
conf (Element -> Text -> Element
annotateMML Element
r Text
str)
Left il :: Inline
il -> (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass) (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> Inline -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts Inline
il
MathJax _ -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$
case MathType
t of
InlineMath -> "\\(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\)"
DisplayMath -> "\\[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\]"
KaTeX _ -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$
case MathType
t of
InlineMath -> Text
str
DisplayMath -> Text
str
PlainMath -> do
Html
x <- m [Inline] -> StateT WriterState m [Inline]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MathType -> Text -> m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str) StateT WriterState m [Inline]
-> ([Inline] -> StateT WriterState m Html)
-> StateT WriterState m Html
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts
let m :: Html
m = Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
let brtag :: Html
brtag = if Bool
html5 then Html
H5.br else Html
H.br
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ case MathType
t of
InlineMath -> Html
m
DisplayMath -> Html
brtag Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
m Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
brtag
(RawInline f :: Format
f str :: Text
str) -> do
Bool
ishtml <- Format -> StateT WriterState m Bool
forall (m :: * -> *).
PandocMonad m =>
Format -> StateT WriterState m Bool
isRawHtml Format
f
if Bool
ishtml
then Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
preEscapedText Text
str
else if (Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "tex") Bool -> Bool -> Bool
&&
HTMLMathMethod -> Bool
allowsMathEnvironments (WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts) Bool -> Bool -> Bool
&&
Text -> Bool
isMathEnvironment Text
str
then WriterOptions -> Inline -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts (Inline -> StateT WriterState m Html)
-> Inline -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ MathType -> Text -> Inline
Math MathType
DisplayMath Text
str
else do
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
inline
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
(Link attr :: Attr
attr txt :: [Inline]
txt (s :: Text
s,_)) | "mailto:" Text -> Text -> Bool
`T.isPrefixOf` Text
s -> do
Html
linkText <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
txt
WriterOptions -> Attr -> Html -> Text -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> Text -> StateT WriterState m Html
obfuscateLink WriterOptions
opts Attr
attr Html
linkText Text
s
(Link (ident :: Text
ident,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) txt :: [Inline]
txt (s :: Text
s,tit :: Text
tit)) -> do
Html
linkText <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
txt
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
let s' :: Text
s' = case Text -> Maybe (Char, Text)
T.uncons Text
s of
Just ('#',xs :: Text
xs) -> let prefix :: Text
prefix = if HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides
then "/"
else WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts
in "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xs
_ -> Text
s
let link :: Html
link = Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
s') (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
linkText
Html
link' <- WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ident, [Text]
classes, [(Text, Text)]
kvs) Html
link
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
tit
then Html
link'
else Html
link' Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
tit)
(Image attr :: Attr
attr txt :: [Inline]
txt (s :: Text
s,tit :: Text
tit)) -> do
let alternate :: Text
alternate = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
let isReveal :: Bool
isReveal = HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides
[Attribute]
attrs <- WriterOptions -> Attr -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
imgAttrsToHtml WriterOptions
opts Attr
attr
let attributes :: [Attribute]
attributes =
(if Bool
isReveal
then Tag -> AttributeValue -> Attribute
customAttribute "data-src" (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
s
else AttributeValue -> Attribute
A.src (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
s) Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
:
[AttributeValue -> Attribute
A.title (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
tit | Bool -> Bool
not (Text -> Bool
T.null Text
tit)] [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++
[Attribute]
attrs
imageTag :: (Html, [Attribute])
imageTag = (if Bool
html5 then Html
H5.img else Html
H.img
, [AttributeValue -> Attribute
A.alt (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
alternate | Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt)] )
mediaTag :: (Html -> a) -> Text -> (a, [Attribute])
mediaTag tg :: Html -> a
tg fallbackTxt :: Text
fallbackTxt =
let linkTxt :: Text
linkTxt = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
then Text
fallbackTxt
else Text
alternate
in (Html -> a
tg (Html -> a) -> Html -> a
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
s) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
linkTxt
, [AttributeValue -> Attribute
A5.controls ""] )
normSrc :: [Char]
normSrc = [Char] -> (URI -> [Char]) -> Maybe URI -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> [Char]
T.unpack Text
s) URI -> [Char]
uriPath ([Char] -> Maybe URI
parseURIReference ([Char] -> Maybe URI) -> [Char] -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s)
(tag :: Html
tag, specAttrs :: [Attribute]
specAttrs) = case [Char] -> Maybe Text
mediaCategory [Char]
normSrc of
Just "image" -> (Html, [Attribute])
imageTag
Just "video" -> (Html -> Html) -> Text -> (Html, [Attribute])
forall a. (Html -> a) -> Text -> (a, [Attribute])
mediaTag Html -> Html
H5.video "Video"
Just "audio" -> (Html -> Html) -> Text -> (Html, [Attribute])
forall a. (Html -> a) -> Text -> (a, [Attribute])
mediaTag Html -> Html
H5.audio "Audio"
Just _ -> (Html
H5.embed, [])
_ -> (Html, [Attribute])
imageTag
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ (Html -> Attribute -> Html) -> Html -> [Attribute] -> Html
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (!) Html
tag ([Attribute] -> Html) -> [Attribute] -> Html
forall a b. (a -> b) -> a -> b
$ [Attribute]
attributes [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++ [Attribute]
specAttrs
(Note contents :: [Block]
contents) -> do
[Html]
notes <- (WriterState -> [Html]) -> StateT WriterState m [Html]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Html]
stNotes
let number :: Int
number = [Html] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Html]
notes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
let ref :: Text
ref = Int -> Text
forall a. Show a => a -> Text
tshow Int
number
Html
htmlContents <- WriterOptions -> Text -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> StateT WriterState m Html
blockListToNote WriterOptions
opts Text
ref [Block]
contents
Maybe EPUBVersion
epubVersion <- (WriterState -> Maybe EPUBVersion)
-> StateT WriterState m (Maybe EPUBVersion)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st {stNotes :: [Html]
stNotes = Html
htmlContentsHtml -> [Html] -> [Html]
forall a. a -> [a] -> [a]
:[Html]
notes}
HTMLSlideVariant
slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
let revealSlash :: Text
revealSlash = [Char] -> Text
T.pack ['/' | HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides]
let link :: Html
link = Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
revealSlash Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref)
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "footnote-ref"
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts ("fnref" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (if Maybe EPUBVersion -> Bool
forall a. Maybe a -> Bool
isJust Maybe EPUBVersion
epubVersion
then Html -> Html
forall a. a -> a
id
else Html -> Html
H.sup)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
ref
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ case Maybe EPUBVersion
epubVersion of
Just EPUB3 -> Html
link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute "epub:type" "noteref"
_ | Bool
html5 -> Html
link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
H5.customAttribute
"role" "doc-noteref"
_ -> Html
link
(Cite cits :: [Citation]
cits il :: [Inline]
il)-> do Html
contents <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts ((Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
addRoleToLink [Inline]
il)
let citationIds :: Text
citationIds = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Citation -> Text) -> [Citation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
citationId [Citation]
cits
let result :: Html
result = Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "citation" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
contents
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ if Bool
html5
then Html
result Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute "data-cites" (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
citationIds)
else Html
result
addRoleToLink :: Inline -> Inline
addRoleToLink :: Inline -> Inline
addRoleToLink (Link (id' :: Text
id',classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) ils :: [Inline]
ils (src :: Text
src,tit :: Text
tit)) =
Attr -> [Inline] -> (Text, Text) -> Inline
Link (Text
id',[Text]
classes,("role","doc-biblioref")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs) [Inline]
ils (Text
src,Text
tit)
addRoleToLink x :: Inline
x = Inline
x
blockListToNote :: PandocMonad m
=> WriterOptions -> Text -> [Block]
-> StateT WriterState m Html
blockListToNote :: WriterOptions -> Text -> [Block] -> StateT WriterState m Html
blockListToNote opts :: WriterOptions
opts ref :: Text
ref blocks :: [Block]
blocks = do
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
let kvs :: [(Text, Text)]
kvs = [("role","doc-backlink") | Bool
html5]
let backlink :: [Inline]
backlink = [Attr -> [Inline] -> (Text, Text) -> Inline
Link ("",["footnote-back"],[(Text, Text)]
kvs)
[Text -> Inline
Str "↩"] ("#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "fnref" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref,"")]
let blocks' :: [Block]
blocks' = if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks
then []
else let lastBlock :: Block
lastBlock = [Block] -> Block
forall a. [a] -> a
last [Block]
blocks
otherBlocks :: [Block]
otherBlocks = [Block] -> [Block]
forall a. [a] -> [a]
init [Block]
blocks
in case Block
lastBlock of
(Para lst :: [Inline]
lst) -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
[[Inline] -> Block
Para ([Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
backlink)]
(Plain lst :: [Inline]
lst) -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
[[Inline] -> Block
Plain ([Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
backlink)]
_ -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
lastBlock,
[Inline] -> Block
Plain [Inline]
backlink]
Html
contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks'
let noteItem :: Html
noteItem = Html -> Html
H.li (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts ("fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
contents
Maybe EPUBVersion
epubVersion <- (WriterState -> Maybe EPUBVersion)
-> StateT WriterState m (Maybe EPUBVersion)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
let noteItem' :: Html
noteItem' = case Maybe EPUBVersion
epubVersion of
Just EPUB3 -> Html
noteItem Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
!
Tag -> AttributeValue -> Attribute
customAttribute "epub:type" "footnote"
_ | Bool
html5 -> Html
noteItem Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
!
Tag -> AttributeValue -> Attribute
customAttribute "role" "doc-endnote"
_ -> Html
noteItem
Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Html
nl WriterOptions
opts Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
noteItem'
isMathEnvironment :: Text -> Bool
isMathEnvironment :: Text -> Bool
isMathEnvironment s :: Text
s = "\\begin{" Text -> Text -> Bool
`T.isPrefixOf` Text
s Bool -> Bool -> Bool
&&
Text
envName Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
mathmlenvs
where envName :: Text
envName = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '}') (Int -> Text -> Text
T.drop 7 Text
s)
mathmlenvs :: [Text]
mathmlenvs = [ "align"
, "align*"
, "alignat"
, "alignat*"
, "aligned"
, "alignedat"
, "array"
, "Bmatrix"
, "bmatrix"
, "cases"
, "CD"
, "eqnarray"
, "eqnarray*"
, "equation"
, "equation*"
, "gather"
, "gather*"
, "gathered"
, "matrix"
, "multline"
, "multline*"
, "pmatrix"
, "smallmatrix"
, "split"
, "subarray"
, "Vmatrix"
, "vmatrix" ]
allowsMathEnvironments :: HTMLMathMethod -> Bool
allowsMathEnvironments :: HTMLMathMethod -> Bool
allowsMathEnvironments (MathJax _) = Bool
True
allowsMathEnvironments MathML = Bool
True
allowsMathEnvironments (WebTeX _) = Bool
True
allowsMathEnvironments _ = Bool
False
isRawHtml :: PandocMonad m => Format -> StateT WriterState m Bool
isRawHtml :: Format -> StateT WriterState m Bool
isRawHtml f :: Format
f = do
Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
Bool -> StateT WriterState m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> StateT WriterState m Bool)
-> Bool -> StateT WriterState m Bool
forall a b. (a -> b) -> a -> b
$ Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "html" Bool -> Bool -> Bool
||
((Bool
html5 Bool -> Bool -> Bool
&& Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "html5") Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "html4")