{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Writers.HTML
   Copyright   : Copyright (C) 2006-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to HTML.
-}
module Text.Pandoc.Writers.HTML (
  writeHtml4,
  writeHtml4String,
  writeHtml5,
  writeHtml5String,
  writeHtmlStringForEPUB,
  writeS5,
  writeSlidy,
  writeSlideous,
  writeDZSlides,
  writeRevealJs,
  tagWithAttributes
  ) where
import Control.Monad.State.Strict
    ( StateT, MonadState(get), gets, modify, evalStateT )
import Control.Monad ( liftM, when, foldM, unless )
import Control.Monad.Trans ( MonadTrans(lift) )
import Data.Char (ord)
import Data.List (intercalate, intersperse, partition, delete, (\\), foldl')
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Containers.ListUtils (nubOrd)
import Data.Maybe (fromMaybe, isJust, isNothing)
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.URI (URI (..), parseURIReference)
import Numeric (showHex)
import Text.DocLayout (render, literal, Doc)
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, formatHtml4Block,
                 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 qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import Text.Pandoc.URI (urlEncode)
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.Translations (Term(Abstract), translateTerm)
import Text.Pandoc.Class.PandocPure (runPure)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.MIME (mediaCategory)
import Text.Pandoc.Writers.Blaze (layoutMarkup)
import Text.TeXMath
import Text.XML.Light (elChildren, unode, unqual)
import qualified Text.XML.Light as XML
import Text.XML.Light.Output
import Data.String (fromString)

data WriterState = WriterState
    { WriterState -> [Html]
stNotes        :: [Html]  -- ^ List of notes
    , WriterState -> Int
stEmittedNotes :: Int     -- ^ How many notes we've already pushed out to the HTML
    , WriterState -> Bool
stMath         :: Bool    -- ^ Math is used in document
    , WriterState -> Bool
stQuotes       :: Bool    -- ^ <q> tag is used
    , WriterState -> Bool
stHighlighting :: Bool    -- ^ Syntax highlighting is used
    , WriterState -> Bool
stHtml5        :: Bool    -- ^ Use HTML5
    , WriterState -> Maybe EPUBVersion
stEPUBVersion  :: Maybe EPUBVersion -- ^ EPUB version if for epub
    , WriterState -> HTMLSlideVariant
stSlideVariant :: HTMLSlideVariant
    , WriterState -> Int
stSlideLevel   :: Int     -- ^ Slide level
    , WriterState -> Bool
stInSection    :: Bool    -- ^ Content is in a section (revealjs)
    , WriterState -> Int
stCodeBlockNum :: Int     -- ^ Number of code block
    , WriterState -> Bool
stCsl          :: Bool    -- ^ Has CSL references
    , WriterState -> Maybe Int
stCslEntrySpacing :: Maybe Int  -- ^ CSL entry spacing
    , WriterState -> Int
stBlockLevel   :: Int     -- ^ Current block depth, excluding section divs
    }

defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState = WriterState {stNotes :: [Html]
stNotes= [], stEmittedNotes :: Int
stEmittedNotes = Int
0, stMath :: Bool
stMath = Bool
False, stQuotes :: Bool
stQuotes = Bool
False,
                                  stHighlighting :: Bool
stHighlighting = Bool
False,
                                  stHtml5 :: Bool
stHtml5 = Bool
False,
                                  stEPUBVersion :: Maybe EPUBVersion
stEPUBVersion = forall a. Maybe a
Nothing,
                                  stSlideVariant :: HTMLSlideVariant
stSlideVariant = HTMLSlideVariant
NoSlides,
                                  stSlideLevel :: Int
stSlideLevel = Int
1,
                                  stInSection :: Bool
stInSection = Bool
False,
                                  stCodeBlockNum :: Int
stCodeBlockNum = Int
0,
                                  stCsl :: Bool
stCsl = Bool
False,
                                  stCslEntrySpacing :: Maybe Int
stCslEntrySpacing = forall a. Maybe a
Nothing,
                                  stBlockLevel :: Int
stBlockLevel = Int
0}

-- Helpers to render HTML with the appropriate function.

strToHtml :: Text -> Html
strToHtml :: Text -> Html
strToHtml Text
t
    | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpecial Text
t =
       let !x :: Html
x = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Html -> Text -> Html
go forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy Char -> Char -> Bool
samegroup Text
t
        in Html
x
    | Bool
otherwise = forall a. ToMarkup a => a -> Html
toHtml Text
t
  where
    samegroup :: Char -> Char -> Bool
samegroup Char
c Char
d = Char
d forall a. Eq a => a -> a -> Bool
== Char
'\xFE0E' Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isSpecial Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpecial Char
d)
    isSpecial :: Char -> Bool
isSpecial Char
'\'' = Bool
True
    isSpecial Char
'"' = Bool
True
    isSpecial Char
c = Char -> Bool
needsVariationSelector Char
c
    go :: Html -> Text -> Html
go Html
h Text
"\'" = Html
h forall a. Semigroup a => a -> a -> a
<> String -> Html
preEscapedString String
"\'"
    go Html
h Text
"\"" = Html
h forall a. Semigroup a => a -> a -> a
<> String -> Html
preEscapedString String
"\""
    go Html
h Text
txt | Text -> Int
T.length Text
txt forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
needsVariationSelector Text
txt
           = Html
h forall a. Semigroup a => a -> a -> a
<> String -> Html
preEscapedString (Text -> String
T.unpack Text
txt forall a. Semigroup a => a -> a -> a
<> String
"\xFE0E")
    go Html
h Text
txt = Html
h forall a. Semigroup a => a -> a -> a
<> forall a. ToMarkup a => a -> Html
toHtml Text
txt

-- See #5469: this prevents iOS from substituting emojis.
needsVariationSelector :: Char -> Bool
needsVariationSelector :: Char -> Bool
needsVariationSelector Char
'↩' = Bool
True
needsVariationSelector Char
'↔' = Bool
True
needsVariationSelector Char
_   = Bool
False

-- | Hard linebreak.
nl :: Html
nl :: Html
nl = String -> Html
preEscapedString String
"\n"

-- | Convert Pandoc document to Html 5 string.
writeHtml5String :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeHtml5String :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String = forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
                      WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
True }

-- | Convert Pandoc document to Html 5 structure.
writeHtml5 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
writeHtml5 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
writeHtml5 = forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
True }

-- | Convert Pandoc document to Html 4 string.
writeHtml4String :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeHtml4String :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml4String WriterOptions
opts = forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
                         WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
False } WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        Pandoc -> Pandoc
ensureValidXmlIdentifiers

-- | Convert Pandoc document to Html 4 structure.
writeHtml4 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
writeHtml4 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
writeHtml4 WriterOptions
opts = forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
False } WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Pandoc -> Pandoc
ensureValidXmlIdentifiers

-- | Convert Pandoc document to Html appropriate for an epub version.
writeHtmlStringForEPUB :: PandocMonad m
                       => EPUBVersion -> WriterOptions -> Pandoc
                       -> m Text
writeHtmlStringForEPUB :: forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB EPUBVersion
version WriterOptions
o = forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
                      WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = EPUBVersion
version forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3,
                                          stEPUBVersion :: Maybe EPUBVersion
stEPUBVersion = forall a. a -> Maybe a
Just EPUBVersion
version }
                      WriterOptions
o{ writerWrapText :: WrapOption
writerWrapText = WrapOption
WrapNone }
   -- we don't use ensureValidXmlIdentifiers here because we
   -- do that in the EPUB writer

-- | Convert Pandoc document to Reveal JS HTML slide show.
writeRevealJs :: PandocMonad m
              => WriterOptions -> Pandoc -> m Text
writeRevealJs :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRevealJs = forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
RevealJsSlides

-- | Convert Pandoc document to S5 HTML slide show.
writeS5 :: PandocMonad m
        => WriterOptions -> Pandoc -> m Text
writeS5 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeS5 WriterOptions
opts = forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
S5Slides WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               Pandoc -> Pandoc
ensureValidXmlIdentifiers

-- | Convert Pandoc document to Slidy HTML slide show.
writeSlidy :: PandocMonad m
           => WriterOptions -> Pandoc -> m Text
writeSlidy :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeSlidy WriterOptions
opts = forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
SlidySlides WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  Pandoc -> Pandoc
ensureValidXmlIdentifiers

-- | Convert Pandoc document to Slideous HTML slide show.
writeSlideous :: PandocMonad m
              => WriterOptions -> Pandoc -> m Text
writeSlideous :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeSlideous WriterOptions
opts = forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
SlideousSlides WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     Pandoc -> Pandoc
ensureValidXmlIdentifiers

-- | Convert Pandoc document to DZSlides HTML slide show.
writeDZSlides :: PandocMonad m
              => WriterOptions -> Pandoc -> m Text
writeDZSlides :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDZSlides WriterOptions
opts = forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
DZSlides WriterOptions
opts

writeHtmlSlideShow' :: PandocMonad m
                    => HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' :: forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
variant = forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
    WriterState
defaultWriterState{ stSlideVariant :: HTMLSlideVariant
stSlideVariant = HTMLSlideVariant
variant
                      , stHtml5 :: Bool
stHtml5 = case HTMLSlideVariant
variant of
                                       HTMLSlideVariant
RevealJsSlides -> Bool
True
                                       HTMLSlideVariant
S5Slides       -> Bool
False
                                       HTMLSlideVariant
SlidySlides    -> Bool
False
                                       HTMLSlideVariant
DZSlides       -> Bool
True
                                       HTMLSlideVariant
SlideousSlides -> Bool
False
                                       HTMLSlideVariant
NoSlides       -> Bool
False
                      }

renderHtml' :: Html -> Text
renderHtml' :: Html -> Text
renderHtml' = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml

writeHtmlString' :: PandocMonad m
                 => WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' :: forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' WriterState
st WriterOptions
opts Pandoc
d = do
  (Html
body, Context Text
context) <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
pandocToHtml WriterOptions
opts Pandoc
d) WriterState
st
  let colwidth :: Maybe Int
colwidth = case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
                    WrapOption
WrapAuto -> forall a. a -> Maybe a
Just (WriterOptions -> Int
writerColumns WriterOptions
opts)
                    WrapOption
_ -> forall a. Maybe a
Nothing
  (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
      then Text -> Text
toEntities
      else forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
         case Maybe Int
colwidth of
           Maybe Int
Nothing -> Html -> Text
renderHtml' Html
body  -- optimization, skip layout
           Just Int
cols -> forall a. HasChars a => Maybe Int -> Doc a -> a
render (forall a. a -> Maybe a
Just Int
cols) forall a b. (a -> b) -> a -> b
$ Html -> Doc Text
layoutMarkup Html
body
       Just Template Text
tpl -> do
         -- warn if empty lang
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing (forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"lang" Context Text
context :: Maybe Text)) forall a b. (a -> b) -> a -> b
$
           forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report LogMessage
NoLangSpecified
         -- check for empty pagetitle
         (Context Text
context' :: Context Text) <-
            case forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"pagetitle" Context Text
context of
                 Just (Text
s :: Text) | Bool -> Bool
not (Text -> Bool
T.null Text
s) -> forall (m :: * -> *) a. Monad m => a -> m a
return Context Text
context
                 Maybe Text
_ -> do
                   let fallback :: Text
fallback = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
                         case forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"sourcefile"
                                   (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
                           Maybe [Text]
Nothing    -> String
"Untitled"
                           Just []    -> String
"Untitled"
                           Just (Text
x:[Text]
_) -> String -> String
takeBaseName forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x
                   forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
NoTitleElement Text
fallback
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"pagetitle" (forall a. HasChars a => a -> Doc a
literal Text
fallback) Context Text
context
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$ forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl
             (forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" (Html -> Doc Text
layoutMarkup Html
body) Context Text
context')

writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' :: forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' WriterState
st WriterOptions
opts Pandoc
d =
  case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Just Template Text
_ -> Text -> Html
preEscapedText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' WriterState
st WriterOptions
opts Pandoc
d
       Maybe (Template Text)
Nothing
         | WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
           -> Text -> Html
preEscapedText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' WriterState
st WriterOptions
opts Pandoc
d
         | Bool
otherwise -> do
            (Html
body, Context Text
_) <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
pandocToHtml WriterOptions
opts Pandoc
d) WriterState
st
            forall (m :: * -> *) a. Monad m => a -> m a
return Html
body

-- result is (title, authors, date, toc, body, new variables)
pandocToHtml :: PandocMonad m
             => WriterOptions
             -> Pandoc
             -> StateT WriterState m (Html, Context Text)
pandocToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
pandocToHtml WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => Meta -> m ()
setupTranslations Meta
meta
  let slideLevel :: Int
slideLevel = forall a. a -> Maybe a -> a
fromMaybe ([Block] -> Int
getSlideLevel [Block]
blocks) forall a b. (a -> b) -> a -> b
$ WriterOptions -> Maybe Int
writerSlideLevel WriterOptions
opts
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stSlideLevel :: Int
stSlideLevel = Int
slideLevel }
  Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
              (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Doc Text
layoutMarkup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts)
              (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Doc Text
layoutMarkup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts)
              Meta
meta
  let stringifyHTML :: [Inline] -> Text
stringifyHTML = Text -> Text
escapeStringForXML forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> Text
stringify
  let authsMeta :: [Doc Text]
authsMeta = forall a b. (a -> b) -> [a] -> [b]
map (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
stringifyHTML) forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  let dateMeta :: Text
dateMeta  = [Inline] -> Text
stringifyHTML forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docDate Meta
meta
  let descriptionMeta :: Doc Text
descriptionMeta = forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML forall a b. (a -> b) -> a -> b
$
                          Text -> Meta -> Text
lookupMetaString Text
"description" Meta
meta
  HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
  Text
abstractTitle <- forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Abstract
  let sects :: [Block]
sects = WriterOptions -> [Block] -> [Block]
adjustNumbers WriterOptions
opts forall a b. (a -> b) -> a -> b
$
              Bool -> Maybe Int -> [Block] -> [Block]
makeSections (WriterOptions -> Bool
writerNumberSections WriterOptions
opts) forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
              if HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
NoSlides
                 then [Block]
blocks
                 else Int -> [Block] -> [Block]
prepSlides Int
slideLevel [Block]
blocks
  Maybe (Doc Text)
toc <- if WriterOptions -> Bool
writerTableOfContents WriterOptions
opts Bool -> Bool -> Bool
&& HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
S5Slides
            then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Doc Text
layoutMarkup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Maybe Html)
tableOfContents WriterOptions
opts [Block]
sects
            else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  Html
blocks' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
sects
  Html
