{-# 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-2024 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, isSpace, isAscii)
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, escapeURIString)
import Text.Pandoc.URI (urlEncode)
import Numeric (showHex)
import Text.DocLayout (render, literal, Doc)
import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent)
import Text.DocTemplates (FromContext (lookupContext), Context (..))
import qualified Text.DocTemplates.Internal as DT
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.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 -> Int
stEmittedNoteBlocks :: Int  -- ^ How many @\<div class=footnote>@ blocks we've already pushed out
    , 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,
                                  stEmittedNoteBlocks :: Int
stEmittedNoteBlocks = 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 = Maybe EPUBVersion
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 = Maybe Int
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 = (Html -> Text -> Html) -> Html -> [Text] -> Html
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Html -> Text -> Html
go Html
forall a. Monoid a => a
mempty ([Text] -> Html) -> [Text] -> Html
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 = Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
t
  where
    samegroup :: Char -> Char -> Bool
samegroup Char
c Char
d = Char
d Char -> Char -> Bool
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 Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
preEscapedString String
"\'"
    go Html
h Text
"\"" = Html
h Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
preEscapedString String
"\""
    go Html
h Text
txt | Text -> Int
T.length Text
txt Int -> Int -> Bool
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 Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
preEscapedString (Text -> String
T.unpack Text
txt String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\xFE0E")
    go Html
h Text
txt = Html
h Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Text -> Html
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 = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
                      WriterState
defaultWriterState{ stHtml5 = 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 = WriterState -> WriterOptions -> Pandoc -> m Html
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' WriterState
defaultWriterState{ stHtml5 = 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 = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
                         WriterState
defaultWriterState{ stHtml5 = False } WriterOptions
opts (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
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 = WriterState -> WriterOptions -> Pandoc -> m Html
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' WriterState
defaultWriterState{ stHtml5 = False } WriterOptions
opts (Pandoc -> m Html) -> (Pandoc -> Pandoc) -> Pandoc -> m Html
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 = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
                      WriterState
defaultWriterState{ stHtml5 = version == EPUB3,
                                          stEPUBVersion = Just version }
                      WriterOptions
o{ writerWrapText = 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 = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
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 = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
S5Slides WriterOptions
opts (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
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 = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
SlidySlides WriterOptions
opts (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
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 = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' HTMLSlideVariant
SlideousSlides WriterOptions
opts (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
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 = HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
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 = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
    WriterState
defaultWriterState{ stSlideVariant = variant
                      , stHtml5 = case 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' = LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Html -> LazyText) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> LazyText
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
  (body, context) <- StateT WriterState m (Html, Context Text)
-> WriterState -> m (Html, Context Text)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
pandocToHtml WriterOptions
opts Pandoc
d) WriterState
st
  let colwidth = case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
                    WrapOption
WrapAuto -> Int -> Maybe Int
forall a. a -> Maybe a
Just (WriterOptions -> Int
writerColumns WriterOptions
opts)
                    WrapOption
_ -> Maybe Int
forall a. Maybe a
Nothing
  (if writerPreferAscii opts
      then toEntities
      else id) <$>
    case writerTemplate opts of
       Maybe (Template Text)
Nothing -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
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 -> Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
cols) (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Html -> Doc Text
layoutMarkup Html
body
       Just Template Text
tpl -> do
         -- warn if empty lang
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"lang" Context Text
context :: Maybe Text) Bool -> Bool -> Bool
&&
               Text -> Template Text -> Bool
forall a. Text -> Template a -> Bool
hasVariable Text
"lang" Template Text
tpl) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
           LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report LogMessage
NoLangSpecified
         (context' :: Context Text) <-
            -- check for empty pagetitle
            case Text -> Context Text -> Maybe Text
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) -> Context Text -> m (Context Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Context Text
context
                 Maybe Text
_ | Text -> Template Text -> Bool
forall a. Text -> Template a -> Bool
hasVariable Text
"pagetitle" Template Text
tpl -> do
                       let fallback :: Text
fallback = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                             case Text -> Context Text -> Maybe [Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"sourcefile"
                                       (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
                               Maybe [Text]
Nothing    -> String
"Untitled"
                               Just []    -> String
"Untitled"
                               Just (Text
x:[Text]
_) -> String -> String
takeBaseName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x
                       LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
NoTitleElement Text
fallback
                       Context Text -> m (Context Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context Text -> m (Context Text))
-> Context Text -> m (Context Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"pagetitle" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
fallback) Context Text
context
                   | Bool
otherwise -> Context Text -> m (Context Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Context Text
context
         return $ render colwidth $ renderTemplate tpl
             (defField "body" (layoutMarkup body) 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 (Text -> Html) -> m Text -> m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' WriterState
st WriterOptions
opts Pandoc
d
       Maybe (Template Text)
Nothing
         | WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
           -> Text -> Html
preEscapedText (Text -> Html) -> m Text -> m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' WriterState
st WriterOptions
opts Pandoc
d
         | Bool
otherwise -> do
            (body, _) <- StateT WriterState m (Html, Context Text)
-> WriterState -> m (Html, Context Text)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Pandoc -> StateT WriterState m (Html, Context Text)
pandocToHtml WriterOptions
opts Pandoc
d) WriterState
st
            return 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
  m () -> StateT WriterState m ()
forall (m :: * -> *) a. Monad m => m a -> StateT WriterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT WriterState m ())
-> m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Meta -> m ()
forall (m :: * -> *). PandocMonad m => Meta -> m ()
setupTranslations Meta
meta
  let slideLevel :: Int
slideLevel = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Block] -> Int
getSlideLevel [Block]
blocks) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Maybe Int
writerSlideLevel WriterOptions
opts
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stSlideLevel = slideLevel }
  metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
              ((Html -> Doc Text)
-> StateT WriterState m Html -> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Doc Text
layoutMarkup (StateT WriterState m Html -> StateT WriterState m (Doc Text))
-> ([Block] -> StateT WriterState m Html)
-> [Block]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts)
              ((Html -> Doc Text)
-> StateT WriterState m Html -> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Doc Text
layoutMarkup (StateT WriterState m Html -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m Html)
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts)
              Meta
meta
  let stringifyHTML = Text -> Text
escapeStringForXML (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify
  let authsMeta = ([Inline] -> Doc Text) -> [[Inline]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> ([Inline] -> Text) -> [Inline] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
stringifyHTML) ([[Inline]] -> [Doc Text]) -> [[Inline]] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  let dateMeta  = [Inline] -> Text
stringifyHTML ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docDate Meta
meta
  let descriptionMeta = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                          Text -> Meta -> Text
lookupMetaString Text
"description" Meta
meta
  slideVariant <- gets stSlideVariant
  abstractTitle <- translateTerm Abstract
  let sects = [Int] -> Bool -> Maybe Int -> [Block] -> [Block]
makeSectionsWithOffsets
                (WriterOptions -> [Int]
writerNumberOffset WriterOptions
opts) (WriterOptions -> Bool
writerNumberSections WriterOptions
opts) Maybe Int
forall a. Maybe a
Nothing ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$
              if HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
== HTMLSlideVariant
NoSlides
                 then [Block]
blocks
                 else Int -> [Block] -> [Block]
prepSlides Int
slideLevel [Block]
blocks
  toc <- if writerTableOfContents opts && slideVariant /= S5Slides
            then fmap layoutMarkup <$> tableOfContents opts sects
            else return Nothing
  blocks' <- blockListToHtml opts sects
  notes <- do
    -- make the st private just to be safe, since we modify it right afterwards
    st <- get
    if null (stNotes st)
      then return mempty
      else do
        notes <- footnoteSection opts EndOfDocument (stEmittedNotes st + 1) (reverse (stNotes st))
        modify (\WriterState
st' -> WriterState
st'{ stNotes = mempty, stEmittedNotes = stEmittedNotes st' + length (stNotes st') })
        return notes
  st <- get
  let html5 = WriterState -> Bool
stHtml5 WriterState
st
  let thebody = Html
blocks' Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
notes
  let math = Html -> Doc Text
layoutMarkup (Html -> Doc Text) -> Html -> Doc Text
forall a b. (a -> b) -> a -> b
$ case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
        MathJax Text
url
          | HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
RevealJsSlides ->
          -- mathjax is handled via a special plugin in revealjs
            Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
toURI Bool
html5 Text
url)
                    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript"
                    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ case HTMLSlideVariant
slideVariant of
                            HTMLSlideVariant
SlideousSlides ->
                              String -> Html
preEscapedString
                              String
"MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);"
                            HTMLSlideVariant
_ -> Html
forall a. Monoid a => a
mempty
        KaTeX Text
url -> do
          Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
!
            AttributeValue -> Attribute
A.defer AttributeValue
forall a. Monoid a => a
mempty (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
!
            AttributeValue -> Attribute
A.src (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
toURI Bool
html5 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"katex.min.js") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
forall a. Monoid a => a
mempty
          Html
nl
          let katexFlushLeft :: Text
katexFlushLeft =
                case Text -> Context Text -> Maybe [Doc Text]
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" Doc Text -> [Doc Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
              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: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
katexFlushLeft
            , Text
"   });"
            , Text
"}}});"
            ]
          Html
nl
          Html
H.link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
!
            AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
toURI Bool
html5 Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"katex.min.css")

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

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

unordList :: PandocMonad m
          => WriterOptions -> [Html] -> StateT WriterState m Html
unordList :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Html] -> StateT WriterState m Html
unordList WriterOptions
opts = (Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.ul WriterOptions
opts ([Html] -> StateT WriterState m Html)
-> ([Html] -> [Html]) -> [Html] -> StateT WriterState m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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 = (Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.ol WriterOptions
opts ([Html] -> StateT WriterState m Html)
-> ([Html] -> [Html]) -> [Html] -> StateT WriterState m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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 = (Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
(Html -> Html)
-> WriterOptions -> [Html] -> StateT WriterState m Html
toList Html -> Html
H.dl WriterOptions
opts ([Html]
items [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html
nl])

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 =
  case [Block] -> Maybe (Bool, [Block])
forall (m :: * -> *). MonadPlus m => [Block] -> m (Bool, [Block])
toTaskListItem [Block]
bls of
    Just (Bool
checked, (Para [Inline]
is:[Block]
bs)) -> Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall {m :: * -> *} {a}.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
checked Html -> Html
H.p [Inline]
is [Block]
bs
    Just (Bool
checked, (Plain [Inline]
is:[Block]
bs)) -> Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall {m :: * -> *} {a}.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
checked Html -> Html
forall a. a -> a
id [Inline]
is [Block]
bs
    Maybe (Bool, [Block])
_ -> WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
bls
  where
    taskListItem :: Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
checked Html -> MarkupM a
constr [Inline]
is [Block]
bs = do
      let checkbox :: Html
checkbox  = if Bool
checked
                      then Html
checkbox' Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.checked AttributeValue
""
                      else Html
checkbox'
          checkbox' :: Html
checkbox' = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"checkbox"
      isContents <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
is
      bsContents <- blockListToHtml opts bs
      return $ constr (H.label (checkbox >> isContents)) >>
               (if null bs then mempty else nl) >>
               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
_ [] = Maybe Html -> StateT WriterState m (Maybe Html)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Html
forall a. Maybe a
Nothing
tableOfContents WriterOptions
opts [Block]
sects = do
  -- in reveal.js, we need #/apples, not #apples:
  slideVariant <- (WriterState -> HTMLSlideVariant)
-> StateT WriterState m HTMLSlideVariant
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> HTMLSlideVariant
stSlideVariant
  let opts' = case HTMLSlideVariant
slideVariant of
                HTMLSlideVariant
RevealJsSlides ->
                  WriterOptions
opts{ writerIdentifierPrefix =
                          "/" <> writerIdentifierPrefix opts }
                HTMLSlideVariant
_ -> WriterOptions
opts
  case toTableOfContents opts sects of
    bl :: Block
bl@(BulletList ([Block]
_:[[Block]]
_)) -> Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html)
-> StateT WriterState m Html -> StateT WriterState m (Maybe Html)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts' Block
bl
    Block
_                     -> Maybe Html -> StateT WriterState m (Maybe Html)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Html
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
  html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  slideVariant <- gets stSlideVariant
  let hrtag = if ReferenceLocation
refLocation ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
/= ReferenceLocation
EndOfBlock
                 then (if Bool
html5 then Html
H5.hr else Html
H.hr) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
nl
                 else Html
forall a. Monoid a => a
mempty
  idName <- do
    blockCount <- gets stEmittedNoteBlocks
    modify $ \WriterState
st -> WriterState
st{ stEmittedNoteBlocks = blockCount + 1 }
    return $
      -- Keep the first note section's id undecorated to maintain a target for
      -- old links which don't expect numbered sections, or for when the notes
      -- are rendered all together at the end of the document.
      if blockCount <= 0
        then "footnotes"
        else "footnotes-" <> show (blockCount + 1)
  let 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
"footnotes " AttributeValue -> AttributeValue -> AttributeValue
forall a. Semigroup a => a -> a -> a
<> AttributeValue
additionalClassName
  epubVersion <- gets stEPUBVersion
  let container Html
x
        | Bool
html5
        , Maybe EPUBVersion
epubVersion Maybe EPUBVersion -> Maybe EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion -> Maybe EPUBVersion
forall a. a -> Maybe a
Just EPUBVersion
EPUB3
                = Html -> Html
H5.section (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (String -> AttributeValue
forall a. IsString a => String -> a
fromString String
idName)
                             (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
className
                             (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"epub:type" AttributeValue
"footnotes" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
        | Bool
html5
        , ReferenceLocation
refLocation ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfDocument
        -- Note: we need a section for a new slide in slide formats.
                = Html -> Html
H5.section (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.id (String -> AttributeValue
forall a. IsString a => String -> a
fromString String
idName)
                             (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.class_ AttributeValue
className
                             (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.role AttributeValue
"doc-endnotes"
                             (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
        | Bool
html5 = Html -> Html
H5.aside   (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts (String -> Text
forall a. IsString a => String -> a
fromString String
idName)
                             (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.class_ AttributeValue
className
                             (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A5.role AttributeValue
"doc-footnote"
                             (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
        | HTMLSlideVariant
slideVariant HTMLSlideVariant -> HTMLSlideVariant -> Bool
forall a. Eq a => a -> a -> Bool
/= HTMLSlideVariant
NoSlides = Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"footnotes slide" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
        | Bool
otherwise = Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
className (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
x
  return $
    if null notes
       then mempty
       else do
         nl
         container $ do
           nl
           hrtag
           -- Keep the previous output exactly the same if we don't
           -- have multiple notes sections
           case epubVersion of
             Just EPUBVersion
_ -> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
notes
             Maybe EPUBVersion
Nothing | Int
startCounter Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
               (Html -> Html
H.ol (Html
nl Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
notes)) Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
             Maybe EPUBVersion
Nothing -> (Html -> Html
H.ol (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.start (String -> AttributeValue
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
startCounter)) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                         Html
nl Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
notes) Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
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 (Char -> Char -> Bool
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"mailto" -> do
         let (Text
name', Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'@') Text
addr
         let domain :: Text
domain = Int -> Text -> Text
T.drop Int
1 Text
rest
         (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name', Text
domain)
       (Text, Text)
_ -> String -> Maybe (Text, Text)
forall a. String -> Maybe a
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 ObfuscationMethod -> ObfuscationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ObfuscationMethod
NoObfuscation = do
  html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  addAttrs opts attr $ H.a ! A.href (toValue $ toURI html5 s) $ txt
obfuscateLink WriterOptions
opts Attr
attr (LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Html -> LazyText) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> LazyText
renderHtml -> Text
txt) Text
s = do
  html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  let meth = WriterOptions -> ObfuscationMethod
writerEmailObfuscation WriterOptions
opts
  let s' = Text -> Text
T.toLower (Int -> Text -> Text
T.take Int
7 Text
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
7 Text
s
  case parseMailto s' of
        (Just (Text
name', Text
domain)) ->
          let domain' :: Text
domain'  = HasCallStack => Text -> Text -> Text -> Text
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Text -> Text
T.drop Int
7 Text
s' -- autolink
                    then (Text
"e", Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
domain')
                    else (Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'",
                          Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
domain' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
              (Text
_, [Text]
classNames, [(Text, Text)]
_) = Attr
attr
              classNamesStr :: Text
classNamesStr = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
" "Text -> Text -> 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
                     Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
                     Text -> Html
preEscapedText (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"<a href=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
s'
                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" class=\"email\">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
obfuscateString Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</a>"
                ObfuscationMethod
JavascriptObfuscation ->
                     Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$
                     (Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                     Text -> Html
preEscapedText (Text
"\n<!--\nh='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                     Text -> Text
obfuscateString Text
domain Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"';a='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
at' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"';n='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                     Text -> Text
obfuscateString Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"';e=n+a+h;\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                     Text
"document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\" clas'+'s=\"em' + 'ail" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                     Text
classNamesStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\">'+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                     Text
linkText  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+'<\\/'+'a'+'>');\n// -->\n")) Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     Html -> Html
H.noscript (Text -> Html
preEscapedText (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Text
obfuscateString Text
altText)
                ObfuscationMethod
_ -> PandocError -> StateT WriterState m Html
forall a. PandocError -> StateT WriterState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT WriterState m Html)
-> PandocError -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ Text
"Unknown obfuscation method: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObfuscationMethod -> Text
forall a. Show a => a -> Text
tshow ObfuscationMethod
meth
        Maybe (Text, Text)
_ -> WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
toURI Bool
html5 Text
s)
                                      (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
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 Int -> Bool
forall a. Integral a => a -> Bool
even Int
num then Int -> String
forall a. Show a => a -> String
show Int
num else String
"x" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Integral a => a -> String -> String
showHex Int
num String
""
  in  Text
"&#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
numstr Text -> Text -> Text
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 (Text -> Text) -> (Text -> Text) -> Text -> Text
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 = (LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Html -> LazyText) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> LazyText
renderHtml (Html -> Text) -> PandocPure Html -> PandocPure Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT WriterState PandocPure Html
-> WriterState -> PandocPure Html
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
               (WriterOptions -> Attr -> Html -> StateT WriterState PandocPure Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr (Tag -> Bool -> Html
customLeaf (Text -> Tag
textTag Text
tagname) Bool
selfClosing))
               WriterState
defaultWriterState{ stHtml5 = html5 })
  in  case PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure PandocPure Text
mktag of
           Left PandocError
_  -> Text
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 = (Html -> Attribute -> Html) -> Html -> [Attribute] -> Html
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
(!) Html
h ([Attribute] -> Html)
-> StateT WriterState m [Attribute] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Attr -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts Attr
attr

toAttrs :: PandocMonad m
        => [(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs :: forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs [(Text, Text)]
kvs = do
  html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  mbEpubVersion <- gets stEPUBVersion
  reverse . snd <$> foldM (go html5 mbEpubVersion) (Set.empty, []) 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 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
keys
       then do
         LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
DuplicateAttribute Text
k Text
v
         (Set Text, [Attribute]) -> m (Set Text, [Attribute])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Text
keys, [Attribute]
attrs)
       else (Set Text, [Attribute]) -> m (Set Text, [Attribute])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
k Set Text
keys, Bool
-> Maybe EPUBVersion -> Text -> Text -> [Attribute] -> [Attribute]
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 = [Attribute] -> [Attribute]
forall a. a -> a
id  -- see #7546
    | Bool
html5
      = if (Text
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (Set Text
html5Attributes Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> Set Text
rdfaAttributes)
            Bool -> Bool -> Bool
&& Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"label") -- #10048
             Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
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) (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
y) Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
:)
           else (Tag -> AttributeValue -> Attribute
customAttribute (Text -> Tag
textTag (Text
"data-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)) (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
y) Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
:)
    | Maybe EPUBVersion
mbEpubVersion Maybe EPUBVersion -> Maybe EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion -> Maybe EPUBVersion
forall a. a -> Maybe a
Just EPUBVersion
EPUB2
    , Bool -> Bool
not (Text
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (Set Text
html4Attributes Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> Set Text
rdfaAttributes) Bool -> Bool -> Bool
||
      Text
"xml:" Text -> Text -> Bool
`T.isPrefixOf` Text
x)
      = [Attribute] -> [Attribute]
forall a. a -> a
id
    | Bool
otherwise
      = (Tag -> AttributeValue -> Attribute
customAttribute (Text -> Tag
textTag Text
x) (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
y) Attribute -> [Attribute] -> [Attribute]
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
  attrs <- [(Text, Text)] -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs [(Text, Text)]
keyvals
  let classes'' = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
classes'
  return $
    [prefixedId opts id' | not (T.null id')] ++
    [A.class_ (toValue $ T.unwords classes'') | not (null classes'')] ++ 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
  WriterOptions -> Attr -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts (Text
ident,[Text]
cls, [(Text, Text)] -> [(Text, Text)]
consolidateStyles ([(Text, Text)]
kvs' [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
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' = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text, Text) -> Bool
forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
isNotDim [(Text, Text)]
kvs
    isNotDim :: (a, b) -> Bool
isNotDim (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 ((Text, Text) -> Bool)
-> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Text, Text) -> Bool
forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
isStyle [(Text, Text)]
xs of
           ([], [(Text, Text)]
_)    -> [(Text, Text)]
xs
           ([(Text, Text)]
ss, [(Text, Text)]
rest) -> (Text
"style", Text -> [Text] -> Text
T.intercalate Text
";" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd [(Text, Text)]
ss) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
    isStyle :: (a, b) -> Bool
isStyle (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 [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
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)) -> [(Direction -> Text
forall a. Show a => a -> Text
tshow Direction
dir, Integer -> Text
forall a. Show a => a -> Text
tshow Integer
a)]
               (Just Dimension
x)         -> [(Text
"style", Direction -> Text
forall a. Show a => a -> Text
tshow Direction
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
x)]
               Maybe Dimension
Nothing          -> []

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

  figAttrs <- attrsToHtml opts attrs
  contents <- blockListToHtml opts body
  captCont <- blockListToHtml opts captBody
  let figCaption = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
                    if Bool
html5
                    then let fcattr :: Attribute
fcattr = if [Block] -> [Block] -> Bool
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 Attribute
forall a. Monoid a => a
mempty
                         in [ Html -> Html
H5.figcaption (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Attribute
fcattr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
captCont ]
                    else [ (Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"figcaption") Html
captCont ]
  let innards = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
                if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
captBody
                   then [Html
nl, Html
contents, Html
nl]
                   else case WriterOptions -> CaptionPosition
writerFigureCaptionPosition WriterOptions
opts of
                         CaptionPosition
CaptionAbove -> [Html
nl, Html
figCaption, Html
nl, Html
contents, Html
nl]
                         CaptionPosition
CaptionBelow -> [Html
nl, Html
contents, Html
nl, Html
figCaption, Html
nl]
  return $
    if html5
    then foldl (!) H5.figure figAttrs innards
    else foldl (!) H.div (A.class_ "float" : figAttrs) innards
 where
  captionIsAlt :: a -> [Block] -> Bool
captionIsAlt a
capt [Plain [Image (Text
_, [Text]
_, [(Text, Text)]
kv) [Inline]
desc (Text, Text)
_]] =
    let alt :: Text
alt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
desc) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"alt" [(Text, Text)]
kv
    in a -> Text
forall a. Walkable Inline a => a -> Text
stringify a
capt Text -> Text -> Bool
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" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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
  Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
increaseLevel (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$
    (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stBlockLevel = stBlockLevel st + 1 })
  doc <- WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtmlInner WriterOptions
opts Block
block
  st <- get
  let emitNotes =
        WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfBlock Bool -> Bool -> Bool
&& WriterState -> Int
stBlockLevel WriterState
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  res <- if emitNotes
    then do
      notes <- if null (stNotes st)
        then return mempty
        else footnoteSection opts (writerReferenceLocation opts)
                             (stEmittedNotes st + 1) (reverse (stNotes st))
      modify (\WriterState
st' -> WriterState
st'{ stNotes = mempty, stEmittedNotes = stEmittedNotes st' + length (stNotes st') })
      return (doc <> notes)
    else return doc
  when increaseLevel $
    modify (\WriterState
st' -> WriterState
st'{ stBlockLevel = stBlockLevel st' - 1 })
  return 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
  captionDoc <- case Caption
caption of
    Caption Maybe [Inline]
_ [] -> Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
    Caption Maybe [Inline]
_ [Block]
longCapt -> do
      cs <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
longCapt
      return $ do
        H.caption cs
        nl
  coltags <- colSpecListToHtml colspecs
  head' <- tableHeadToHtml opts thead
  bodies <- intersperse (nl) <$> mapM (tableBodyToHtml opts) tbodies
  foot' <- tableFootToHtml opts tfoot
  let (ident,classes,kvs) = 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 = \case
        ColWidth Double
d -> Double
d
        ColWidth
ColWidthDefault -> Double
0
  let totalWidth = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double)
-> ([ColSpec] -> [Double]) -> [ColSpec] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColSpec -> Double) -> [ColSpec] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ColWidth -> Double
colWidth (ColWidth -> Double) -> (ColSpec -> ColWidth) -> ColSpec -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColSpec -> ColWidth
forall a b. (a, b) -> b
snd) ([ColSpec] -> Double) -> [ColSpec] -> Double
forall a b. (a -> b) -> a -> b
$ [ColSpec]
colspecs
  let attr' = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [(Text, Text)]
kvs of
                Maybe Text
Nothing | Double
totalWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
&& Double
totalWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
                  -> (Text
ident,[Text]
classes, (Text
"style",Text
"width:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                         String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
totalWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) :: Int))
                         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%;")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs)
                Maybe Text
_ -> Attr
attr
  addAttrs opts attr' $ H.table $ do
    nl
    captionDoc
    coltags
    head'
    mconcat bodies
    foot'
    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) =
  WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr (Html -> StateT WriterState m Html)
-> (Html -> Html) -> Html -> StateT WriterState m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
H.tbody (Html -> StateT WriterState m Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    intermediateHead <-
      if [HeaderRow] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
inthead
      then Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
      else WriterOptions
-> TablePart -> [HeaderRow] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> TablePart -> [HeaderRow] -> StateT WriterState m Html
headerRowsToHtml WriterOptions
opts TablePart
Thead [HeaderRow]
inthead
    bodyRows <- bodyRowsToHtml opts rows
    return $ intermediateHead <> 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) =
  WriterOptions
-> TablePart -> Attr -> [HeaderRow] -> StateT WriterState m Html
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) =
  WriterOptions
-> TablePart -> Attr -> [HeaderRow] -> StateT WriterState m Html
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 [HeaderRow] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
rows Bool -> Bool -> Bool
|| (HeaderRow -> Bool) -> [HeaderRow] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all HeaderRow -> Bool
isEmptyRow [HeaderRow]
rows
  then Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Html
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
    contents <- WriterOptions
-> TablePart -> [HeaderRow] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> TablePart -> [HeaderRow] -> StateT WriterState m Html
headerRowsToHtml WriterOptions
opts TablePart
tblpart [HeaderRow]
rows
    tablePartElement <- addAttrs opts attr $ tag' contents
    return $ do
      tablePartElement
      nl
  where
    isEmptyRow :: HeaderRow -> Bool
isEmptyRow (Ann.HeaderRow Attr
_attr RowNumber
_rownum [Cell]
cells) = (Cell -> Bool) -> [Cell] -> Bool
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 Cell -> Cell -> Bool
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
(TablePart -> TablePart -> Bool)
-> (TablePart -> TablePart -> Bool) -> Eq TablePart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TablePart -> TablePart -> Bool
== :: TablePart -> TablePart -> Bool
$c/= :: TablePart -> TablePart -> Bool
/= :: 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 =
  WriterOptions -> [TableRow] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [TableRow] -> StateT WriterState m Html
rowListToHtml WriterOptions
opts ([TableRow] -> StateT WriterState m Html)
-> ([HeaderRow] -> [TableRow])
-> [HeaderRow]
-> StateT WriterState m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderRow -> TableRow) -> [HeaderRow] -> [TableRow]
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 =
  WriterOptions -> [TableRow] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [TableRow] -> StateT WriterState m Html
rowListToHtml WriterOptions
opts ([TableRow] -> StateT WriterState m Html)
-> ([BodyRow] -> [TableRow])
-> [BodyRow]
-> StateT WriterState m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RowNumber -> BodyRow -> TableRow)
-> [RowNumber] -> [BodyRow] -> [TableRow]
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 Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html]
x) ([Html] -> Html)
-> StateT WriterState m [Html] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     (TableRow -> StateT WriterState m Html)
-> [TableRow] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> TableRow -> StateT WriterState m Html
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
  html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  let hasDefaultWidth (a
_, ColWidth
ColWidthDefault) = Bool
True
      hasDefaultWidth (a, ColWidth)
_                    = Bool
False

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

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

  return $
    if all hasDefaultWidth colspecs
    then mempty
    else do
      H.colgroup $ do
        nl
        mapM_ (col . snd) colspecs
      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 celltype :: CellType
celltype = case TablePart
tblpart of
                   TablePart
Thead -> CellType
HeaderCell
                   TablePart
_     -> CellType
BodyCell
  headcells <- (Cell -> StateT WriterState m Html)
-> [Cell] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> CellType -> Cell -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> CellType -> Cell -> StateT WriterState m Html
cellToHtml WriterOptions
opts CellType
HeaderCell) [Cell]
rowhead
  bodycells <- mapM (cellToHtml opts celltype) rowbody
  rowHtml <- addAttrs opts attr $ H.tr $ do
    nl
    mconcat headcells
    mconcat bodycells
  return $ do
    rowHtml
    nl

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

rowspanAttrib :: RowSpan -> Attribute
rowspanAttrib :: RowSpan -> Attribute
rowspanAttrib = \case
  RowSpan Int
1 -> Attribute
forall a. Monoid a => a
mempty
  RowSpan Int
n -> AttributeValue -> Attribute
A.rowspan (Int -> AttributeValue
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 = ColSpec -> Alignment
forall a b. (a, b) -> a
fst ColSpec
colspec
  in WriterOptions
-> CellType -> Alignment -> Cell -> StateT WriterState m Html
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
  contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
item
  html5 <- gets stHtml5
  let (ident, cls, kvs) = attr
  let tag' = case CellType
ctype of
        CellType
BodyCell   -> Html -> Html
H.td
        CellType
HeaderCell -> Html -> Html
H.th
  let align' = case Alignment
align of
        Alignment
AlignDefault -> Alignment
colAlign
        Alignment
_            -> Alignment
align
  let 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 ((Text, Text) -> Bool)
-> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"align") (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
kvs of
                   ([(Text, Text)]
_, []) -> (Text
"align", Text
alignStr) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                   ([(Text, Text)]
xs, (Text, Text)
_:[(Text, Text)]
rest) -> [(Text, Text)]
xs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ (Text
"align", Text
alignStr) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
  otherAttribs <- attrsToHtml opts (ident, cls, kvs')
  let attribs = [Attribute] -> Attribute
forall a. Monoid a => [a] -> a
mconcat
              ([Attribute] -> Attribute) -> [Attribute] -> Attribute
forall a b. (a -> b) -> a -> b
$ ColSpan -> Attribute
colspanAttrib ColSpan
colspan
              Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: RowSpan -> Attribute
rowspanAttrib RowSpan
rowspan
              Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: [Attribute]
otherAttribs
  return $ do
    tag' ! attribs $ contents
    nl

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

toListItem :: Html -> Html
toListItem :: Html -> Html
toListItem Html
item = Html
nl Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
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 =
  [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Html] -> [Html]) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse (Html
nl) ([Html] -> [Html]) -> ([Html] -> [Html]) -> [Html] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Bool) -> [Html] -> [Html]
forall a. (a -> Bool) -> [a] -> [a]
filter Html -> Bool
forall {a}. MarkupM a -> Bool
nonempty
    ([Html] -> Html)
-> StateT WriterState m [Html] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m Html)
-> [Block] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts) [Block]
lst
  where nonempty :: MarkupM a -> Bool
nonempty (Empty 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 = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html)
-> StateT WriterState m [Html] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT WriterState m Html)
-> [Inline] -> StateT WriterState m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Inline -> StateT WriterState m Html
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 (String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"semantics" [Element
cs, String -> ([Attr], String) -> Element
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
          []  -> String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"mrow" ()
          [Element
x] -> Element
x
          [Element]
xs  -> String -> [Element] -> Element
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
  html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  case inline of
    (Str Text
str)      -> Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
strToHtml Text
str
    Inline
Space          -> Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Char -> Html
forall a. ToMarkup a => a -> Html
toHtml Char
' '
    Inline
SoftBreak      -> Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
                                     WrapOption
WrapNone     -> Char -> Html
forall a. ToMarkup a => a -> Html
toHtml Char
' '
                                     WrapOption
WrapAuto     -> Char -> Html
forall a. ToMarkup a => a -> Html
toHtml Char
' '
                                     WrapOption
WrapPreserve -> Char -> Html
forall a. ToMarkup a => a -> Html
toHtml Char
'\n'
    Inline
LineBreak      -> Html -> StateT WriterState m Html
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ do
                        if Bool
html5 then Html
H5.br else Html
H.br
                        Char -> Html
forall a. ToMarkup a => a -> Html
toHtml Char
'\n'
    (Span (Text
"",[Text
cls],[]) [Inline]
ils)
        | Text
cls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"csl-block" Bool -> Bool -> Bool
|| Text
cls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"csl-left-margin" Bool -> Bool -> Bool
||
          Text
cls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"csl-right-inline" Bool -> Bool -> Bool
|| Text
cls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"csl-indent"
        -> WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils StateT WriterState m Html
-> (Html -> StateT WriterState m Html) -> StateT WriterState m Html
forall a b.
StateT WriterState m a
-> (a -> StateT WriterState m b) -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Html -> StateT WriterState m Html
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 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
htmlSpanLikeElements
                               = (Html -> Html, [Text]) -> Maybe (Html -> Html, [Text])
forall a. a -> Maybe a
Just (Tag -> Html -> Html
customParent (Text -> Tag
textTag Text
c), [])
                             | Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"smallcaps"
                               = (Html -> Html, [Text]) -> Maybe (Html -> Html, [Text])
forall a. a -> Maybe a
Just (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"smallcaps", [])
                             | Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"underline"
                               = (Html -> Html, [Text]) -> Maybe (Html -> Html, [Text])
forall a. a -> Maybe a
Just (Html -> Html
H.u, [])
                             | Bool
otherwise = Maybe (Html -> Html, [Text])
forall a. Maybe a
Nothing
                            go (Just (Html -> Html
t,[Text]
cs)) Text
c
                             | Text
c Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
htmlSpanLikeElements
                               = (Html -> Html, [Text]) -> Maybe (Html -> Html, [Text])
forall a. a -> Maybe a
Just (Html -> Html
t (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Html -> Html
customParent (Text -> Tag
textTag Text
c), [Text]
cs)
                             | Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"smallcaps"
                               = (Html -> Html, [Text]) -> Maybe (Html -> Html, [Text])
forall a. a -> Maybe a
Just (Html -> Html
t (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html
H.span (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"smallcaps"), [Text]
cs)
                             | Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"underline"
                               = (Html -> Html, [Text]) -> Maybe (Html -> Html, [Text])
forall a. a -> Maybe a
Just (Html -> Html
t (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
H.u, [Text]
cs)
                             | Bool
otherwise
                               = (Html -> Html, [Text]) -> Maybe (Html -> Html, [Text])
forall a. a -> Maybe a
Just (Html -> Html
t, Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
cs)
                            spanLikeTags :: [Text] -> Maybe (Html -> Html, [Text])
spanLikeTags = (Maybe (Html -> Html, [Text])
 -> Text -> Maybe (Html -> Html, [Text]))
-> Maybe (Html -> Html, [Text])
-> [Text]
-> Maybe (Html -> Html, [Text])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe (Html -> Html, [Text])
-> Text -> Maybe (Html -> Html, [Text])
go Maybe (Html -> Html, [Text])
forall a. Maybe a
Nothing
                        in case [Text] -> Maybe (Html -> Html, [Text])
spanLikeTags [Text]
classes of
                            Just (Html -> Html
tag, [Text]
cs) -> do
                              h <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils
                              addAttrs opts (id',cs,kvs') $ tag h
                            Maybe (Html -> Html, [Text])
Nothing -> do
                              h <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils
                              addAttrs opts (id',classes',kvs') (H.span h)
                            where
                              styles :: [Text]
styles = [Text
"font-style:normal;"
                                       | Text
"csl-no-emph" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                                    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"font-weight:normal;"
                                       | Text
"csl-no-strong" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                                    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"font-variant:normal;"
                                       | Text
"csl-no-smallcaps" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                              kvs' :: [(Text, Text)]
kvs' = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
styles
                                        then [(Text, Text)]
kvs
                                        else (Text
"style", [Text] -> Text
T.concat [Text]
styles) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                              classes' :: [Text]
classes' = [ Text
c | Text
c <- [Text]
classes
                                         , Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ Text
"csl-no-emph"
                                                       , Text
"csl-no-strong"
                                                       , Text
"csl-no-smallcaps"
                                                       ]
                                         ]

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

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

addBibliorefRole :: Inline -> Inline
addBibliorefRole :: Inline -> Inline
addBibliorefRole (Link (Text
id',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils (Text
src,Text
tit))
   | Text
"#ref-" Text -> Text -> Bool
`T.isPrefixOf` Text
src =
  Attr -> [Inline] -> (Text, Text) -> Inline
Link (Text
id',[Text]
classes,(Text
"role",Text
"doc-biblioref")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs) [Inline]
ils (Text
src,Text
tit)
addBibliorefRole 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
  epubVersion <- (WriterState -> Maybe EPUBVersion)
-> StateT WriterState m (Maybe EPUBVersion)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
  html5 <- gets stHtml5
  case 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
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"fnref" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref,Text
"")]
      let blocks' :: [Block]
blocks'  = if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks
                        then []
                        else let lastBlock :: Block
lastBlock   = [Block] -> Block
forall a. HasCallStack => [a] -> a
last [Block]
blocks
                                 otherBlocks :: [Block]
otherBlocks = [Block] -> [Block]
forall a. HasCallStack => [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" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls
                                                -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
lastBlock,
                                                      [Inline] -> Block
Plain [Inline]
backlink]
                                      Para [Inline]
lst  -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                                                     [[Inline] -> Block
Para ([Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
backlink)]
                                      Plain [Inline]
lst -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                                                     [[Inline] -> Block
Plain ([Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
backlink)]
                                      Block
_         -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
lastBlock,
                                                     [Inline] -> Block
Plain [Inline]
backlink]
      contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks'
      let noteItem = Html -> Html
H.li (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts (Text
"fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
contents
      return $ noteItem >> 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
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"fnref" Text -> Text -> Text
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 Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"." Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
             (Plain [Inline]
ils : [Block]
rest) ->
                [Inline] -> Block
Plain (Inline
backlink Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
"." Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
             [Block]
_ -> [Inline] -> Block
Para [Inline
backlink , Text -> Inline
Str Text
"."] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blocks
      contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks'
      let noteItem = (if EPUBVersion
epubv EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3
                         then Html -> Html
H5.aside (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"epub:type" AttributeValue
"footnote" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"role" AttributeValue
"doc-footnote"
                         else Html -> Html
H.div) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts (Text
"fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref)
                      (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
nl Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
contents Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
      return $ noteItem >> 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
  html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  return $
    (if html5 then H5.div else H.div)
                x ! A.class_ (toValue 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 Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
mathmlenvs
  where envName :: Text
envName = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= 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"]


-- | Check to see if Format is valid HTML
isRawHtml :: PandocMonad m => Format -> StateT WriterState m Bool
isRawHtml :: forall (m :: * -> *).
PandocMonad m =>
Format -> StateT WriterState m Bool
isRawHtml Format
f = do
  html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  return $ f == Format "html" ||
           ((html5 && f == Format "html5") || f == Format "html4") ||
           isSlideVariant f

-- | Check to see if Format matches with an HTML slide variant
isSlideVariant :: Format -> Bool
isSlideVariant :: Format -> Bool
isSlideVariant Format
f = Format
f Format -> [Format] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text -> Format
Format Text
"s5", Text -> Format
Format Text
"slidy", Text -> Format
Format Text
"slideous",
                             Text -> Format
Format Text
"dzslides", Text -> Format
Format Text
"revealjs"]


-- 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 = (Inline -> Inline) -> [Inline] -> [Inline]
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

toURI :: Bool -> Text -> Text
toURI :: Bool -> Text -> Text
toURI Bool
isHtml5 Text
t = if Bool
isHtml5 then Text
t else Text -> Text
escapeURI Text
t
 where
   escapeURI :: Text -> Text
escapeURI = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
escapeURIString (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
needsEscaping) (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
   needsEscaping :: Char -> Bool
needsEscaping Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
"<>|\"{}[]^`" Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isAscii Char
c)

hasVariable :: Text -> DT.Template a -> Bool
hasVariable :: forall a. Text -> Template a -> Bool
hasVariable Text
var = Template a -> Bool
forall {a}. Template a -> Bool
checkVar
 where
   matches :: Variable -> Bool
matches Variable
v' = Text -> [Text] -> Text
T.intercalate Text
"." (Variable -> [Text]
DT.varParts Variable
v') Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
var
   checkVar :: Template a -> Bool
checkVar (DT.Interpolate Variable
v) = Variable -> Bool
matches Variable
v
   checkVar (DT.Conditional Variable
v Template a
t1 Template a
t2) = Variable -> Bool
matches Variable
v Bool -> Bool -> Bool
|| Template a -> Bool
checkVar Template a
t1 Bool -> Bool -> Bool
|| Template a -> Bool
checkVar Template a
t2
   checkVar (DT.Iterate Variable
v Template a
t1 Template a
t2) = Variable -> Bool
matches Variable
v Bool -> Bool -> Bool
|| Template a -> Bool
checkVar Template a
t1 Bool -> Bool -> Bool
|| Template a -> Bool
checkVar Template a
t2
   checkVar (DT.Nested Template a
t) = Template a -> Bool
checkVar Template a
t
   checkVar (DT.Partial [Pipe]
_ Template a
t) = Template a -> Bool
checkVar Template a
t
   checkVar (DT.Concat Template a
t1 Template a
t2) = Template a -> Bool
checkVar Template a
t1 Bool -> Bool -> Bool
|| Template a -> Bool
checkVar Template a
t2
   checkVar (DT.Literal Doc a
_) = Bool
False
   checkVar Template a
DT.Empty = Bool
False