notes <- do
    -- make the st private just to be safe, since we modify it right afterwards
    WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (WriterState -> [Html]
stNotes WriterState
st)
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
      else do
        Html
notes <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ReferenceLocation -> Int -> [Html] -> StateT WriterState m Html
footnoteSection WriterOptions
opts ReferenceLocation
EndOfDocument (WriterState -> Int
stEmittedNotes WriterState
st forall a. Num a => a -> a -> a
+ Int
1) (forall a. [a] -> [a]
reverse (WriterState -> [Html]
stNotes WriterState
st))
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st' -> WriterState
st'{ stNotes :: [Html]
stNotes = forall a. Monoid a => a
mempty, stEmittedNotes :: Int
stEmittedNotes = WriterState -> Int
stEmittedNotes WriterState
st' forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (WriterState -> [Html]
stNotes WriterState
st') })
        forall (m :: * -> *) a. Monad m => a -> m a
return Html
notes
  WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  let thebody :: Html
thebody = Html
blocks' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
notes
  let math :: Doc Text
math = Html -> Doc Text
layoutMarkup forall a b. (a -> b) -> a -> b
$ case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
        MathJax Text
url
          | HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
RevealJsSlides ->
          -- mathjax is handled via a special plugin in revealjs
            Html -> Html
H.script forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src (forall a. ToValue a => a -> AttributeValue
toValue Text
url)
                    forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript"
                    forall a b. (a -> b) -> a -> b
$ case HTMLSlideVariant
slideVariant of
                            HTMLSlideVariant
SlideousSlides ->
                              String -> Html
preEscapedString
                              String
"MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);"
                            HTMLSlideVariant
_ -> forall a. Monoid a => a
mempty
        KaTeX Text
url -> do
          Html -> Html
H.script forall h. Attributable h => h -> Attribute -> h
!
            AttributeValue -> Attribute
A.defer forall a. Monoid a => a
mempty forall h. Attributable h => h -> Attribute -> h
!
            AttributeValue -> Attribute
A.src (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ Text
url forall a. Semigroup a => a -> a -> a
<> Text
"katex.min.js") forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
          Html
nl
          let katexFlushLeft :: Text
katexFlushLeft =
                case forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"classoption" Context Text
metadata of
                  Just [Doc Text]
clsops | Doc Text
"fleqn" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Doc Text]
clsops :: [Doc Text]) -> Text
"true"
                  Maybe [Doc Text]
_ -> Text
"false"
          Html -> Html
H.script forall a b. (a -> b) -> a -> b
$ Text -> Html
text forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
              Text
"document.addEventListener(\"DOMContentLoaded\", function () {"
            , Text
" var mathElements = document.getElementsByClassName(\"math\");"
            , Text
" var macros = [];"
            , Text
" for (var i = 0; i < mathElements.length; i++) {"
            , Text
"  var texText = mathElements[i].firstChild;"
            , Text
"  if (mathElements[i].tagName == \"SPAN\") {"
            , Text
"   katex.render(texText.data, mathElements[i], {"
            , Text
"    displayMode: mathElements[i].classList.contains('display'),"
            , Text
"    throwOnError: false,"
            , Text
"    macros: macros,"
            , Text
"    fleqn: " forall a. Semigroup a => a -> a -> a
<> Text
katexFlushLeft
            , Text
"   });"
            , Text
"}}});"
            ]
          Html
nl
          Html
H.link forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet" forall h. Attributable h => h -> Attribute -> h
!
            AttributeValue -> Attribute
A.href (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ Text
url forall a. Semigroup a => a -> a -> a
<> Text
"katex.min.css")

        HTMLMathMethod
_ -> forall a. Monoid a => a
mempty
  let Maybe [Text]
mCss :: Maybe [Text] = forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"css" Context Text
metadata
  let context :: Context Text
      context :: Context Text
context =   (if WriterState -> Bool
stHighlighting WriterState
st
                      then case WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts of
                                Just Style
sty -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"highlighting-css"
                                            (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Style -> String
styleToCss Style
sty)
                                Maybe Style
Nothing  -> forall a. a -> a
id
                      else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (if WriterState -> Bool
stCsl WriterState
st
                      then forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"csl-css" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           (case WriterState -> Maybe Int
stCslEntrySpacing WriterState
st of
                              Maybe Int
Nothing -> forall a. a -> a
id
                              Just Int
n  ->
                                forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"csl-entry-spacing"
                                  (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow Int
n forall a. Semigroup a => a -> a -> a
<> Text
"em"))
                      else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (if WriterState -> Bool
stMath WriterState
st
                      then forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" Doc Text
math
                      else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"abstract-title" Text
abstractTitle forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
                        MathJax Text
u -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mathjax" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mathjaxurl"
                                       (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'?') Text
u)
                        HTMLMathMethod
_         -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mathjax" Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
                        HTMLMathMethod
PlainMath -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"displaymath-css" Bool
True
                        WebTeX Text
_  -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"displaymath-css" Bool
True
                        HTMLMathMethod
_         -> forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (if HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides
                      then -- set boolean options explicitly, since
                           -- template can't distinguish False/undefined
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"controls" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"controlsTutorial" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"controlsLayout"
                           (Doc Text
"bottom-right" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"controlsBackArrows" (Doc Text
"faded" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"progress" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"slideNumber" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"showSlideNumber" (Doc Text
"all" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"hashOneBasedIndex" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"hash" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"respondToHashChanges" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"history" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"keyboard" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"overview" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"disableLayout" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"center" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"touch" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"loop" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"rtl" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"navigationMode" (Doc Text
"default" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"shuffle" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"fragments" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"fragmentInURL" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"embedded" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"help" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"pause" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"showNotes" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"autoPlayMedia" (Doc Text
"null" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"preloadIframes" (Doc Text
"null" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"autoSlide" (Doc Text
"0" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"autoSlideStoppable" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"autoSlideMethod" (Doc Text
"null" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"defaultTiming" (Doc Text
"null" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mouseWheel" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"display" (Doc Text
"block" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"hideInactiveCursor" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"hideCursorTime" (Doc Text
"5000" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"previewLinks" Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"transition" (Doc Text
"slide" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"transitionSpeed" (Doc Text
"default" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"backgroundTransition" (Doc Text
"fade" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"viewDistance" (Doc Text
"3" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mobileViewDistance" (Doc Text
"2" :: Doc Text)
                      else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"document-css" (forall a. Maybe a -> Bool
isNothing Maybe [Text]
mCss Bool -> Bool -> Bool
&& HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
NoSlides) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"quotes" (WriterState -> Bool
stQuotes WriterState
st) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  -- for backwards compatibility we populate toc
                  -- with the contents of the toc, rather than a
                  -- boolean:
                  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc") Maybe (Doc Text)
toc forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"table-of-contents") Maybe (Doc Text)
toc forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"author-meta" [Doc Text]
authsMeta forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"date-meta" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal)
                    (Text -> Maybe Text
normalizeDate Text
dateMeta) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"description-meta" Doc Text
descriptionMeta forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"pagetitle"
                      (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
stringifyHTML forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Inline]
docTitle forall a b. (a -> b) -> a -> b
$ Meta
meta) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"idprefix" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  -- these should maybe be set in pandoc.hs
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"slidy-url"
                    (Doc Text
"https://www.w3.org/Talks/Tools/Slidy2" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"slideous-url" (Doc Text
"slideous" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"revealjs-url" (Doc Text
"https://unpkg.com/reveal.js@^4/" :: Doc Text) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"s5-url" (Doc Text
"s5/default" :: Doc Text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"html5" (WriterState -> Bool
stHtml5 WriterState
st) forall a b. (a -> b) -> a -> b
$
                  Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return (Html
thebody, Context Text
context)

-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
prefixedId :: WriterOptions -> Text -> Attribute
prefixedId :: WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts Text
s =
  case Text
s of
    Text
"" -> forall a. Monoid a => a
mempty
    Text
_  -> AttributeValue -> Attribute
A.id forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts forall a. Semigroup a => a -> a -> a
<> Text
s

toList :: PandocMonad m
       => (Html -> Html)
       -> WriterOptions
       -> [Html]
       -> StateT WriterState m Html
toList :: forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
listop WriterOptions
opts [Html]
items = do
    HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      if WriterOptions -> Bool
writerIncremental WriterOptions
opts
         then if HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
RevealJsSlides
                 then  Html -> Html
listop (forall a. Monoid a => [a] -> a
mconcat [Html]
items) forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"incremental"
                 else Html -> Html
listop forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"fragment") [Html]
items
         else Html -> Html
listop forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Html]
items

unordList :: PandocMonad m
          => WriterOptions -> [Html] -> StateT WriterState m Html
unordList :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
unordList WriterOptions
opts = forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.ul WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> [Html]
toListItems

ordList :: PandocMonad m
        => WriterOptions -> [Html] -> StateT WriterState m Html
ordList :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
ordList WriterOptions
opts = forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.ol WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> [Html]
toListItems

defList :: PandocMonad m
        => WriterOptions -> [Html] -> StateT WriterState m Html
defList :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
defList WriterOptions
opts [Html]
items = forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.dl WriterOptions
opts ([Html]
items forall a. [a] -> [a] -> [a]
++ [Html
nl])

isTaskListItem :: [Block] -> Bool
isTaskListItem :: [Block] -> Bool
isTaskListItem (Plain (Str Text
"☐":Inline
Space:[Inline]
_):[Block]
_) = Bool
True
isTaskListItem (Plain (Str Text
"☒":Inline
Space:[Inline]
_):[Block]
_) = Bool
True
isTaskListItem (Para  (Str Text
"☐":Inline
Space:[Inline]
_):[Block]
_) = Bool
True
isTaskListItem (Para  (Str Text
"☒":Inline
Space:[Inline]
_):[Block]
_) = Bool
True
isTaskListItem [Block]
_                           = Bool
False

listItemToHtml :: PandocMonad m
               => WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml WriterOptions
opts [Block]
bls
  | Plain (Str Text
"☐":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
bls = forall {m :: * -> *} {a}.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
False forall a. a -> a
id  [Inline]
is [Block]
bs
  | Plain (Str Text
"☒":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
bls = forall {m :: * -> *} {a}.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
True  forall a. a -> a
id  [Inline]
is [Block]
bs
  | Para  (Str Text
"☐":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
bls = 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 Text
"☒":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
bls = 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 = 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 Bool
checked Html -> MarkupM a
constr [Inline]
is [Block]
bs = do
      let checkbox :: Html
checkbox  = if Bool
checked
                      then Html
checkbox' forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.checked AttributeValue
""
                      else Html
checkbox'
          checkbox' :: Html
checkbox' = Html
H.input forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"checkbox"
      Html
isContents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
is
      Html
bsContents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
bs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> MarkupM a
constr (Html -> Html
H.label (Html
checkbox forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
isContents)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
               (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
bs then forall a. Monoid a => a
mempty else Html
nl) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
               Html
bsContents

-- | Construct table of contents from list of elements.
tableOfContents :: PandocMonad m => WriterOptions -> [Block]
                -> StateT WriterState m (Maybe Html)
tableOfContents :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Maybe Html)
tableOfContents WriterOptions
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
tableOfContents WriterOptions
opts [Block]
sects = do
  -- in reveal.js, we need #/apples, not #apples:
  HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
  let opts' :: WriterOptions
opts' = case HTMLSlideVariant
slideVariant of
                HTMLSlideVariant
RevealJsSlides ->
                  WriterOptions
opts{ writerIdentifierPrefix :: Text
writerIdentifierPrefix =
                          Text
"/" forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts }
                HTMLSlideVariant
_ -> WriterOptions
opts
  case WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
opts [Block]
sects of
    bl :: Block
bl@(BulletList ([Block]
_:[[Block]]
_)) -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts' Block
bl
    Block
_                     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Convert list of Note blocks to a footnote <div>.
-- Assumes notes are sorted.
footnoteSection ::
  PandocMonad m => WriterOptions -> ReferenceLocation -> Int -> [Html] -> StateT WriterState m Html
footnoteSection :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ReferenceLocation -> Int -> [Html] -> StateT WriterState m Html
footnoteSection WriterOptions
opts ReferenceLocation
refLocation Int
startCounter [Html]
notes = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
  let hrtag :: Html
hrtag = if ReferenceLocation
refLocation forall a. Eq a => a -> a -> Bool
/= ReferenceLocation
EndOfBlock
                 then (if Bool
html5 then Html
H5.hr else Html
H.hr) forall a. Semigroup a => a -> a -> a
<> Html
nl
                 else forall a. Monoid a => a
mempty
  let additionalClassName :: AttributeValue
additionalClassName = case ReferenceLocation
refLocation of
        ReferenceLocation
EndOfBlock -> AttributeValue
"footnotes-end-of-block"
        ReferenceLocation
EndOfDocument -> AttributeValue
"footnotes-end-of-document"
        ReferenceLocation
EndOfSection -> AttributeValue
"footnotes-end-of-section"
  let className :: AttributeValue
className = AttributeValue
"footnotes " forall a. Semigroup a => a -> a -> a
<> AttributeValue
additionalClassName
  Maybe EPUBVersion
epubVersion <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
  let container :: Html -> Html
container Html
x
        | Bool
html5
        , Maybe EPUBVersion
epubVersion forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EPUBVersion
EPUB3
                = Html -> Html
H5.section forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"footnotes"
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
className
                             forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"epub:type" AttributeValue
"footnotes" forall a b. (a -> b) -> a -> b
$ Html
x
        | Bool
html5
        , ReferenceLocation
refLocation forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfDocument
        , HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides -- need a section for a new slide:
                = Html -> Html
H5.section forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.id AttributeValue
"footnotes"
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.class_ AttributeValue
className
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.role AttributeValue
"doc-endnotes"
                             forall a b. (a -> b) -> a -> b
$ Html
x
        | Bool
html5 = Html -> Html
H5.aside   forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts Text
"footnotes"
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.class_ AttributeValue
className
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.role AttributeValue
"doc-endnotes"
                             forall a b. (a -> b) -> a -> b
$ Html
x
        | HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
NoSlides = Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"footnotes slide" forall a b. (a -> b) -> a -> b
$ Html
x
        | Bool
otherwise = Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
className forall a b. (a -> b) -> a -> b
$ Html
x
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Html]
notes
       then forall a. Monoid a => a
mempty
       else do
         Html
nl
         Html -> Html
container forall a b. (a -> b) -> a -> b
$ do
           Html
nl
           Html
hrtag
           -- Keep the previous output exactly the same if we don't
           -- have multiple notes sections
           case Maybe EPUBVersion
epubVersion of
             Just EPUBVersion
_ -> forall a. Monoid a => [a] -> a
mconcat [Html]
notes
             Maybe EPUBVersion
Nothing | Int
startCounter forall a. Eq a => a -> a -> Bool
== Int
1 ->
               (Html -> Html
H.ol (Html
nl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Monoid a => [a] -> a
mconcat [Html]
notes)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
             Maybe EPUBVersion
Nothing -> (Html -> Html
H.ol forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.start (forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int
startCounter)) forall a b. (a -> b) -> a -> b
$
                         Html
nl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Monoid a => [a] -> a
mconcat [Html]
notes) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl

-- | Parse a mailto link; return Just (name, domain) or Nothing.
parseMailto :: Text -> Maybe (Text, Text)
parseMailto :: Text -> Maybe (Text, Text)
parseMailto Text
s =
  case (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
==Char
':') Text
s of
       (Text
xs,Text -> Maybe (Char, Text)
T.uncons -> Just (Char
':',Text
addr)) | Text -> Text
T.toLower Text
xs forall a. Eq a => a -> a -> Bool
== Text
"mailto" -> do
         let (Text
name', Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
/=Char
'@') Text
addr
         let domain :: Text
domain = Int -> Text -> Text
T.drop Int
1 Text
rest
         forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name', Text
domain)
       (Text, Text)
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"not a mailto: URL"

-- | Obfuscate a "mailto:" link.
obfuscateLink :: PandocMonad m
              => WriterOptions -> Attr -> Html -> Text
              -> StateT WriterState m Html
obfuscateLink :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> Text -> StateT WriterState m Html
obfuscateLink WriterOptions
opts Attr
attr Html
txt Text
s | WriterOptions -> ObfuscationMethod
writerEmailObfuscation WriterOptions
opts forall a. Eq a => a -> a -> Bool
== ObfuscationMethod
NoObfuscation =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. ToValue a => a -> AttributeValue
toValue Text
s) forall a b. (a -> b) -> a -> b
$ Html
txt
obfuscateLink WriterOptions
opts Attr
attr (Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml -> Text
txt) Text
s =
  let meth :: ObfuscationMethod
meth = WriterOptions -> ObfuscationMethod
writerEmailObfuscation WriterOptions
opts
      s' :: Text
s' = Text -> Text
T.toLower (Int -> Text -> Text
T.take Int
7 Text
s) forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
7 Text
s
  in  case Text -> Maybe (Text, Text)
parseMailto Text
s' of
        (Just (Text
name', Text
domain)) ->
          let domain' :: Text
domain'  = Text -> Text -> Text -> Text
T.replace Text
"." Text
" dot " Text
domain
              at' :: Text
at'      = Char -> Text
obfuscateChar Char
'@'
              (Text
linkText, Text
altText) =
                 if Text
txt forall a. Eq a => a -> a -> Bool
== Int -> Text -> Text
T.drop Int
7 Text
s' -- autolink
                    then (Text
"e", Text
name' forall a. Semigroup a => a -> a -> a
<> Text
" at " forall a. Semigroup a => a -> a -> a
<> Text
domain')
                    else (Text
"'" forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
txt forall a. Semigroup a => a -> a -> a
<> Text
"'",
                          Text
txt forall a. Semigroup a => a -> a -> a
<> Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
name' forall a. Semigroup a => a -> a -> a
<> Text
" at " forall a. Semigroup a => a -> a -> a
<> Text
domain' forall a. Semigroup a => a -> a -> a
<> Text
")")
              (Text
_, [Text]
classNames, [(Text, Text)]
_) = Attr
attr
              classNamesStr :: Text
classNamesStr = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text
" "forall a. Semigroup a => a -> a -> a
<>) [Text]
classNames
          in  case ObfuscationMethod
meth of
                ObfuscationMethod
ReferenceObfuscation ->
                     -- need to use preEscapedString or &'s are escaped to &amp; in URL
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                     Text -> Html
preEscapedText forall a b. (a -> b) -> a -> b
$ Text
"<a href=\"" forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
s'
                     forall a. Semigroup a => a -> a -> a
<> Text
"\" class=\"email\">" forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
txt forall a. Semigroup a => a -> a -> a
<> Text
"</a>"
                ObfuscationMethod
JavascriptObfuscation ->
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                     (Html -> Html
H.script forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript" forall a b. (a -> b) -> a -> b
$
                     Text -> Html
preEscapedText (Text
"\n<!--\nh='" forall a. Semigroup a => a -> a -> a
<>
                     Text -> Text
obfuscateString Text
domain forall a. Semigroup a => a -> a -> a
<> Text
"';a='" forall a. Semigroup a => a -> a -> a
<> Text
at' forall a. Semigroup a => a -> a -> a
<> Text
"';n='" forall a. Semigroup a => a -> a -> a
<>
                     Text -> Text
obfuscateString Text
name' forall a. Semigroup a => a -> a -> a
<> Text
"';e=n+a+h;\n" forall a. Semigroup a => a -> a -> a
<>
                     Text
"document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\" clas'+'s=\"em' + 'ail" forall a. Semigroup a => a -> a -> a
<>
                     Text
classNamesStr forall a. Semigroup a => a -> a -> a
<> Text
"\">'+" forall a. Semigroup a => a -> a -> a
<>
                     Text
linkText  forall a. Semigroup a => a -> a -> a
<> Text
"+'<\\/'+'a'+'>');\n// -->\n")) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     Html -> Html
H.noscript (Text -> Html
preEscapedText forall a b. (a -> b) -> a -> b
$ Text -> Text
obfuscateString Text
altText)
                ObfuscationMethod
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError forall a b. (a -> b) -> a -> b
$ Text
"Unknown obfuscation method: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow ObfuscationMethod
meth
        Maybe (Text, Text)
_ -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. ToValue a => a -> AttributeValue
toValue Text
s) forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Text
txt  -- malformed email

-- | Obfuscate character as entity.
obfuscateChar :: Char -> Text
obfuscateChar :: Char -> Text
obfuscateChar Char
char =
  let num :: Int
num    = Char -> Int
ord Char
char
      numstr :: String
numstr = if forall a. Integral a => a -> Bool
even Int
num then forall a. Show a => a -> String
show Int
num else String
"x" forall a. Semigroup a => a -> a -> a
<> forall a. (Integral a, Show a) => a -> String -> String
showHex Int
num String
""
  in  Text
"&#" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
numstr forall a. Semigroup a => a -> a -> a
<> Text
";"

-- | Obfuscate string using entities.
obfuscateString :: Text -> Text
obfuscateString :: Text -> Text
obfuscateString = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
obfuscateChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fromEntities

-- | Create HTML tag with attributes.
tagWithAttributes :: WriterOptions
                  -> Bool -- ^ True for HTML5
                  -> Bool -- ^ True if self-closing tag
                  -> Text -- ^ Tag text
                  -> Attr -- ^ Pandoc style tag attributes
                  -> Text
tagWithAttributes :: WriterOptions -> Bool -> Bool -> Text -> Attr -> Text
tagWithAttributes WriterOptions
opts Bool
html5 Bool
selfClosing Text
tagname Attr
attr =
  let mktag :: PandocPure Text
mktag = (Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
               (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 forall a. PandocPure a -> Either PandocError a
runPure PandocPure Text
mktag of
           Left PandocError
_  -> forall a. Monoid a => a
mempty
           Right Text
t -> Text
t

addAttrs :: PandocMonad m
         => WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr Html
h = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall h. Attributable h => h -> Attribute -> h
(!) Html
h forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs [(Text, Text)]
kvs = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  Maybe EPUBVersion
mbEpubVersion <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
  forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall {m :: * -> *}.
PandocMonad m =>
Bool
-> Maybe EPUBVersion
-> (Set Text, [Attribute])
-> (Text, Text)
-> m (Set Text, [Attribute])
go Bool
html5 Maybe EPUBVersion
mbEpubVersion) (forall a. Set a
Set.empty, []) [(Text, Text)]
kvs
 where
  go :: Bool
-> Maybe EPUBVersion
-> (Set Text, [Attribute])
-> (Text, Text)
-> m (Set Text, [Attribute])
go Bool
html5 Maybe EPUBVersion
mbEpubVersion (Set Text
keys, [Attribute]
attrs) (Text
k,Text
v) = do
    if Text
k forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
keys
       then do
         forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
DuplicateAttribute Text
k Text
v
         forall (m :: * -> *) a. Monad m => a -> m a
return (Set Text
keys, [Attribute]
attrs)
       else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> Set a -> Set a
Set.insert Text
k Set Text
keys, forall {a}.
ToValue a =>
Bool
-> Maybe EPUBVersion -> Text -> a -> [Attribute] -> [Attribute]
addAttr Bool
html5 Maybe EPUBVersion
mbEpubVersion Text
k Text
v [Attribute]
attrs)
  addAttr :: Bool
-> Maybe EPUBVersion -> Text -> a -> [Attribute] -> [Attribute]
addAttr Bool
html5 Maybe EPUBVersion
mbEpubVersion Text
x a
y
    | Text -> Bool
T.null Text
x = forall a. a -> a
id  -- see #7546
    | Bool
html5
      = if Text
x forall a. Ord a => a -> Set a -> Bool
`Set.member` (Set Text
html5Attributes forall a. Semigroup a => a -> a -> a
<> Set Text
rdfaAttributes)
             Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
':') Text
x -- e.g. epub: namespace
             Bool -> Bool -> Bool
|| Text
"data-" Text -> Text -> Bool
`T.isPrefixOf` Text
x
             Bool -> Bool -> Bool
|| Text
"aria-" Text -> Text -> Bool
`T.isPrefixOf` Text
x
           then (Tag -> AttributeValue -> Attribute
customAttribute (Text -> Tag
textTag Text
x) (forall a. ToValue a => a -> AttributeValue
toValue a
y) forall a. a -> [a] -> [a]
:)
           else (Tag -> AttributeValue -> Attribute
customAttribute (Text -> Tag
textTag (Text
"data-" forall a. Semigroup a => a -> a -> a
<> Text
x)) (forall a. ToValue a => a -> AttributeValue
toValue a
y) forall a. a -> [a] -> [a]
:)
    | Maybe EPUBVersion
mbEpubVersion forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EPUBVersion
EPUB2
    , Bool -> Bool
not (Text
x forall a. Ord a => a -> Set a -> Bool
`Set.member` (Set Text
html4Attributes forall a. Semigroup a => a -> a -> a
<> Set Text
rdfaAttributes) Bool -> Bool -> Bool
||
      Text
"xml:" Text -> Text -> Bool
`T.isPrefixOf` Text
x)
      = forall a. a -> a
id
    | Bool
otherwise
      = (Tag -> AttributeValue -> Attribute
customAttribute (Text -> Tag
textTag Text
x) (forall a. ToValue a => a -> AttributeValue
toValue a
y) forall a. a -> [a] -> [a]
:)

attrsToHtml :: PandocMonad m
            => WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts (Text
id',[Text]
classes',[(Text, Text)]
keyvals) = do
  [Attribute]
attrs <- forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs [(Text, Text)]
keyvals
  let classes'' :: [Text]
classes'' = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
classes'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    [WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts Text
id' | Bool -> Bool
not (Text -> Bool
T.null Text
id')] forall a. [a] -> [a] -> [a]
++
    [AttributeValue -> Attribute
A.class_ (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
classes'') | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes'')] forall a. [a] -> [a] -> [a]
++ [Attribute]
attrs

imgAttrsToHtml :: PandocMonad m
               => WriterOptions -> Attr -> StateT WriterState m [Attribute]
imgAttrsToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
imgAttrsToHtml WriterOptions
opts Attr
attr = do
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts (Text
ident,[Text]
cls, [(Text, Text)] -> [(Text, Text)]
consolidateStyles ([(Text, Text)]
kvs' forall a. [a] -> [a] -> [a]
++ Attr -> [(Text, Text)]
dimensionsToAttrList Attr
attr))
  where
    (Text
ident,[Text]
cls,[(Text, Text)]
kvs) = Attr
attr
    kvs' :: [(Text, Text)]
kvs' = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
isNotDim [(Text, Text)]
kvs
    isNotDim :: (a, b) -> Bool
isNotDim (a
"width", b
_)  = Bool
False
    isNotDim (a
"height", b
_) = Bool
False
    isNotDim (a, b)
_             = Bool
True
    consolidateStyles :: [(Text, Text)] -> [(Text, Text)]
    consolidateStyles :: [(Text, Text)] -> [(Text, Text)]
consolidateStyles [(Text, Text)]
xs =
      case forall a. (a -> Bool) -> [a] -> ([a], [a])
partition forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
isStyle [(Text, Text)]
xs of
           ([], [(Text, Text)]
_)    -> [(Text, Text)]
xs
           ([(Text, Text)]
ss, [(Text, Text)]
rest) -> (Text
"style", Text -> [Text] -> Text
T.intercalate Text
";" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Text, Text)]
ss) forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
    isStyle :: (a, b) -> Bool
isStyle (a
"style", b
_) = Bool
True
    isStyle (a, b)
_            = Bool
False

dimensionsToAttrList :: Attr -> [(Text, Text)]
dimensionsToAttrList :: Attr -> [(Text, Text)]
dimensionsToAttrList Attr
attr = Direction -> [(Text, Text)]
go Direction
Width forall a. [a] -> [a] -> [a]
++ Direction -> [(Text, Text)]
go Direction
Height
  where
    go :: Direction -> [(Text, Text)]
go Direction
dir = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
               (Just (Pixel Integer
a)) -> [(forall a. Show a => a -> Text
tshow Direction
dir, forall a. Show a => a -> Text
tshow Integer
a)]
               (Just Dimension
x)         -> [(Text
"style", forall a. Show a => a -> Text
tshow Direction
dir forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Dimension
x)]
               Maybe Dimension
Nothing          -> []

adjustNumbers :: WriterOptions -> [Block] -> [Block]
adjustNumbers :: WriterOptions -> [Block] -> [Block]
adjustNumbers WriterOptions
opts [Block]
doc =
  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Int
0) (WriterOptions -> [Int]
writerNumberOffset WriterOptions
opts)
     then [Block]
doc
     else forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
go [Block]
doc
  where
   go :: Block -> Block
go (Div (Text
ident,Text
"section":[Text]
classes,[(Text, Text)]
kvs) [Block]
lst) =
     Attr -> [Block] -> Block
Div (Text
ident,Text
"section"forall a. a -> [a] -> [a]
:[Text]
classes,forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Eq a, IsString a) => (a, Text) -> (a, Text)
fixnum [(Text, Text)]
kvs) [Block]
lst
   go (Header Int
level (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
lst) =
     Int -> Attr -> [Inline] -> Block
Header Int
level (Text
ident,[Text]
classes,forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Eq a, IsString a) => (a, Text) -> (a, Text)
fixnum [(Text, Text)]
kvs) [Inline]
lst
   go Block
x = Block
x
   fixnum :: (a, Text) -> (a, Text)
fixnum (a
"number",Text
num) = (a
"number",
                               [Int] -> Text
showSecNum forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+)
                               (WriterOptions -> [Int]
writerNumberOffset WriterOptions
opts forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Int
0)
                               (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead) forall a b. (a -> b) -> a -> b
$
                                (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
==Char
'.') Text
num))
   fixnum (a, Text)
x = (a, Text)
x
   showSecNum :: [Int] -> Text
showSecNum = Text -> [Text] -> Text
T.intercalate Text
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow

blockToHtmlInner :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html
blockToHtmlInner :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtmlInner WriterOptions
opts (Plain [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
blockToHtmlInner WriterOptions
opts (Para [Inline]
lst) = do
  HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
  case (HTMLSlideVariant
slideVariant, [Inline]
lst) of
    (HTMLSlideVariant
RevealJsSlides, [Image attr :: Attr
attr@(Text
_,[Text]
classes,[(Text, Text)]
_) [Inline]
txt (Text
src,Text
tit)])
      | Text
"r-stretch" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> do
          -- a "stretched" image in reveal.js must be a direct child
          -- of the slide container
          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))
    (HTMLSlideVariant, [Inline])
_ -> do
      Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
      case Html
contents of
        Empty ()
_ | Bool -> Bool
not (forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs WriterOptions
opts) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
        Html
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
H.p Html
contents
blockToHtmlInner WriterOptions
opts (LineBlock [[Inline]]
lns) = do
  Html
htmlLines <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
lns
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"line-block" forall a b. (a -> b) -> a -> b
$ Html
htmlLines
blockToHtmlInner WriterOptions
opts (Div (Text
ident, Text
"section":[Text]
dclasses, [(Text, Text)]
dkvs)
                   (Header Int
level
                     hattr :: Attr
hattr@(Text
hident,[Text]
hclasses,[(Text, Text)]
hkvs) [Inline]
ils : [Block]
xs)) = do
  HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
  Int
slideLevel <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stSlideLevel
  let slide :: Bool
slide = HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
NoSlides Bool -> Bool -> Bool
&&
               Int
level forall a. Ord a => a -> a -> Bool
<= Int
slideLevel {- DROPPED old fix for #5168 here -}
  Bool
html5 <- 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 forall a. Ord a => a -> a -> Bool
< Int
slideLevel
  let level' :: Int
level' = if Int
level forall a. Ord a => a -> a -> Bool
<= Int
slideLevel Bool -> Bool -> Bool
&& HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
SlidySlides
                  then Int
1 -- see #3566
                  else Int
level
  Html
header' <- if [Inline]
ils forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
"\0"]  -- marker for hrule
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
                else 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 (Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) [Block]
_) = Bool
True
      isSec (Div Attr
_ [Block]
zs)                = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isSec [Block]
zs
      isSec Block
_                         = Bool
False
  let isPause :: Block -> Bool
isPause (Para [Str Text
".",Inline
Space,Str Text
".",Inline
Space,Str Text
"."]) = Bool
True
      isPause Block
_                                            = Bool
False
  let fragmentClass :: Text
fragmentClass = case HTMLSlideVariant
slideVariant of
                           HTMLSlideVariant
RevealJsSlides -> Text
"fragment"
                           HTMLSlideVariant
_              -> Text
"incremental"
  let inDiv' :: [Block] -> [Block]
inDiv' [Block]
zs = Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"html") (Text
"<div class=\""
                       forall a. Semigroup a => a -> a -> a
<> Text
fragmentClass forall a. Semigroup a => a -> a -> a
<> Text
"\">") forall a. a -> [a] -> [a]
:
                   ([Block]
zs forall a. [a] -> [a] -> [a]
++ [Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"html") Text
"</div>"])
  let breakOnPauses :: [Block] -> [Block]
breakOnPauses [Block]
zs
        | Bool
slide = case forall a. (a -> Bool) -> [a] -> [[a]]
splitBy Block -> Bool
isPause [Block]
zs of
                           []   -> []
                           [Block]
y:[[Block]]
ys -> [Block]
y forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Block] -> [Block]
inDiv' [[Block]]
ys
        | Bool
otherwise = [Block]
zs
  let ([Block]
titleBlocks, [Block]
innerSecs) =
        if Bool
titleSlide
           -- title slides have no content of their own
           then let ([Block]
as, [Block]
bs) = 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 <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
titleBlocks
  Bool
inSection <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInSection
  Html
innerContents <- do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInSection :: Bool
stInSection = Bool
True }
    Html
res <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
innerSecs
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInSection :: Bool
stInSection = Bool
inSection }
    [Html]
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Html]
stNotes
    let emitNotes :: Bool
emitNotes = WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfSection Bool -> Bool -> Bool
&&
                     Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Html]
notes)
    if Bool
emitNotes
      then do
        WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
        Html
renderedNotes <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ReferenceLocation -> Int -> [Html] -> StateT WriterState m Html
footnoteSection WriterOptions
opts (WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts)
                           (WriterState -> Int
stEmittedNotes WriterState
st forall a. Num a => a -> a -> a
+ Int
1) (forall a. [a] -> [a]
reverse [Html]
notes)
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st' -> WriterState
st'{ stNotes :: [Html]
stNotes = forall a. Monoid a => a
mempty,
                             stEmittedNotes :: Int
stEmittedNotes = WriterState -> Int
stEmittedNotes WriterState
st' forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Html]
notes })
        forall (m :: * -> *) a. Monad m => a -> m a
return (Html
res forall a. Semigroup a => a -> a -> a
<> Html
renderedNotes)
      else forall (m :: * -> *) a. Monad m => a -> m a
return Html
res
  let classes' :: [Text]
classes' = [Text
"title-slide" | Bool
titleSlide] forall a. [a] -> [a] -> [a]
++ [Text
"slide" | Bool
slide] forall a. [a] -> [a] -> [a]
++
                  [Text
"section" | (Bool
slide Bool -> Bool -> Bool
|| WriterOptions -> Bool
writerSectionDivs WriterOptions
opts) Bool -> Bool -> Bool
&&
                               Bool -> Bool
not Bool
html5 ] forall a. [a] -> [a] -> [a]
++
                  [Text
"level" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
level | Bool
slide Bool -> Bool -> Bool
|| WriterOptions -> Bool
writerSectionDivs WriterOptions
opts ]
                  forall a. Semigroup a => a -> a -> a
<> [Text
d | Text
d <- [Text]
dclasses,
                               HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
RevealJsSlides Bool -> Bool -> Bool
||
                               Text
d forall a. Eq a => a -> a -> Bool
/= Text
"r-fit-text"] -- see #5965
  let attr :: Attr
attr = (Text
ident, [Text]
classes', [(Text, Text)]
dkvs)
  if Bool
titleSlide
     then do
       Html
t <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr forall a b. (a -> b) -> a -> b
$
             Html -> Html
secttag forall a b. (a -> b) -> a -> b
$ Html
nl forall a. Semigroup a => a -> a -> a
<> Html
header' forall a. Semigroup a => a -> a -> a
<> Html
nl forall a. Semigroup a => a -> a -> a
<> Html
titleContents forall a. Semigroup a => a -> a -> a
<> Html
nl
       -- ensure 2D nesting for revealjs, but only for one level;
       -- revealjs doesn't like more than one level of nesting
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
         if HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inSection Bool -> Bool -> Bool
&&
              Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
innerSecs)
            then Html -> Html
H5.section (Html
nl forall a. Semigroup a => a -> a -> a
<> Html
t forall a. Semigroup a => a -> a -> a
<> Html
nl forall a. Semigroup a => a -> a -> a
<> Html
innerContents)
            else Html
t forall a. Semigroup a => a -> a -> a
<> Html
nl forall a. Semigroup a => a -> a -> a
<> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
innerSecs
                                    then forall a. Monoid a => a
mempty
                                    else Html
innerContents forall a. Semigroup a => a -> a -> a
<> Html
nl
     else if WriterOptions -> Bool
writerSectionDivs WriterOptions
opts Bool -> Bool -> Bool
|| Bool
slide Bool -> Bool -> Bool
||
              (Text
hident 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 forall a. Eq a => a -> a -> Bool
/= [Text]
dclasses) Bool -> Bool -> Bool
|| ([(Text, Text)]
hkvs forall a. Eq a => a -> a -> Bool
/= [(Text, Text)]
dkvs)
          then forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr
               forall a b. (a -> b) -> a -> b
$ Html -> Html
secttag
               forall a b. (a -> b) -> a -> b
$ Html
nl forall a. Semigroup a => a -> a -> a
<> Html
header' forall a. Semigroup a => a -> a -> a
<> Html
nl forall a. Semigroup a => a -> a -> a
<>
                 if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
innerSecs
                    then forall a. Monoid a => a
mempty
                    else Html
innerContents forall a. Semigroup a => a -> a -> a
<> Html
nl
          else do
            let attr' :: Attr
attr' = (Text
ident, [Text]
classes' forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
hclasses, [(Text, Text)]
dkvs forall a. Eq a => [a] -> [a] -> [a]
\\ [(Text, Text)]
hkvs)
            Html
t <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr' Html
header'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html
t forall a. Semigroup a => a -> a -> a
<>
                     if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
innerSecs
                        then forall a. Monoid a => a
mempty
                        else Html
nl forall a. Semigroup a => a -> a -> a
<> Html
innerContents
blockToHtmlInner WriterOptions
opts (Div attr :: Attr
attr@(Text
ident, [Text]
classes, [(Text, Text)]
kvs') [Block]
bs) = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
  let isCslBibBody :: Bool
isCslBibBody = Text
ident forall a. Eq a => a -> a -> Bool
== Text
"refs" Bool -> Bool -> Bool
|| Text
"csl-bib-body" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isCslBibBody forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stCsl :: Bool
stCsl = Bool
True
                                        , stCslEntrySpacing :: Maybe Int
stCslEntrySpacing =
                                           forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"entry-spacing" [(Text, Text)]
kvs' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                           forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead }
  let isCslBibEntry :: Bool
isCslBibEntry = Text
"csl-entry" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  let kvs :: [(Text, Text)]
kvs = [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs'
                   , Text
k forall a. Eq a => a -> a -> Bool
/= Text
"width" Bool -> Bool -> Bool
|| Text
"column" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes] forall a. [a] -> [a] -> [a]
++
            [(Text
"style", Text
"width:" forall a. Semigroup a => a -> a -> a
<> Text
w forall a. Semigroup a => a -> a -> a
<> Text
";") | Text
"column" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                                             , (Text
"width", Text
w) <- [(Text, Text)]
kvs'] forall a. [a] -> [a] -> [a]
++
            [(Text
"role", Text
"list") | Bool
isCslBibBody Bool -> Bool -> Bool
&& Bool
html5] forall a. [a] -> [a] -> [a]
++
            [(Text
"role", Text
"listitem") | Bool
isCslBibEntry Bool -> Bool -> Bool
&& Bool
html5]
  let speakerNotes :: Bool
speakerNotes = Text
"notes" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  -- we don't want incremental output inside speaker notes, see #1394
  let opts' :: WriterOptions
opts' = if | Bool
speakerNotes -> WriterOptions
opts{ writerIncremental :: Bool
writerIncremental = Bool
False }
                 | Text
"incremental" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> WriterOptions
opts{ writerIncremental :: Bool
writerIncremental = Bool
True }
                 | Text
"nonincremental" 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
      -- we remove "incremental" and "nonincremental" if we're in a
      -- slide presentaiton format.
      classes' :: [Text]
classes' = case HTMLSlideVariant
slideVariant of
        HTMLSlideVariant
NoSlides -> [Text]
classes
        HTMLSlideVariant
_ -> forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
k -> Text
k forall a. Eq a => a -> a -> Bool
/= Text
"incremental" Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
/= Text
"nonincremental") [Text]
classes
  let paraToPlain :: Block -> Block
paraToPlain (Para [Inline]
ils) = [Inline] -> Block
Plain [Inline]
ils
      paraToPlain Block
x          = Block
x
  let bs' :: [Block]
bs' = if Text
"csl-entry" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes'
               then forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
paraToPlain [Block]
bs
               else [Block]
bs
  Html
contents <- if Text
"columns" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes'
                 then -- we don't use blockListToHtml because it inserts
                      -- a newline between the column divs, which throws
                      -- off widths! see #4028
                      forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts) [Block]
bs'
                 else forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts' [Block]
bs'
  let contents' :: Html
contents' = Html
nl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
  let (Html -> Html
divtag, [Text]
classes'') = if Bool
html5 Bool -> Bool -> Bool
&& Text
"section" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes'
                            then (Html -> Html
H5.section, forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Text
"section") [Text]
classes')
                            else (Html -> Html
H.div, [Text]
classes')
  if Bool
speakerNotes
     then case HTMLSlideVariant
slideVariant of
               HTMLSlideVariant
RevealJsSlides -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts' Attr
attr forall a b. (a -> b) -> a -> b
$
                           Html -> Html
H5.aside Html
contents'
               HTMLSlideVariant
DZSlides       -> do
                 Html
t <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts' Attr
attr forall a b. (a -> b) -> a -> b
$
                             Html -> Html
H5.div Html
contents'
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html
t forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.role AttributeValue
"note"
               HTMLSlideVariant
NoSlides       -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts' Attr
attr forall a b. (a -> b) -> a -> b
$
                           Html -> Html
H.div Html
contents'
               HTMLSlideVariant
_              -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     else forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ident, [Text]
classes'', [(Text, Text)]
kvs) forall a b. (a -> b) -> a -> b
$
              Html -> Html
divtag Html
contents'
blockToHtmlInner WriterOptions
opts (RawBlock Format
f Text
str) = do
  Bool
ishtml <- forall (m :: * -> *).
PandocMonad m =>
Format -> StateT WriterState m Bool
isRawHtml Format
f
  if Bool
ishtml
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Html
preEscapedText Text
str
     else if (Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex") Bool -> Bool -> Bool
&&
             HTMLMathMethod -> Bool
allowsMathEnvironments (WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts) Bool -> Bool -> Bool
&&
             Text -> Bool
isMathEnvironment Text
str
             then do
               forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st {stMath :: Bool
stMath = Bool
True})
               forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Plain [MathType -> Text -> Inline
Math MathType
DisplayMath Text
str]
             else do
               forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered (Format -> Text -> Block
RawBlock Format
f Text
str)
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
blockToHtmlInner WriterOptions
_ Block
HorizontalRule = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
html5 then Html
H5.hr else Html
H.hr
blockToHtmlInner WriterOptions
opts (CodeBlock (Text
id',[Text]
classes,[(Text, Text)]
keyvals) Text
rawCode) = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  Text
id'' <- if Text -> Bool
T.null Text
id'
             then do
               forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stCodeBlockNum :: Int
stCodeBlockNum = WriterState -> Int
stCodeBlockNum WriterState
st forall a. Num a => a -> a -> a
+ Int
1 }
               Int
codeblocknum <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stCodeBlockNum
               forall (m :: * -> *) a. Monad m => a -> m a
return (WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts forall a. Semigroup a => a -> a -> a
<> Text
"cb" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
codeblocknum)
             else forall (m :: * -> *) a. Monad m => a -> m a
return (WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts forall a. Semigroup a => a -> a -> a
<> Text
id')
  let tolhs :: Bool
tolhs = forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts Bool -> Bool -> Bool
&&
                forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
c -> Text -> Text
T.toLower Text
c forall a. Eq a => a -> a -> Bool
== Text
"haskell") [Text]
classes Bool -> Bool -> Bool
&&
                forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
c -> Text -> Text
T.toLower Text
c forall a. Eq a => a -> a -> Bool
== Text
"literate") [Text]
classes
      classes' :: [Text]
classes' = if Bool
tolhs
                    then forall a b. (a -> b) -> [a] -> [b]
map (\Text
c -> if Text -> Text
T.toLower Text
c forall a. Eq a => a -> a -> Bool
== Text
"haskell"
                                       then Text
"literatehaskell"
                                       else Text
c) [Text]
classes
                    else [Text]
classes
      adjCode :: Text
adjCode  = if Bool
tolhs
                    then [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text
"> " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text
rawCode
                    else Text
rawCode
      hlCode :: Either Text Html
hlCode   = if forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
                    then forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts)
                         (if Bool
html5 then FormatOptions -> [SourceLine] -> Html
formatHtmlBlock else FormatOptions -> [SourceLine] -> Html
formatHtml4Block)
                            (Text
id'',[Text]
classes',[(Text, Text)]
keyvals) Text
adjCode
                    else forall a b. a -> Either a b
Left Text
""
  case Either Text Html
hlCode of
         Left Text
msg -> do
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) forall a b. (a -> b) -> a -> b
$
             forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
           forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
id',[Text]
classes,[(Text, Text)]
keyvals)
             forall a b. (a -> b) -> a -> b
$ Html -> Html
H.pre forall a b. (a -> b) -> a -> b
$ Html -> Html
H.code forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Text
adjCode
         Right Html
h -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                    -- we set writerIdentifierPrefix to "" since id'' already
                    -- includes it:
                    forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts{writerIdentifierPrefix :: Text
writerIdentifierPrefix = Text
""} (Text
id'',[],[(Text, Text)]
keyvals) Html
h
blockToHtmlInner WriterOptions
opts (BlockQuote [Block]
blocks) = do
  -- in S5, treat list in blockquote specially
  -- if default is incremental, make it nonincremental;
  -- otherwise incremental
  HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
  if HTMLSlideVariant
slideVariant 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 [[Block]]
lst]  -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml (WriterOptions
opts {writerIncremental :: Bool
writerIncremental = Bool
inc})
                                  ([[Block]] -> Block
BulletList [[Block]]
lst)
             [OrderedList ListAttributes
attribs [[Block]]
lst] ->
                                  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 [([Inline], [[Block]])]
lst] ->
                                  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)
             [Block]
_                 -> do Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks
                                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
H.blockquote
                                            forall a b. (a -> b) -> a -> b
$ Html
nl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
     else do
       Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
H.blockquote forall a b. (a -> b) -> a -> b
$ Html
nl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
blockToHtmlInner WriterOptions
opts (Header Int
level (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
lst) = do
  Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
  let secnum :: Text
secnum = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"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
&& Text
"unnumbered" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes
                     then (Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"header-section-number"
                             forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Text
secnum) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. ToMarkup a => a -> Html
toHtml Char
' ' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents
                     else Html
contents
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  let kvs' :: [(Text, Text)]
kvs' = if Bool
html5
             then [(Text, Text)]
kvs
             else [ (Text
k, Text
v) | (Text
k, Text
v) <- [(Text, Text)]
kvs
                           , Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Text
"lang", Text
"dir", Text
"title", Text
"style"
                                      , Text
"align"] forall a. [a] -> [a] -> [a]
++ [Text]
intrinsicEventsHTML4)]
  let classes' :: [Text]
classes' = if Int
level forall a. Ord a => a -> a -> Bool
> Int
6 then Text
"heading"forall a. a -> [a] -> [a]
:[Text]
classes else [Text]
classes
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ident,[Text]
classes',[(Text, Text)]
kvs')
         forall a b. (a -> b) -> a -> b
$ case Int
level of
              Int
1 -> Html -> Html
H.h1 Html
contents'
              Int
2 -> Html -> Html
H.h2 Html
contents'
              Int
3 -> Html -> Html
H.h3 Html
contents'
              Int
4 -> Html -> Html
H.h4 Html
contents'
              Int
5 -> Html -> Html
H.h5 Html
contents'
              Int
6 -> Html -> Html
H.h6 Html
contents'
              Int
_ -> Html -> Html
H.p  Html
contents'
blockToHtmlInner WriterOptions
opts (BulletList [[Block]]
lst) = do
  [Html]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml WriterOptions
opts) [[Block]]
lst
  let isTaskList :: Bool
isTaskList = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
lst) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isTaskListItem [[Block]]
lst
  (if Bool
isTaskList then (forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"task-list") else forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
unordList WriterOptions
opts [Html]
contents
blockToHtmlInner WriterOptions
opts (OrderedList (Int
startnum, ListNumberStyle
numstyle, ListNumberDelim
_) [[Block]]
lst) = do
  [Html]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml WriterOptions
opts) [[Block]]
lst
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  let numstyle' :: Text
numstyle' = case ListNumberStyle
numstyle of
                       ListNumberStyle
Example -> Text
"decimal"
                       ListNumberStyle
_       -> Text -> Text
camelCaseToHyphenated forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow ListNumberStyle
numstyle
  let attribs :: [Attribute]
attribs = [AttributeValue -> Attribute
A.start forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue Int
startnum | Int
startnum forall a. Eq a => a -> a -> Bool
/= Int
1] forall a. [a] -> [a] -> [a]
++
                [AttributeValue -> Attribute
A.class_ AttributeValue
"example" | ListNumberStyle
numstyle forall a. Eq a => a -> a -> Bool
== ListNumberStyle
Example] forall a. [a] -> [a] -> [a]
++
                (if ListNumberStyle
numstyle forall a. Eq a => a -> a -> Bool
/= ListNumberStyle
DefaultStyle
                   then if Bool
html5
                           then [AttributeValue -> Attribute
A.type_ forall a b. (a -> b) -> a -> b
$
                                 case ListNumberStyle
numstyle of
                                      ListNumberStyle
Decimal    -> AttributeValue
"1"
                                      ListNumberStyle
LowerAlpha -> AttributeValue
"a"
                                      ListNumberStyle
UpperAlpha -> AttributeValue
"A"
                                      ListNumberStyle
LowerRoman -> AttributeValue
"i"
                                      ListNumberStyle
UpperRoman -> AttributeValue
"I"
                                      ListNumberStyle
_          -> AttributeValue
"1"]
                           else [AttributeValue -> Attribute
A.style forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ Text
"list-style-type: " forall a. Semigroup a => a -> a -> a
<>
                                   Text
numstyle']
                   else [])
  Html
l <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
ordList WriterOptions
opts [Html]
contents
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall h. Attributable h => h -> Attribute -> h
(!) Html
l [Attribute]
attribs
blockToHtmlInner WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
lst) = do
  [Html]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\([Inline]
term, [[Block]]
defs) ->
                  do Html
term' <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Html -> Html
H.dt forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
term
                     [Html]
defs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\Html
x -> Html -> Html
H.dd (Html
nl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts) [[Block]]
defs
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Html
nl forall a. a -> [a] -> [a]
: Html
term' forall a. a -> [a] -> [a]
: Html
nl forall a. a -> [a] -> [a]
:
                                        forall a. a -> [a] -> [a]
intersperse (Html
nl) [Html]
defs') [([Inline], [[Block]])]
lst
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
defList WriterOptions
opts [Html]
contents
blockToHtmlInner WriterOptions
opts (Table Attr
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Table -> StateT WriterState m Html
tableToHtml WriterOptions
opts (Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable Attr
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot)
blockToHtmlInner WriterOptions
opts (Figure Attr
attrs (Caption Maybe [Inline]
_ [Block]
captBody)  [Block]
body) = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5

  [Attribute]
figAttrs <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts Attr
attrs
  Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
body
  Html
figCaption <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
captBody
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
                else do
                  Html
captCont <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
captBody
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
                    if Bool
html5
                    then let fcattr :: Attribute
fcattr = if forall {a}. Walkable Inline a => a -> [Block] -> Bool
captionIsAlt [Block]
captBody [Block]
body
                                      then Tag -> AttributeValue -> Attribute
H5.customAttribute
                                           (Text -> Tag
textTag Text
"aria-hidden")
                                           (forall a. ToValue a => a -> AttributeValue
toValue @Text Text
"true")
                                      else forall a. Monoid a => a
mempty
                         in [ Html -> Html
H5.figcaption forall h. Attributable h => h -> Attribute -> h
! Attribute
fcattr forall a b. (a -> b) -> a -> b
$ Html
captCont, Html
nl ]
                    else [ (Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"figcaption") Html
captCont, Html
nl ]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    if Bool
html5
    then forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall h. Attributable h => h -> Attribute -> h
(!) Html -> Html
H5.figure [Attribute]
figAttrs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Html
nl, Html
contents, Html
nl, Html
figCaption]
    else forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall h. Attributable h => h -> Attribute -> h
(!) Html -> Html
H.div (AttributeValue -> Attribute
A.class_ AttributeValue
"float" forall a. a -> [a] -> [a]
: [Attribute]
figAttrs) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
           [Html
nl, Html
contents, Html
nl, Html
figCaption]
 where
  captionIsAlt :: a -> [Block] -> Bool
captionIsAlt a
capt [Plain [Image (Text
_, [Text]
_, [(Text, Text)]
kv) [Inline]
desc (Text, Text)
_]] =
    let alt :: Text
alt = forall a. a -> Maybe a -> a
fromMaybe (forall a. Walkable Inline a => a -> Text
stringify [Inline]
desc) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"alt" [(Text, Text)]
kv
    in forall a. Walkable Inline a => a -> Text
stringify a
capt forall a. Eq a => a -> a -> Bool
== Text
alt
  captionIsAlt a
_ [Block]
_ = Bool
False

-- | Convert Pandoc block element to HTML. All the legwork is done by
-- 'blockToHtmlInner', this just takes care of emitting the notes after
-- the block if necessary.
blockToHtml :: PandocMonad m => WriterOptions -> Block -> StateT WriterState m Html
blockToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts Block
block = do
  let isSection :: Bool
isSection = case Block
block of
        Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
_ | Text
"section" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> Bool
True
        Block
_ -> Bool
False
  let increaseLevel :: Bool
increaseLevel = Bool -> Bool
not Bool
isSection
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
increaseLevel forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stBlockLevel :: Int
stBlockLevel = WriterState -> Int
stBlockLevel WriterState
st forall a. Num a => a -> a -> a
+ Int
1 })
  Html
doc <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtmlInner WriterOptions
opts Block
block
  WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  let emitNotes :: Bool
emitNotes =
        WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfBlock Bool -> Bool -> Bool
&& WriterState -> Int
stBlockLevel WriterState
st forall a. Eq a => a -> a -> Bool
== Int
1
  Html
res <- if Bool
emitNotes
    then do
      Html
notes <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (WriterState -> [Html]
stNotes WriterState
st)
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
        else forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ReferenceLocation -> Int -> [Html] -> StateT WriterState m Html
footnoteSection WriterOptions
opts (WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts)
                             (WriterState -> Int
stEmittedNotes WriterState
st forall a. Num a => a -> a -> a
+ Int
1) (forall a. [a] -> [a]
reverse (WriterState -> [Html]
stNotes WriterState
st))
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st' -> WriterState
st'{ stNotes :: [Html]
stNotes = forall a. Monoid a => a
mempty, stEmittedNotes :: Int
stEmittedNotes = WriterState -> Int
stEmittedNotes WriterState
st' forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (WriterState -> [Html]
stNotes WriterState
st') })
      forall (m :: * -> *) a. Monad m => a -> m a
return (Html
doc forall a. Semigroup a => a -> a -> a
<> Html
notes)
    else forall (m :: * -> *) a. Monad m => a -> m a
return Html
doc
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
increaseLevel forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st' -> WriterState
st'{ stBlockLevel :: Int
stBlockLevel = WriterState -> Int
stBlockLevel WriterState
st' forall a. Num a => a -> a -> a
- Int
1 })
  forall (m :: * -> *) a. Monad m => a -> m a
return Html
res

tableToHtml :: PandocMonad m
            => WriterOptions
            -> Ann.Table
            -> StateT WriterState m Html
tableToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Table -> StateT WriterState m Html
tableToHtml WriterOptions
opts (Ann.Table Attr
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = do
  Html
captionDoc <- case Caption
caption of
    Caption Maybe [Inline]
_ [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    Caption Maybe [Inline]
_ [Block]
longCapt -> do
      Html
cs <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
longCapt
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
H.caption Html
cs
        Html
nl
  Html
coltags <- forall (m :: * -> *).
PandocMonad m =>
[ColSpec] -> StateT WriterState m Html
colSpecListToHtml [ColSpec]
colspecs
  Html
head' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableHead -> StateT WriterState m Html
tableHeadToHtml WriterOptions
opts TableHead
thead
  [Html]
bodies <- forall a. a -> [a] -> [a]
intersperse (Html
nl) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableBody -> StateT WriterState m Html
tableBodyToHtml WriterOptions
opts) [TableBody]
tbodies
  Html
foot' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableFoot -> StateT WriterState m Html
tableFootToHtml WriterOptions
opts TableFoot
tfoot
  let (Text
ident,[Text]
classes,[(Text, Text)]
kvs) = Attr
attr
  -- When widths of columns are < 100%, we need to set width for the whole
  -- table, or some browsers give us skinny columns with lots of space
  -- between:
  let colWidth :: ColWidth -> Double
colWidth = \case
        ColWidth Double
d -> Double
d
        ColWidth
ColWidthDefault -> Double
0
  let totalWidth :: Double
totalWidth = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ColWidth -> Double
colWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ [ColSpec]
colspecs
  let attr' :: Attr
attr' = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [(Text, Text)]
kvs of
                Maybe Text
Nothing | Double
totalWidth forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
&& Double
totalWidth forall a. Ord a => a -> a -> Bool
> Double
0
                  -> (Text
ident,[Text]
classes, (Text
"style",Text
"width:" forall a. Semigroup a => a -> a -> a
<>
                         String -> Text
T.pack (forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
totalWidth forall a. Num a => a -> a -> a
* Double
100) :: Int))
                         forall a. Semigroup a => a -> a -> a
<> Text
"%;")forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs)
                Maybe Text
_ -> Attr
attr
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr' forall a b. (a -> b) -> a -> b
$ Html -> Html
H.table forall a b. (a -> b) -> a -> b
$ do
    Html
nl
    Html
captionDoc
    Html
coltags
    Html
head'
    forall a. Monoid a => [a] -> a
mconcat [Html]
bodies
    Html
foot'
    Html
nl

tableBodyToHtml :: PandocMonad m
                => WriterOptions
                -> Ann.TableBody
                -> StateT WriterState m Html
tableBodyToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableBody -> StateT WriterState m Html
tableBodyToHtml WriterOptions
opts (Ann.TableBody Attr
attr RowHeadColumns
_rowHeadCols [HeaderRow]
inthead [BodyRow]
rows) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
H.tbody forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Html
intermediateHead <-
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
inthead
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
      else forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> TablePart -> [HeaderRow] -> StateT WriterState m Html
headerRowsToHtml WriterOptions
opts TablePart
Thead [HeaderRow]
inthead
    Html
bodyRows <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [BodyRow] -> StateT WriterState m Html
bodyRowsToHtml WriterOptions
opts [BodyRow]
rows
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html
intermediateHead forall a. Semigroup a => a -> a -> a
<> Html
bodyRows

tableHeadToHtml :: PandocMonad m
                => WriterOptions
                -> Ann.TableHead
                -> StateT WriterState m Html
tableHeadToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableHead -> StateT WriterState m Html
tableHeadToHtml WriterOptions
opts (Ann.TableHead Attr
attr [HeaderRow]
rows) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> TablePart -> Attr -> [HeaderRow] -> StateT WriterState m Html
tablePartToHtml WriterOptions
opts TablePart
Thead Attr
attr [HeaderRow]
rows

tableFootToHtml :: PandocMonad m
                => WriterOptions
                -> Ann.TableFoot
                -> StateT WriterState m Html
tableFootToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableFoot -> StateT WriterState m Html
tableFootToHtml WriterOptions
opts (Ann.TableFoot Attr
attr [HeaderRow]
rows) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> TablePart -> Attr -> [HeaderRow] -> StateT WriterState m Html
tablePartToHtml WriterOptions
opts TablePart
Tfoot Attr
attr [HeaderRow]
rows

tablePartToHtml :: PandocMonad m
                => WriterOptions
                -> TablePart
                -> Attr
                -> [Ann.HeaderRow]
                -> StateT WriterState m Html
tablePartToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> TablePart -> Attr -> [HeaderRow] -> StateT WriterState m Html
tablePartToHtml WriterOptions
opts TablePart
tblpart Attr
attr [HeaderRow]
rows =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
rows Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all HeaderRow -> Bool
isEmptyRow [HeaderRow]
rows
  then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  else do
    let tag' :: Html -> Html
tag' = case TablePart
tblpart of
                 TablePart
Thead -> Html -> Html
H.thead
                 TablePart
Tfoot -> Html -> Html
H.tfoot
                 TablePart
Tbody -> Html -> Html
H.tbody -- this would be unexpected
    Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> TablePart -> [HeaderRow] -> StateT WriterState m Html
headerRowsToHtml WriterOptions
opts TablePart
tblpart [HeaderRow]
rows
    Html
tablePartElement <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr forall a b. (a -> b) -> a -> b
$ Html -> Html
tag' Html
contents
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
      Html
tablePartElement
      Html
nl
  where
    isEmptyRow :: HeaderRow -> Bool
isEmptyRow (Ann.HeaderRow Attr
_attr RowNumber
_rownum [Cell]
cells) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Cell -> Bool
isEmptyCell [Cell]
cells
    isEmptyCell :: Cell -> Bool
isEmptyCell (Ann.Cell NonEmpty ColSpec
_colspecs ColNumber
_colnum Cell
cell) =
      Cell
cell forall a. Eq a => a -> a -> Bool
== Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
nullAttr Alignment
AlignDefault (Int -> RowSpan
RowSpan Int
1) (Int -> ColSpan
ColSpan Int
1) []

-- | The part of a table; header, footer, or body.
data TablePart = Thead | Tfoot | Tbody
  deriving (TablePart -> TablePart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TablePart -> TablePart -> Bool
$c/= :: TablePart -> TablePart -> Bool
== :: TablePart -> TablePart -> Bool
$c== :: TablePart -> TablePart -> Bool
Eq)

data CellType = HeaderCell | BodyCell

data TableRow = TableRow TablePart Attr Ann.RowNumber Ann.RowHead Ann.RowBody

headerRowsToHtml :: PandocMonad m
                 => WriterOptions
                 -> TablePart
                 -> [Ann.HeaderRow]
                 -> StateT WriterState m Html
headerRowsToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> TablePart -> [HeaderRow] -> StateT WriterState m Html
headerRowsToHtml WriterOptions
opts TablePart
tablepart =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [TableRow] -> StateT WriterState m Html
rowListToHtml WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HeaderRow -> TableRow
toTableRow
  where
    toTableRow :: HeaderRow -> TableRow
toTableRow (Ann.HeaderRow Attr
attr RowNumber
rownum [Cell]
rowbody) =
      TablePart -> Attr -> RowNumber -> [Cell] -> [Cell] -> TableRow
TableRow TablePart
tablepart Attr
attr RowNumber
rownum [] [Cell]
rowbody

bodyRowsToHtml :: PandocMonad m
               => WriterOptions
               -> [Ann.BodyRow]
               -> StateT WriterState m Html
bodyRowsToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [BodyRow] -> StateT WriterState m Html
bodyRowsToHtml WriterOptions
opts =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [TableRow] -> StateT WriterState m Html
rowListToHtml WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RowNumber -> BodyRow -> TableRow
toTableRow [RowNumber
1..]
  where
    toTableRow :: RowNumber -> BodyRow -> TableRow
toTableRow RowNumber
rownum (Ann.BodyRow Attr
attr RowNumber
_rownum [Cell]
rowhead [Cell]
rowbody) =
      TablePart -> Attr -> RowNumber -> [Cell] -> [Cell] -> TableRow
TableRow TablePart
Tbody Attr
attr RowNumber
rownum [Cell]
rowhead [Cell]
rowbody


rowListToHtml :: PandocMonad m
              => WriterOptions
              -> [TableRow]
              -> StateT WriterState m Html
rowListToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [TableRow] -> StateT WriterState m Html
rowListToHtml WriterOptions
opts [TableRow]
rows =
  (\[Html]
x -> Html
nl forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Monoid a => [a] -> a
mconcat [Html]
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableRow -> StateT WriterState m Html
tableRowToHtml WriterOptions
opts) [TableRow]
rows

colSpecListToHtml :: PandocMonad m
                  => [ColSpec]
                  -> StateT WriterState m Html
colSpecListToHtml :: forall (m :: * -> *).
PandocMonad m =>
[ColSpec] -> StateT WriterState m Html
colSpecListToHtml [ColSpec]
colspecs = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  let hasDefaultWidth :: (a, ColWidth) -> Bool
hasDefaultWidth (a
_, ColWidth
ColWidthDefault) = Bool
True
      hasDefaultWidth (a, ColWidth)
_                    = Bool
False

  let percent :: a -> String
percent a
w = forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
100forall a. Num a => a -> a -> a
*a
w) :: Integer) forall a. Semigroup a => a -> a -> a
<> String
"%"

  let col :: ColWidth -> Html
      col :: ColWidth -> Html
col ColWidth
cw = do
        Html
H.col forall h. Attributable h => h -> Attribute -> h
! case ColWidth
cw of
          ColWidth
ColWidthDefault -> forall a. Monoid a => a
mempty
          ColWidth Double
w -> if Bool
html5
                        then AttributeValue -> Attribute
A.style (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ String
"width: " forall a. Semigroup a => a -> a -> a
<> forall {a}. RealFrac a => a -> String
percent Double
w)
                        else AttributeValue -> Attribute
A.width (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ forall {a}. RealFrac a => a -> String
percent Double
w)
        Html
nl

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {a}. (a, ColWidth) -> Bool
hasDefaultWidth [ColSpec]
colspecs
    then forall a. Monoid a => a
mempty
    else do
      Html -> Html
H.colgroup forall a b. (a -> b) -> a -> b
$ do
        Html
nl
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ColWidth -> Html
col forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [ColSpec]
colspecs
      Html
nl

tableRowToHtml :: PandocMonad m
               => WriterOptions
               -> TableRow
               -> StateT WriterState m Html
tableRowToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableRow -> StateT WriterState m Html
tableRowToHtml WriterOptions
opts (TableRow TablePart
tblpart Attr
attr RowNumber
rownum [Cell]
rowhead [Cell]
rowbody) = do
  let rowclass :: Text
rowclass = case RowNumber
rownum of
        Ann.RowNumber Int
x | Int
x forall a. Integral a => a -> a -> a
`rem` Int
2 forall a. Eq a => a -> a -> Bool
== Int
1   -> Text
"odd"
        RowNumber
_               | TablePart
tblpart forall a. Eq a => a -> a -> Bool
/= TablePart
Thead -> Text
"even"
        RowNumber
_                                  -> Text
"header"
  let attr' :: Attr
attr' = case Attr
attr of
                (Text
id', [Text]
classes, [(Text, Text)]
rest) -> (Text
id', Text
rowclassforall a. a -> [a] -> [a]
:[Text]
classes, [(Text, Text)]
rest)
  let celltype :: CellType
celltype = case TablePart
tblpart of
                   TablePart
Thead -> CellType
HeaderCell
                   TablePart
_     -> CellType
BodyCell
  [Html]
headcells <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> CellType -> Cell -> StateT WriterState m Html
cellToHtml WriterOptions
opts CellType
HeaderCell) [Cell]
rowhead
  [Html]
bodycells <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> CellType -> Cell -> StateT WriterState m Html
cellToHtml WriterOptions
opts CellType
celltype) [Cell]
rowbody
  Html
rowHtml <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr' forall a b. (a -> b) -> a -> b
$ Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$ do
    Html
nl
    forall a. Monoid a => [a] -> a
mconcat [Html]
headcells
    forall a. Monoid a => [a] -> a
mconcat [Html]
bodycells
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
    Html
rowHtml
    Html
nl

colspanAttrib :: ColSpan -> Attribute
colspanAttrib :: ColSpan -> Attribute
colspanAttrib = \case
  ColSpan Int
1 -> forall a. Monoid a => a
mempty
  ColSpan Int
n -> AttributeValue -> Attribute
A.colspan (forall a. ToValue a => a -> AttributeValue
toValue Int
n)

rowspanAttrib :: RowSpan -> Attribute
rowspanAttrib :: RowSpan -> Attribute
rowspanAttrib = \case
  RowSpan Int
1 -> forall a. Monoid a => a
mempty
  RowSpan Int
n -> AttributeValue -> Attribute
A.rowspan (forall a. ToValue a => a -> AttributeValue
toValue Int
n)

cellToHtml :: PandocMonad m
           => WriterOptions
           -> CellType
           -> Ann.Cell
           -> StateT WriterState m Html
cellToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> CellType -> Cell -> StateT WriterState m Html
cellToHtml WriterOptions
opts CellType
celltype (Ann.Cell (ColSpec
colspec :| [ColSpec]
_) ColNumber
_colNum Cell
cell) =
  let align :: Alignment
align = forall a b. (a, b) -> a
fst ColSpec
colspec
  in forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> CellType -> Alignment -> Cell -> StateT WriterState m Html
tableCellToHtml WriterOptions
opts CellType
celltype Alignment
align Cell
cell

tableCellToHtml :: PandocMonad m
                => WriterOptions
                -> CellType
                -> Alignment
                -> Cell
                -> StateT WriterState m Html
tableCellToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> CellType -> Alignment -> Cell -> StateT WriterState m Html
tableCellToHtml WriterOptions
opts CellType
ctype Alignment
colAlign (Cell Attr
attr Alignment
align RowSpan
rowspan ColSpan
colspan [Block]
item) = do
  Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
item
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  let (Text
ident, [Text]
cls, [(Text, Text)]
kvs) = Attr
attr
  let tag' :: Html -> Html
tag' = case CellType
ctype of
        CellType
BodyCell   -> Html -> Html
H.td
        CellType
HeaderCell -> Html -> Html
H.th
  let align' :: Alignment
align' = case Alignment
align of
        Alignment
AlignDefault -> Alignment
colAlign
        Alignment
_            -> Alignment
align
  let kvs' :: [(Text, Text)]
kvs' = case Alignment -> Maybe Text
htmlAlignmentToString Alignment
align' of
               Maybe Text
Nothing ->
                 [(Text, Text)]
kvs
               Just Text
alignStr ->
                 if Bool
html5
                 then (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
htmlAddStyle (Text
"text-align", Text
alignStr) [(Text, Text)]
kvs
                 else case forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((forall a. Eq a => a -> a -> Bool
== Text
"align") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Text)]
kvs of
                   ([(Text, Text)]
_, []) -> (Text
"align", Text
alignStr) forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                   ([(Text, Text)]
xs, (Text, Text)
_:[(Text, Text)]
rest) -> [(Text, Text)]
xs forall a. [a] -> [a] -> [a]
++ (Text
"align", Text
alignStr) forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
  [Attribute]
otherAttribs <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts (Text
ident, [Text]
cls, [(Text, Text)]
kvs')
  let attribs :: Attribute
attribs = forall a. Monoid a => [a] -> a
mconcat
              forall a b. (a -> b) -> a -> b
$ ColSpan -> Attribute
colspanAttrib ColSpan
colspan
              forall a. a -> [a] -> [a]
: RowSpan -> Attribute
rowspanAttrib RowSpan
rowspan
              forall a. a -> [a] -> [a]
: [Attribute]
otherAttribs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
tag' forall h. Attributable h => h -> Attribute -> h
! Attribute
attribs forall a b. (a -> b) -> a -> b
$ Html
contents
    Html
nl

toListItems :: [Html] -> [Html]
toListItems :: [Html] -> [Html]
toListItems [Html]
items = forall a b. (a -> b) -> [a] -> [b]
map Html -> Html
toListItem [Html]
items forall a. [a] -> [a] -> [a]
++ [Html
nl]

toListItem :: Html -> Html
toListItem :: Html -> Html
toListItem Html
item = Html
nl forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Html -> Html
H.li Html
item

blockListToHtml :: PandocMonad m
                => WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
lst =
  forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (Html
nl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. MarkupM a -> Bool
nonempty
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts) [Block]
lst
  where nonempty :: MarkupM a -> Bool
nonempty (Empty a
_) = Bool
False
        nonempty MarkupM a
_         = Bool
True

-- | Convert list of Pandoc inline elements to HTML.
inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts) [Inline]
lst

-- | Annotates a MathML expression with the tex source
annotateMML :: XML.Element -> Text -> XML.Element
annotateMML :: Element -> Text -> Element
annotateMML Element
e Text
tex = Element -> Element
math (forall t. Node t => String -> t -> Element
unode String
"semantics" [Element
cs, forall t. Node t => String -> t -> Element
unode String
"annotation" ([Attr]
annotAttrs, Text -> String
T.unpack Text
tex)])
  where
    cs :: Element
cs = case Element -> [Element]
elChildren Element
e of
          []  -> forall t. Node t => String -> t -> Element
unode String
"mrow" ()
          [Element
x] -> Element
x
          [Element]
xs  -> forall t. Node t => String -> t -> Element
unode String
"mrow" [Element]
xs
    math :: Element -> Element
math 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 QName
q [Attr]
as [Content]
_ Maybe Integer
l) = Element
e
    annotAttrs :: [Attr]
annotAttrs = [QName -> String -> Attr
XML.Attr (String -> QName
unqual String
"encoding") String
"application/x-tex"]


-- | Convert Pandoc inline element to HTML.
inlineToHtml :: PandocMonad m
             => WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts Inline
inline = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  case Inline
inline of
    (Str Text
str)      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Html
strToHtml Text
str
    Inline
Space          -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Char
' '
    Inline
SoftBreak      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
                                     WrapOption
WrapNone     -> forall a. ToMarkup a => a -> Html
toHtml Char
' '
                                     WrapOption
WrapAuto     -> forall a. ToMarkup a => a -> Html
toHtml Char
' '
                                     WrapOption
WrapPreserve -> forall a. ToMarkup a => a -> Html
toHtml Char
'\n'
    Inline
LineBreak      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
                        if Bool
html5 then Html
H5.br else Html
H.br
                        forall a. ToMarkup a => a -> Html
toHtml Char
'\n'
    (Span (Text
"",[Text
cls],[]) [Inline]
ils)
        | Text
cls forall a. Eq a => a -> a -> Bool
== Text
"csl-block" Bool -> Bool -> Bool
|| Text
cls forall a. Eq a => a -> a -> Bool
== Text
"csl-left-margin" Bool -> Bool -> Bool
||
          Text
cls forall a. Eq a => a -> a -> Bool
== Text
"csl-right-inline" Bool -> Bool -> Bool
|| Text
cls forall a. Eq a => a -> a -> Bool
== Text
"csl-indent"
        -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
Text -> Html -> StateT WriterState m Html
inDiv Text
cls

    (Span (Text
id',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) ->
                        let go :: Maybe (Html -> Html, [Text])
-> Text -> Maybe (Html -> Html, [Text])
go Maybe (Html -> Html, [Text])
Nothing Text
c
                             | Text
c forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
htmlSpanLikeElements
                               = forall a. a -> Maybe a
Just (Tag -> Html -> Html
customParent (Text -> Tag
textTag Text
c), [])
                             | Text
c forall a. Eq a => a -> a -> Bool
== Text
"smallcaps"
                               = forall a. a -> Maybe a
Just (Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"smallcaps", [])
                             | Text
c forall a. Eq a => a -> a -> Bool
== Text
"underline"
                               = forall a. a -> Maybe a
Just (Html -> Html
H.u, [])
                             | Bool
otherwise = forall a. Maybe a
Nothing
                            go (Just (Html -> Html
t,[Text]
cs)) Text
c
                             | Text
c forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
htmlSpanLikeElements
                               = forall a. a -> Maybe a
Just (Html -> Html
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Html -> Html
customParent (Text -> Tag
textTag Text
c), [Text]
cs)
                             | Text
c forall a. Eq a => a -> a -> Bool
== Text
"smallcaps"
                               = forall a. a -> Maybe a
Just (Html -> Html
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"smallcaps"), [Text]
cs)
                             | Text
c forall a. Eq a => a -> a -> Bool
== Text
"underline"
                               = forall a. a -> Maybe a
Just (Html -> Html
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
H.u, [Text]
cs)
                             | Bool
otherwise
                               = forall a. a -> Maybe a
Just (Html -> Html
t, Text
cforall a. a -> [a] -> [a]
:[Text]
cs)
                            spanLikeTags :: [Text] -> Maybe (Html -> Html, [Text])
spanLikeTags = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe (Html -> Html, [Text])
-> Text -> Maybe (Html -> Html, [Text])
go forall a. Maybe a
Nothing
                        in case [Text] -> Maybe (Html -> Html, [Text])
spanLikeTags [Text]
classes of
                            Just (Html -> Html
tag, [Text]
cs) -> do
                              Html
h <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils
                              forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
id',[Text]
cs,[(Text, Text)]
kvs') forall a b. (a -> b) -> a -> b
$ Html -> Html
tag Html
h
                            Maybe (Html -> Html, [Text])
Nothing -> do
                              Html
h <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils
                              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 = [Text
"font-style:normal;"
                                       | Text
"csl-no-emph" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                                    forall a. [a] -> [a] -> [a]
++ [Text
"font-weight:normal;"
                                       | Text
"csl-no-strong" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                                    forall a. [a] -> [a] -> [a]
++ [Text
"font-variant:normal;"
                                       | Text
"csl-no-smallcaps" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                              kvs' :: [(Text, Text)]
kvs' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
styles
                                        then [(Text, Text)]
kvs
                                        else (Text
"style", [Text] -> Text
T.concat [Text]
styles) forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                              classes' :: [Text]
classes' = [ Text
c | Text
c <- [Text]
classes
                                         , Text
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ Text
"csl-no-emph"
                                                       , Text
"csl-no-strong"
                                                       , Text
"csl-no-smallcaps"
                                                       ]
                                         ]

    (Emph [Inline]
lst)       -> Html -> Html
H.em forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
    (Underline [Inline]
lst)  -> Html -> Html
H.u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
    (Strong [Inline]
lst)     -> Html -> Html
H.strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
    (Code attr :: Attr
attr@(Text
ids,[Text]
cs,[(Text, Text)]
kvs) Text
str)
                     -> case Either Text Html
hlCode of
                             Left Text
msg -> do
                               forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) forall a b. (a -> b) -> a -> b
$
                                 forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
                               forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ids,[Text]
cs',[(Text, Text)]
kvs) forall a b. (a -> b) -> a -> b
$
                                 forall a. a -> Maybe a -> a
fromMaybe Html -> Html
H.code Maybe (Html -> Html)
sampOrVar forall a b. (a -> b) -> a -> b
$
                                 Text -> Html
strToHtml Text
str
                             Right Html
h -> do
                               forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True }
                               forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ids,[],[(Text, Text)]
kvs) forall a b. (a -> b) -> a -> b
$
                                 forall a. a -> Maybe a -> a
fromMaybe forall a. a -> a
id Maybe (Html -> Html)
sampOrVar Html
h
                        where hlCode :: Either Text Html
hlCode = if forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
                                          then 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 forall a b. a -> Either a b
Left Text
""
                              (Maybe (Html -> Html)
sampOrVar,[Text]
cs')
                                | Text
"sample" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cs =
                                      (forall a. a -> Maybe a
Just Html -> Html
H.samp,Text
"sample" forall a. Eq a => a -> [a] -> [a]
`delete` [Text]
cs)
                                | Text
"variable" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cs =
                                      (forall a. a -> Maybe a
Just Html -> Html
H.var,Text
"variable" forall a. Eq a => a -> [a] -> [a]
`delete` [Text]
cs)
                                | Bool
otherwise = (forall a. Maybe a
Nothing,[Text]
cs)
    (Strikeout [Inline]
lst)  -> Html -> Html
H.del forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
    (SmallCaps [Inline]
lst)   -> (Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"smallcaps") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                           forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
    (Superscript [Inline]
lst) -> Html -> Html
H.sup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
    (Subscript [Inline]
lst)   -> Html -> Html
H.sub forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
    (Quoted QuoteType
quoteType [Inline]
lst) ->
                        let (Html
leftQuote, Html
rightQuote) = case QuoteType
quoteType of
                              QuoteType
SingleQuote -> (forall a. ToMarkup a => a -> Html
toHtml Char
'‘',
                                              forall a. ToMarkup a => a -> Html
toHtml Char
'’')
                              QuoteType
DoubleQuote -> (forall a. ToMarkup a => a -> Html
toHtml Char
'“',
                                              forall a. ToMarkup a => a -> Html
toHtml Char
'”')

                        in if WriterOptions -> Bool
writerHtmlQTags WriterOptions
opts
                               then do
                                 forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stQuotes :: Bool
stQuotes = Bool
True }
                                 let (Maybe Attr
maybeAttr, [Inline]
lst') = case [Inline]
lst of
                                      [Span attr :: Attr
attr@(Text
_, [Text]
_, [(Text, Text)]
kvs) [Inline]
cs]
                                        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
==Text
"cite") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Text)]
kvs
                                          -> (forall a. a -> Maybe a
Just Attr
attr, [Inline]
cs)
                                      [Inline]
cs -> (forall a. Maybe a
Nothing, [Inline]
cs)
                                 let addAttrsMb :: Maybe Attr -> Html -> StateT WriterState m Html
addAttrsMb = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts)
                                 forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                   Maybe Attr -> Html -> StateT WriterState m Html
addAttrsMb Maybe Attr
maybeAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
H.q
                               else (\Html
x -> Html
leftQuote forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
rightQuote)
                                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
lst
    (Math MathType
t Text
str) -> do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st {stMath :: Bool
stMath = Bool
True})
      let mathClass :: AttributeValue
mathClass = forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ (Text
"math " :: Text) forall a. Semigroup a => a -> a -> a
<>
                      if MathType
t forall a. Eq a => a -> a -> Bool
== MathType
InlineMath then Text
"inline" else Text
"display"
      case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
           WebTeX Text
url -> do
              let imtag :: Html
imtag = if Bool
html5 then Html
H5.img else Html
H.img
              let str' :: Text
str' = Text -> Text
T.strip Text
str
              let s :: Text
s = case MathType
t of
                           MathType
InlineMath  -> Text
"\\textstyle "
                           MathType
DisplayMath -> Text
"\\displaystyle "
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html
imtag forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.style AttributeValue
"vertical-align:middle"
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src (forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
url forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 Text -> Text
urlEncode forall a b. (a -> b) -> a -> b
$ Text
s forall a. Semigroup a => a -> a -> a
<> Text
str')
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.alt (forall a. ToValue a => a -> AttributeValue
toValue Text
str')
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title (forall a. ToValue a => a -> AttributeValue
toValue Text
str')
                             forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass
           HTMLMathMethod
GladTeX ->
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                Tag -> Html -> Html
customParent (Text -> Tag
textTag Text
"eq") forall h. Attributable h => h -> Attribute -> h
!
                  Tag -> AttributeValue -> Attribute
customAttribute Tag
"env"
                    (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ if MathType
t forall a. Eq a => a -> a -> Bool
== MathType
InlineMath
                                  then (Text
"math" :: Text)
                                  else Text
"displaymath") forall a b. (a -> b) -> a -> b
$ Text -> Html
strToHtml Text
str
           HTMLMathMethod
MathML -> do
              let conf :: ConfigPP
conf = (QName -> Bool) -> ConfigPP -> ConfigPP
useShortEmptyTags (forall a b. a -> b -> a
const Bool
False)
                           ConfigPP
defaultConfigPP
              Either Inline Element
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 Element
r  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Html
preEscapedString forall a b. (a -> b) -> a -> b
$
                        ConfigPP -> Element -> String
ppcElement ConfigPP
conf (Element -> Text -> Element
annotateMML Element
r Text
str)
                    Left Inline
il  -> (Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts Inline
il
           MathJax Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$
              case MathType
t of
                MathType
InlineMath  -> Text
"\\(" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\\)"
                MathType
DisplayMath -> Text
"\\[" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\\]"
           KaTeX Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$
              case MathType
t of
                MathType
InlineMath  -> Text
str
                MathType
DisplayMath -> Text
str
           HTMLMathMethod
PlainMath -> do
              Html
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
mathClass forall a b. (a -> b) -> a -> b
$ Html
x
    (RawInline Format
f Text
str) -> do
      Bool
ishtml <- forall (m :: * -> *).
PandocMonad m =>
Format -> StateT WriterState m Bool
isRawHtml Format
f
      if Bool
ishtml
         then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Html
preEscapedText Text
str
         else do
           let istex :: Bool
istex = Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex"
           let mm :: HTMLMathMethod
mm = WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts
           case Bool
istex of
             Bool
True
               | HTMLMathMethod -> Bool
allowsMathEnvironments HTMLMathMethod
mm Bool -> Bool -> Bool
&& Text -> Bool
isMathEnvironment Text
str
                 -> do
                    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st {stMath :: Bool
stMath = Bool
True})
                    forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts forall a b. (a -> b) -> a -> b
$ MathType -> Text -> Inline
Math MathType
DisplayMath Text
str
               | HTMLMathMethod -> Bool
allowsRef HTMLMathMethod
mm Bool -> Bool -> Bool
&& Text -> Bool
isRef Text
str
                 -> do
                    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st {stMath :: Bool
stMath = Bool
True})
                    forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts forall a b. (a -> b) -> a -> b
$ MathType -> Text -> Inline
Math MathType
InlineMath Text
str
             Bool
_ -> do forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
inline
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    (Link Attr
attr [Inline]
txt (Text
s,Text
_)) | Text
"mailto:" Text -> Text -> Bool
`T.isPrefixOf` Text
s -> do
                        Html
linkText <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts ([Inline] -> [Inline]
removeLinks [Inline]
txt)
                        forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> Text -> StateT WriterState m Html
obfuscateLink WriterOptions
opts Attr
attr Html
linkText Text
s
    (Link (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
txt (Text
s,Text
tit)) -> do
                        Html
linkText <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts ([Inline] -> [Inline]
removeLinks [Inline]
txt)
                        HTMLSlideVariant
slideVariant <- 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 (Char
'#',Text
xs) -> let prefix :: Text
prefix = if HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides
                                                             then Text
"/"
                                                             else WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts
                                             in  Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
xs
                                   Maybe (Char, Text)
_ -> Text
s
                        let link :: Html
link = Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. ToValue a => a -> AttributeValue
toValue Text
s') forall a b. (a -> b) -> a -> b
$ Html
linkText
                        Html
link' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
ident, [Text]
classes, [(Text, Text)]
kvs) Html
link
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
tit
                                    then Html
link'
                                    else Html
link' forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title (forall a. ToValue a => a -> AttributeValue
toValue Text
tit)
    (Image attr :: Attr
attr@(Text
_, [Text]
_, [(Text, Text)]
attrList) [Inline]
txt (Text
s, Text
tit)) -> do
                        let alternate :: Text
alternate = forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt
                        HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
                        let isReveal :: Bool
isReveal = HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides
                        [Attribute]
attrs <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
imgAttrsToHtml WriterOptions
opts Attr
attr
                        let attributes :: [Attribute]
attributes =
                              -- reveal.js uses data-src for lazy loading
                              (if Bool
isReveal
                                  then Tag -> AttributeValue -> Attribute
customAttribute Tag
"data-src" forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue Text
s
                                  else AttributeValue -> Attribute
A.src forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue Text
s) forall a. a -> [a] -> [a]
:
                              [AttributeValue -> Attribute
A.title forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue Text
tit | Bool -> Bool
not (Text -> Bool
T.null Text
tit)] 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 forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
toValue Text
alternate | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt) Bool -> Bool -> Bool
&&
                                  forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"alt" [(Text, Text)]
attrList)] )
                            mediaTag :: (Html -> a) -> Text -> (a, [Attribute])
mediaTag Html -> a
tg Text
fallbackTxt =
                              let linkTxt :: Text
linkTxt = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
                                            then Text
fallbackTxt
                                            else Text
alternate
                              in (Html -> a
tg forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. ToValue a => a -> AttributeValue
toValue Text
s) forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Text
linkTxt
                                 , [AttributeValue -> Attribute
A5.controls AttributeValue
""] )
                            s' :: Text
s' = forall a. a -> Maybe a -> a
fromMaybe Text
s forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
".gz" Text
s
                            normSrc :: String
normSrc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> String
T.unpack Text
s) URI -> String
uriPath (String -> Maybe URI
parseURIReference forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s')
                            (Html
tag, [Attribute]
specAttrs) = case String -> Maybe Text
mediaCategory String
normSrc of
                              Just Text
"image" -> (Html, [Attribute])
imageTag
                              Just Text
"video" -> forall {a}. (Html -> a) -> Text -> (a, [Attribute])
mediaTag Html -> Html
H5.video Text
"Video"
                              Just Text
"audio" -> forall {a}. (Html -> a) -> Text -> (a, [Attribute])
mediaTag Html -> Html
H5.audio Text
"Audio"
                              Just Text
_       -> (Html
H5.embed, [])
                              Maybe Text
_            -> (Html, [Attribute])
imageTag
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall h. Attributable h => h -> Attribute -> h
(!) Html
tag forall a b. (a -> b) -> a -> b
$ [Attribute]
attributes forall a. [a] -> [a] -> [a]
++ [Attribute]
specAttrs
                        -- note:  null title included, as in Markdown.pl
    (Note [Block]
contents) -> do
                        [Html]
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Html]
stNotes
                        Int
emittedNotes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stEmittedNotes
                        let number :: Int
number = Int
emittedNotes forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Html]
notes forall a. Num a => a -> a -> a
+ Int
1
                        let ref :: Text
ref = forall a. Show a => a -> Text
tshow Int
number
                        Html
htmlContents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> StateT WriterState m Html
blockListToNote WriterOptions
opts Text
ref [Block]
contents
                        Maybe EPUBVersion
epubVersion <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
                        -- push contents onto front of notes
                        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st {stNotes :: [Html]
stNotes = Html
htmlContentsforall a. a -> [a] -> [a]
:[Html]
notes}
                        HTMLSlideVariant
slideVariant <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
                        let revealSlash :: Text
revealSlash = String -> Text
T.pack [Char
'/' | HTMLSlideVariant
slideVariant forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
RevealJsSlides]
                        let link :: Html
link = Html -> Html
H.a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. ToValue a => a -> AttributeValue
toValue forall a b. (a -> b) -> a -> b
$ Text
"#" forall a. Semigroup a => a -> a -> a
<>
                                         Text
revealSlash forall a. Semigroup a => a -> a -> a
<>
                                         WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts forall a. Semigroup a => a -> a -> a
<> Text
"fn" forall a. Semigroup a => a -> a -> a
<> Text
ref)
                                       forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"footnote-ref"
                                       forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts (Text
"fnref" forall a. Semigroup a => a -> a -> a
<> Text
ref)
                                       forall a b. (a -> b) -> a -> b
$ (if forall a. Maybe a -> Bool
isJust Maybe EPUBVersion
epubVersion
                                             then forall a. a -> a
id
                                             else Html -> Html
H.sup)
                                       forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Text
ref
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe EPUBVersion
epubVersion of
                                      Just EPUBVersion
EPUB3 -> Html
link forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"epub:type" AttributeValue
"noteref"
                                      Maybe EPUBVersion
_ | Bool
html5  -> Html
link forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.role AttributeValue
"doc-noteref"
                                      Maybe EPUBVersion
_          -> Html
link
    (Cite [Citation]
cits [Inline]
il)-> do Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts
                                      (if Bool
html5
                                          then forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
addRoleToLink [Inline]
il
                                          else [Inline]
il)
                        let citationIds :: Text
citationIds = [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
citationId [Citation]
cits
                        let result :: Html
result = Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"citation" forall a b. (a -> b) -> a -> b
$ Html
contents
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
html5
                                    then Html
result forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"data-cites" (forall a. ToValue a => a -> AttributeValue
toValue Text
citationIds)
                                    else Html
result

addRoleToLink :: Inline -> Inline
addRoleToLink :: Inline -> Inline
addRoleToLink (Link (Text
id',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils (Text
src,Text
tit)) =
  Attr -> [Inline] -> (Text, Text) -> Inline
Link (Text
id',[Text]
classes,(Text
"role",Text
"doc-biblioref")forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs) [Inline]
ils (Text
src,Text
tit)
addRoleToLink Inline
x = Inline
x

blockListToNote :: PandocMonad m
                => WriterOptions -> Text -> [Block]
                -> StateT WriterState m Html
blockListToNote :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> StateT WriterState m Html
blockListToNote WriterOptions
opts Text
ref [Block]
blocks = do
  Maybe EPUBVersion
epubVersion <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  case Maybe EPUBVersion
epubVersion of
    Maybe EPUBVersion
Nothing -> do -- web page
      -- If last block is Para or Plain, include the backlink at the end of
      -- that block. Otherwise, insert a new Plain block with the backlink.
      let kvs :: [(Text, Text)]
kvs = [(Text
"role",Text
"doc-backlink") | Bool
html5]
      let backlink :: [Inline]
backlink = [Attr -> [Inline] -> (Text, Text) -> Inline
Link (Text
"",[Text
"footnote-back"],[(Text, Text)]
kvs)
                        [Text -> Inline
Str Text
"↩"] (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
"fnref" forall a. Semigroup a => a -> a -> a
<> Text
ref,Text
"")]
      let blocks' :: [Block]
blocks'  = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks
                        then []
                        else let lastBlock :: Block
lastBlock   = forall a. [a] -> a
last [Block]
blocks
                                 otherBlocks :: [Block]
otherBlocks = forall a. [a] -> [a]
init [Block]
blocks
                             in  case Block
lastBlock of
                                      Para [Image (Text
_,[Text]
cls,[(Text, Text)]
_) [Inline]
_ (Text
_,Text
tit)]
                                          | Text
"fig:" Text -> Text -> Bool
`T.isPrefixOf` Text
tit
                                            Bool -> Bool -> Bool
|| Text
"r-stretch" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls
                                                -> [Block]
otherBlocks forall a. [a] -> [a] -> [a]
++ [Block
lastBlock,
                                                      [Inline] -> Block
Plain [Inline]
backlink]
                                      Para [Inline]
lst  -> [Block]
otherBlocks forall a. [a] -> [a] -> [a]
++
                                                     [[Inline] -> Block
Para ([Inline]
lst forall a. [a] -> [a] -> [a]
++ [Inline]
backlink)]
                                      Plain [Inline]
lst -> [Block]
otherBlocks forall a. [a] -> [a] -> [a]
++
                                                     [[Inline] -> Block
Plain ([Inline]
lst forall a. [a] -> [a] -> [a]
++ [Inline]
backlink)]
                                      Block
_         -> [Block]
otherBlocks forall a. [a] -> [a] -> [a]
++ [Block
lastBlock,
                                                     [Inline] -> Block
Plain [Inline]
backlink]
      Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks'
      let noteItem :: Html
noteItem = Html -> Html
H.li forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts (Text
"fn" forall a. Semigroup a => a -> a -> a
<> Text
ref) forall a b. (a -> b) -> a -> b
$ Html
contents
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html
noteItem forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
    Just EPUBVersion
epubv -> do
      let kvs :: [(Text, Text)]
kvs = [(Text
"role",Text
"doc-backlink") | Bool
html5]
      let backlink :: Inline
backlink = Attr -> [Inline] -> (Text, Text) -> Inline
Link (Text
"",[Text
"footnote-back"],[(Text, Text)]
kvs)
                        [Text -> Inline
Str Text
ref] (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
"fnref" forall a. Semigroup a => a -> a -> a
<> Text
ref,Text
"")
      let blocks' :: [Block]
blocks' =
           case [Block]
blocks of
             (Para [Inline]
ils : [Block]
rest) ->
                [Inline] -> Block
Para (Inline
backlink forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"." forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
ils) forall a. a -> [a] -> [a]
: [Block]
rest
             (Plain [Inline]
ils : [Block]
rest) ->
                [Inline] -> Block
Plain (Inline
backlink forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"." forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
ils) forall a. a -> [a] -> [a]
: [Block]
rest
             [Block]
_ -> [Inline] -> Block
Para [Inline
backlink , Text -> Inline
Str Text
"."] forall a. a -> [a] -> [a]
: [Block]
blocks
      Html
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks'
      let noteItem :: Html
noteItem = (if EPUBVersion
epubv forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3
                         then Html -> Html
H5.aside forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"epub:type" AttributeValue
"footnote"
                         else Html -> Html
H.div) forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts (Text
"fn" forall a. Semigroup a => a -> a -> a
<> Text
ref)
                      forall a b. (a -> b) -> a -> b
$ Html
nl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html
noteItem forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl

inDiv :: PandocMonad m=> Text -> Html -> StateT WriterState m Html
inDiv :: forall (m :: * -> *).
PandocMonad m =>
Text -> Html -> StateT WriterState m Html
inDiv Text
cls Html
x = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    (if Bool
html5 then Html -> Html
H5.div else Html -> Html
H.div)
                Html
x forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ (forall a. ToValue a => a -> AttributeValue
toValue Text
cls)

isRef :: Text -> Bool
isRef :: Text -> Bool
isRef Text
t = Text
"\\ref{" Text -> Text -> Bool
`T.isPrefixOf` Text
t Bool -> Bool -> Bool
|| Text
"\\eqref{" Text -> Text -> Bool
`T.isPrefixOf` Text
t

isMathEnvironment :: Text -> Bool
isMathEnvironment :: Text -> Bool
isMathEnvironment Text
s = Text
"\\begin{" Text -> Text -> Bool
`T.isPrefixOf` Text
s Bool -> Bool -> Bool
&&
                         Text
envName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
mathmlenvs
  where envName :: Text
envName = (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'}') (Int -> Text -> Text
T.drop Int
7 Text
s)
        mathmlenvs :: [Text]
mathmlenvs = [ Text
"align"
                     , Text
"align*"
                     , Text
"alignat"
                     , Text
"alignat*"
                     , Text
"aligned"
                     , Text
"alignedat"
                     , Text
"array"
                     , Text
"Bmatrix"
                     , Text
"bmatrix"
                     , Text
"cases"
                     , Text
"CD"
                     , Text
"eqnarray"
                     , Text
"eqnarray*"
                     , Text
"equation"
                     , Text
"equation*"
                     , Text
"gather"
                     , Text
"gather*"
                     , Text
"gathered"
                     , Text
"matrix"
                     , Text
"multline"
                     , Text
"multline*"
                     , Text
"pmatrix"
                     , Text
"prooftree" -- bussproofs
                     , Text
"smallmatrix"
                     , Text
"split"
                     , Text
"subarray"
                     , Text
"Vmatrix"
                     , Text
"vmatrix" ]

allowsMathEnvironments :: HTMLMathMethod -> Bool
allowsMathEnvironments :: HTMLMathMethod -> Bool
allowsMathEnvironments (MathJax Text
_) = Bool
True
allowsMathEnvironments (KaTeX Text
_)   = Bool
True
allowsMathEnvironments HTMLMathMethod
MathML      = Bool
True
allowsMathEnvironments (WebTeX Text
_)  = Bool
True
allowsMathEnvironments HTMLMathMethod
_           = Bool
False

allowsRef :: HTMLMathMethod -> Bool
allowsRef :: HTMLMathMethod -> Bool
allowsRef (MathJax Text
_) = Bool
True
allowsRef HTMLMathMethod
_           = Bool
False

-- | List of intrinsic event attributes allowed on all elements in HTML4.
intrinsicEventsHTML4 :: [Text]
intrinsicEventsHTML4 :: [Text]
intrinsicEventsHTML4 =
  [ Text
"onclick", Text
"ondblclick", Text
"onmousedown", Text
"onmouseup", Text
"onmouseover"
  , Text
"onmouseout", Text
"onmouseout", Text
"onkeypress", Text
"onkeydown", Text
"onkeyup"]

isRawHtml :: PandocMonad m => Format -> StateT WriterState m Bool
isRawHtml :: forall (m :: * -> *).
PandocMonad m =>
Format -> StateT WriterState m Bool
isRawHtml Format
f = do
  Bool
html5 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" Bool -> Bool -> Bool
||
           ((Bool
html5 Bool -> Bool -> Bool
&& Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html5") Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html4")

-- We need to remove links from link text, because an <a> element is
-- not allowed inside another <a> element.
removeLinks :: [Inline] -> [Inline]
removeLinks :: [Inline] -> [Inline]
removeLinks = forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
go
 where
  go :: Inline -> Inline
go (Link Attr
attr [Inline]
ils (Text, Text)
_) = Attr -> [Inline] -> Inline
Span Attr
attr [Inline]
ils
  go Inline
x = Inline
x