{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Writers.HTML
   Copyright   : Copyright (C) 2006-2022 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
import Data.Char (ord)
import Data.List (intercalate, intersperse, partition, delete, (\\), foldl')
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Maybe (fromMaybe, isJust, isNothing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Network.URI (URI (..), parseURIReference)
import Numeric (showHex)
import Text.DocLayout (render, literal, Doc)
import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent)
import Text.DocTemplates (FromContext (lookupContext), Context (..))
import Text.Blaze.Html hiding (contents)
import Text.Pandoc.Translations (Term(Abstract))
import Text.Pandoc.CSS (cssAttributes)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight,
                                 styleToCss)
import Text.Pandoc.ImageSize
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Slides
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import Text.Pandoc.Network.HTTP (urlEncode)
import Text.Pandoc.XML (escapeStringForXML, fromEntities, toEntities,
                        html5Attributes, html4Attributes, rdfaAttributes)
import qualified Text.Blaze.XHtml5 as H5
import qualified Text.Blaze.XHtml5.Attributes as A5
import Control.Monad.Except (throwError)
import System.FilePath (takeBaseName)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Text.Blaze.XHtml1.Transitional as H
import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
import Text.Pandoc.Class.PandocMonad (PandocMonad, report,
                                      translateTerm)
import Text.Pandoc.Class.PandocPure (runPure)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.MIME (mediaCategory)
import Text.Pandoc.Writers.Blaze (layoutMarkup)
import Text.TeXMath
import Text.XML.Light (elChildren, unode, unqual)
import qualified Text.XML.Light as XML
import Text.XML.Light.Output
import Data.String (fromString)

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

defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState = WriterState :: [Html]
-> Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe EPUBVersion
-> HTMLSlideVariant
-> Int
-> Bool
-> Int
-> Bool
-> Maybe Int
-> Int
-> WriterState
WriterState {stNotes :: [Html]
stNotes= [], stEmittedNotes :: Int
stEmittedNotes = 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 = 1,
                                  stInSection :: Bool
stInSection = Bool
False,
                                  stCodeBlockNum :: Int
stCodeBlockNum = 0,
                                  stCsl :: Bool
stCsl = Bool
False,
                                  stCslEntrySpacing :: Maybe Int
stCslEntrySpacing = Maybe Int
forall a. Maybe a
Nothing,
                                  stBlockLevel :: Int
stBlockLevel = 0}

-- Helpers to render HTML with the appropriate function.

strToHtml :: Text -> Html
strToHtml :: Text -> Html
strToHtml = [Char] -> Html
strToHtml' ([Char] -> Html) -> (Text -> [Char]) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
  where
    strToHtml' :: [Char] -> Html
strToHtml' ('\'':xs :: [Char]
xs) = [Char] -> Html
preEscapedString "\'" Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` [Char] -> Html
strToHtml' [Char]
xs
    strToHtml' ('"' :xs :: [Char]
xs) = [Char] -> Html
preEscapedString "\"" Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` [Char] -> Html
strToHtml' [Char]
xs
    strToHtml' (x :: Char
x:xs :: [Char]
xs) | Char -> Bool
needsVariationSelector Char
x
                      = [Char] -> Html
preEscapedString [Char
x, '\xFE0E'] Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend`
                        case [Char]
xs of
                          ('\xFE0E':ys :: [Char]
ys) -> [Char] -> Html
strToHtml' [Char]
ys
                          _             -> [Char] -> Html
strToHtml' [Char]
xs
    strToHtml' xs :: [Char]
xs@(_:_) = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"' Bool -> Bool -> Bool
||
                                       Char -> Bool
needsVariationSelector Char
c) [Char]
xs of
                            (_ ,[]) -> [Char] -> Html
forall a. ToMarkup a => a -> Html
toHtml [Char]
xs
                            (ys :: [Char]
ys,zs :: [Char]
zs) -> [Char] -> Html
forall a. ToMarkup a => a -> Html
toHtml [Char]
ys Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` [Char] -> Html
strToHtml' [Char]
zs
    strToHtml' [] = ""

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

-- | Hard linebreak.
nl :: Html
nl :: Html
nl = [Char] -> Html
preEscapedString "\n"

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

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

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

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

-- | Convert Pandoc document to Html appropriate for an epub version.
writeHtmlStringForEPUB :: PandocMonad m
                       => EPUBVersion -> WriterOptions -> Pandoc
                       -> m Text
writeHtmlStringForEPUB :: EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB version :: EPUBVersion
version o :: WriterOptions
o = WriterState -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString'
                      WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = EPUBVersion
version EPUBVersion -> EPUBVersion -> Bool
forall a. Eq a => a -> a -> Bool
== EPUBVersion
EPUB3,
                                          stEPUBVersion :: Maybe EPUBVersion
stEPUBVersion = EPUBVersion -> Maybe EPUBVersion
forall a. a -> Maybe a
Just EPUBVersion
version }
                      WriterOptions
o{ writerWrapText :: WrapOption
writerWrapText = WrapOption
WrapNone }

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

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

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

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

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

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

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

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

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

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

        _ -> case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext "mathml-script"
                  (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
                    Just s :: Text
s | Bool -> Bool
not (WriterState -> Bool
stHtml5 WriterState
st) ->
                      Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ "text/javascript"
                        (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
preEscapedString
                          ("/*<![CDATA[*/\n" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                          "/*]]>*/\n")
                          | Bool
otherwise -> Html
forall a. Monoid a => a
mempty
                    Nothing -> Html
forall a. Monoid a => a
mempty
  let Maybe [Text]
mCss :: Maybe [Text] = Text -> Context Text -> Maybe [Text]
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext "css" Context Text
metadata
  let context :: Context Text
      context :: Context Text
context =   (if WriterState -> Bool
stHighlighting WriterState
st
                      then case WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts of
                                Just sty :: Style
sty -> Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Style -> [Char]
styleToCss Style
sty)
                                Nothing  -> Context Text -> Context Text
forall a. a -> a
id
                      else Context Text -> Context Text
forall a. a -> a
id) (Context Text -> Context Text)
-> (Context Text -> Context Text) -> 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 "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
                              Nothing -> Context Text -> Context Text
forall a. a -> a
id
                              Just 0  -> Context Text -> Context Text
forall a. a -> a
id
                              Just n :: Int
n  ->
                                Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "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
<> "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 "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 "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 u :: Text
u -> Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "mathjax" Bool
True (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "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
/='?') Text
u)
                        _         -> Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "mathjax" Bool
False) (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
                        PlainMath -> Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "displaymath-css" Bool
True
                        WebTeX _  -> Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "displaymath-css" Bool
True
                        _         -> 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 "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 "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 "controlsLayout"
                           ("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 "controlsBackArrows" ("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 "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 "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 "showSlideNumber" ("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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "navigationMode" ("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 "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 "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 "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 "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 "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 "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 "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 "autoPlayMedia" ("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 "preloadIframes" ("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 "autoSlide" ("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 "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 "autoSlideMethod" ("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 "defaultTiming" ("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 "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 "display" ("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 "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 "hideCursorTime" ("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 "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 "transition" ("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 "transitionSpeed" ("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 "backgroundTransition" ("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 "viewDistance" ("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 "mobileViewDistance" ("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 "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 "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 "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 "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 "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 "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 "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 "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 "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 "slidy-url"
                    ("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 "slideous-url" ("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 "revealjs-url" ("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 "s5-url" ("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 "html5" (WriterState -> Bool
stHtml5 WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Context Text
metadata
  (Html, Context Text) -> StateT WriterState m (Html, Context Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
thebody, Context Text
context)

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

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

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

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

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

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

listItemToHtml :: PandocMonad m
               => WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml :: WriterOptions -> [Block] -> StateT WriterState m Html
listItemToHtml opts :: WriterOptions
opts bls :: [Block]
bls
  | Plain (Str "☐":Space:is :: [Inline]
is) : bs :: [Block]
bs <- [Block]
bls = Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *) a.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
False Html -> Html
forall a. a -> a
id  [Inline]
is [Block]
bs
  | Plain (Str "☒":Space:is :: [Inline]
is) : bs :: [Block]
bs <- [Block]
bls = Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *) a.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
True  Html -> Html
forall a. a -> a
id  [Inline]
is [Block]
bs
  | Para  (Str "☐":Space:is :: [Inline]
is) : bs :: [Block]
bs <- [Block]
bls = Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *) a.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
False Html -> Html
H.p [Inline]
is [Block]
bs
  | Para  (Str "☒":Space:is :: [Inline]
is) : bs :: [Block]
bs <- [Block]
bls = Bool
-> (Html -> Html)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
forall (m :: * -> *) a.
PandocMonad m =>
Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem Bool
True  Html -> Html
H.p [Inline]
is [Block]
bs
  | Bool
otherwise = WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
bls
  where
    taskListItem :: Bool
-> (Html -> MarkupM a)
-> [Inline]
-> [Block]
-> StateT WriterState m Html
taskListItem checked :: Bool
checked constr :: Html -> MarkupM a
constr is :: [Inline]
is bs :: [Block]
bs = do
      let checkbox :: Html
checkbox  = if Bool
checked
                      then Html
checkbox' Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.checked ""
                      else Html
checkbox'
          checkbox' :: Html
checkbox' = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.type_ "checkbox" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.disabled "" Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
nl
      Html
isContents <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
is
      Html
bsContents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
bs
      Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> MarkupM a
constr (Html
checkbox Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
isContents) MarkupM a -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
bsContents

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

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

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

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

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

-- | 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 opts :: WriterOptions
opts html5 :: Bool
html5 selfClosing :: Bool
selfClosing tagname :: Text
tagname attr :: Attr
attr =
  let mktag :: PandocPure Text
mktag = (Text -> Text
TL.toStrict (Text -> Text) -> (Html -> Text) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml (Html -> Text) -> PandocPure Html -> PandocPure Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT WriterState PandocPure Html
-> WriterState -> PandocPure Html
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
               (WriterOptions -> Attr -> Html -> StateT WriterState PandocPure Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts Attr
attr (Tag -> Bool -> Html
customLeaf (Text -> Tag
textTag Text
tagname) Bool
selfClosing))
               WriterState
defaultWriterState{ stHtml5 :: Bool
stHtml5 = Bool
html5 })
  in  case PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure PandocPure Text
mktag of
           Left _  -> Text
forall a. Monoid a => a
mempty
           Right t :: Text
t -> Text
t

addAttrs :: PandocMonad m
         => WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs :: WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs opts :: WriterOptions
opts attr :: Attr
attr h :: Html
h = (Html -> Attribute -> Html) -> Html -> [Attribute] -> Html
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (!) Html
h ([Attribute] -> Html)
-> StateT WriterState m [Attribute] -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Attr -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts Attr
attr

toAttrs :: PandocMonad m
        => [(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs :: [(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs kvs :: [(Text, Text)]
kvs = do
  Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  Maybe EPUBVersion
mbEpubVersion <- (WriterState -> Maybe EPUBVersion)
-> StateT WriterState m (Maybe EPUBVersion)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
  [Attribute] -> [Attribute]
forall a. [a] -> [a]
reverse ([Attribute] -> [Attribute])
-> ((Set Text, [Attribute]) -> [Attribute])
-> (Set Text, [Attribute])
-> [Attribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text, [Attribute]) -> [Attribute]
forall a b. (a, b) -> b
snd ((Set Text, [Attribute]) -> [Attribute])
-> StateT WriterState m (Set Text, [Attribute])
-> StateT WriterState m [Attribute]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Set Text, [Attribute])
 -> (Text, Text) -> StateT WriterState m (Set Text, [Attribute]))
-> (Set Text, [Attribute])
-> [(Text, Text)]
-> StateT WriterState m (Set Text, [Attribute])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Bool
-> Maybe EPUBVersion
-> (Set Text, [Attribute])
-> (Text, Text)
-> StateT WriterState m (Set Text, [Attribute])
forall (m :: * -> *).
PandocMonad m =>
Bool
-> Maybe EPUBVersion
-> (Set Text, [Attribute])
-> (Text, Text)
-> m (Set Text, [Attribute])
go Bool
html5 Maybe EPUBVersion
mbEpubVersion) (Set Text
forall a. Set a
Set.empty, []) [(Text, Text)]
kvs
 where
  go :: Bool
-> Maybe EPUBVersion
-> (Set Text, [Attribute])
-> (Text, Text)
-> m (Set Text, [Attribute])
go html5 :: Bool
html5 mbEpubVersion :: Maybe EPUBVersion
mbEpubVersion (keys :: Set Text
keys, attrs :: [Attribute]
attrs) (k :: Text
k,v :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Set Text
keys, [Attribute]
attrs)
       else (Set Text, [Attribute]) -> m (Set Text, [Attribute])
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 html5 :: Bool
html5 mbEpubVersion :: Maybe EPUBVersion
mbEpubVersion x :: Text
x y :: 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
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':') Text
x -- e.g. epub: namespace
             Bool -> Bool -> Bool
|| "data-" Text -> Text -> Bool
`T.isPrefixOf` Text
x
             Bool -> Bool -> Bool
|| "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 ("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
||
      "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 :: WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml opts :: WriterOptions
opts (id' :: Text
id',classes' :: [Text]
classes',keyvals :: [(Text, Text)]
keyvals) = do
  [Attribute]
attrs <- [(Text, Text)] -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs [(Text, Text)]
keyvals
  [Attribute] -> StateT WriterState m [Attribute]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attribute] -> StateT WriterState m [Attribute])
-> [Attribute] -> StateT WriterState m [Attribute]
forall a b. (a -> b) -> a -> b
$
    [WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts Text
id' | Bool -> Bool
not (Text -> Bool
T.null Text
id')] [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++
    [AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
classes') | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes')] [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++ [Attribute]
attrs

imgAttrsToHtml :: PandocMonad m
               => WriterOptions -> Attr -> StateT WriterState m [Attribute]
imgAttrsToHtml :: WriterOptions -> Attr -> StateT WriterState m [Attribute]
imgAttrsToHtml opts :: WriterOptions
opts attr :: Attr
attr = do
  [Attribute]
attrs <- WriterOptions -> Attr -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts (Text
ident,[Text]
cls,[(Text, Text)]
kvs')
  [Attribute]
dimattrs <- [(Text, Text)] -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> StateT WriterState m [Attribute]
toAttrs (Attr -> [(Text, Text)]
dimensionsToAttrList Attr
attr)
  [Attribute] -> StateT WriterState m [Attribute]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attribute] -> StateT WriterState m [Attribute])
-> [Attribute] -> StateT WriterState m [Attribute]
forall a b. (a -> b) -> a -> b
$ [Attribute]
attrs [Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++ [Attribute]
dimattrs
  where
    (ident :: Text
ident,cls :: [Text]
cls,kvs :: [(Text, Text)]
kvs) = Attr
attr
    kvs' :: [(Text, Text)]
kvs' = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text, Text) -> Bool
forall a b. (Eq a, IsString a) => (a, b) -> Bool
isNotDim [(Text, Text)]
kvs
    isNotDim :: (a, b) -> Bool
isNotDim ("width", _)  = Bool
False
    isNotDim ("height", _) = Bool
False
    isNotDim _             = Bool
True

dimensionsToAttrList :: Attr -> [(Text, Text)]
dimensionsToAttrList :: Attr -> [(Text, Text)]
dimensionsToAttrList attr :: Attr
attr = [(Text, Text)] -> [(Text, Text)]
consolidateStyles ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Direction -> [(Text, Text)]
go Direction
Width [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Direction -> [(Text, Text)]
go Direction
Height
  where
    consolidateStyles :: [(Text, Text)] -> [(Text, Text)]
    consolidateStyles :: [(Text, Text)] -> [(Text, Text)]
consolidateStyles xs :: [(Text, Text)]
xs =
      case ((Text, Text) -> Bool)
-> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Text, Text) -> Bool
forall a b. (Eq a, IsString a) => (a, b) -> Bool
isStyle [(Text, Text)]
xs of
           ([], _)    -> [(Text, Text)]
xs
           (ss :: [(Text, Text)]
ss, rest :: [(Text, Text)]
rest) -> ("style", Text -> [Text] -> Text
T.intercalate ";" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd [(Text, Text)]
ss) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
    isStyle :: (a, b) -> Bool
isStyle ("style", _) = Bool
True
    isStyle _            = Bool
False
    go :: Direction -> [(Text, Text)]
go dir :: Direction
dir = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
               (Just (Pixel a :: Integer
a)) -> [(Direction -> Text
forall a. Show a => a -> Text
tshow Direction
dir, Integer -> Text
forall a. Show a => a -> Text
tshow Integer
a)]
               (Just x :: Dimension
x)         -> [("style", Direction -> Text
forall a. Show a => a -> Text
tshow Direction
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
x)]
               Nothing          -> []

figure :: PandocMonad m
       => WriterOptions -> Attr -> [Inline] -> (Text, Text)
       -> StateT WriterState m Html
figure :: WriterOptions
-> Attr -> [Inline] -> (Text, Text) -> StateT WriterState m Html
figure opts :: WriterOptions
opts attr :: Attr
attr@(_, _, attrList :: [(Text, Text)]
attrList) txt :: [Inline]
txt (s :: Text
s,tit :: Text
tit) = do
  Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  -- Screen-readers will normally read the @alt@ text and the figure; we
  -- want to avoid them reading the same text twice. With HTML5 we can
  -- use aria-hidden for the caption; with HTML4, we use an empty
  -- alt-text instead.
  -- When the alt text differs from the caption both should be read.
  let alt :: [Inline]
alt = if Bool
html5 then [Inline]
txt else [Text -> Inline
Str ""]
  let tocapt :: Html -> Html
tocapt = if Bool
html5
                  then (Html -> Html
H5.figcaption (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
!) (Attribute -> Html -> Html) -> Attribute -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                       if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "alt" [(Text, Text)]
attrList)
                          then Attribute
forall a. Monoid a => a
mempty
                          else Tag -> AttributeValue -> Attribute
H5.customAttribute (Text -> Tag
textTag "aria-hidden")
                                                  (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue @Text "true")
                  else Html -> Html
H.p (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "caption"
  Html
img <- WriterOptions -> Inline -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml WriterOptions
opts (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
alt (Text
s,Text
tit))
  Html
capt <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
             then Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
             else (Html
nl Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>) (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
tocapt (Html -> Html)
-> StateT WriterState m Html -> StateT WriterState m Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
txt
  let inner :: Html
inner = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat [Html
nl, Html
img, Html
capt, Html
nl]
  Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ if Bool
html5
              then Html -> Html
H5.figure Html
inner
              else Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ "figure" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
inner


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

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

-- | 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 :: WriterOptions -> Block -> StateT WriterState m Html
blockToHtml opts :: WriterOptions
opts block :: Block
block = do
  -- Ignore inserted section divs -- they are not blocks as they came from
  -- the document itself (at least not when coming from markdown)
  let isSection :: Bool
isSection = case Block
block of
        Div (_, classes :: [Text]
classes, _) _ | "section" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> Bool
True
        _ -> 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 (\st :: WriterState
st -> WriterState
st{ stBlockLevel :: Int
stBlockLevel = WriterState -> Int
stBlockLevel WriterState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 })
  Html
doc <- WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtmlInner WriterOptions
opts Block
block
  WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
  let emitNotes :: Bool
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
== 1) Bool -> Bool -> Bool
||
        (WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfSection Bool -> Bool -> Bool
&& Bool
isSection)
  Html
res <- if Bool
emitNotes
    then do
      Html
notes <- if [Html] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (WriterState -> [Html]
stNotes WriterState
st)
        then Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
forall a. Monoid a => a
mempty
        else ReferenceLocation -> Int -> [Html] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
ReferenceLocation -> Int -> [Html] -> StateT WriterState m Html
footnoteSection (WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts) (WriterState -> Int
stEmittedNotes WriterState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ([Html] -> [Html]
forall a. [a] -> [a]
reverse (WriterState -> [Html]
stNotes WriterState
st))
      (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st' :: WriterState
st' -> WriterState
st'{ stNotes :: [Html]
stNotes = [Html]
forall a. Monoid a => a
mempty, stEmittedNotes :: Int
stEmittedNotes = WriterState -> Int
stEmittedNotes WriterState
st' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Html] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (WriterState -> [Html]
stNotes WriterState
st') })
      Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html
doc Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
notes)
    else Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
doc
  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 (\st' :: WriterState
st' -> WriterState
st'{ stBlockLevel :: Int
stBlockLevel = WriterState -> Int
stBlockLevel WriterState
st' Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 })
  Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
res

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

tableBodyToHtml :: PandocMonad m
                => WriterOptions
                -> Ann.TableBody
                -> StateT WriterState m Html
tableBodyToHtml :: WriterOptions -> TableBody -> StateT WriterState m Html
tableBodyToHtml opts :: WriterOptions
opts (Ann.TableBody attr :: Attr
attr _rowHeadCols :: RowHeadColumns
_rowHeadCols inthead :: [HeaderRow]
inthead rows :: [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
    Html
intermediateHead <-
      if [HeaderRow] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
inthead
      then Html -> StateT WriterState m Html
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
    Html
bodyRows <- WriterOptions -> [BodyRow] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [BodyRow] -> StateT WriterState m Html
bodyRowsToHtml WriterOptions
opts [BodyRow]
rows
    Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html
intermediateHead Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
bodyRows

tableHeadToHtml :: PandocMonad m
                => WriterOptions
                -> Ann.TableHead
                -> StateT WriterState m Html
tableHeadToHtml :: WriterOptions -> TableHead -> StateT WriterState m Html
tableHeadToHtml opts :: WriterOptions
opts (Ann.TableHead attr :: Attr
attr rows :: [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 :: WriterOptions -> TableFoot -> StateT WriterState m Html
tableFootToHtml opts :: WriterOptions
opts (Ann.TableFoot attr :: Attr
attr rows :: [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 :: WriterOptions
-> TablePart -> Attr -> [HeaderRow] -> StateT WriterState m Html
tablePartToHtml opts :: WriterOptions
opts tblpart :: TablePart
tblpart attr :: Attr
attr rows :: [HeaderRow]
rows =
  if [HeaderRow] -> 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 (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
                 Thead -> Html -> Html
H.thead
                 Tfoot -> Html -> Html
H.tfoot
                 Tbody -> Html -> Html
H.tbody -- this would be unexpected
    Html
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
    Html
tablePartElement <- 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
tag' Html
contents
    Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ do
      Html
tablePartElement
      Html
nl
  where
    isEmptyRow :: HeaderRow -> Bool
isEmptyRow (Ann.HeaderRow _attr :: Attr
_attr _rownum :: RowNumber
_rownum cells :: [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 _colspecs :: NonEmpty ColSpec
_colspecs _colnum :: ColNumber
_colnum cell :: 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 1) (Int -> ColSpan
ColSpan 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
/= :: TablePart -> TablePart -> Bool
$c/= :: TablePart -> TablePart -> Bool
== :: TablePart -> TablePart -> Bool
$c== :: TablePart -> TablePart -> Bool
Eq)

data CellType = HeaderCell | BodyCell

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

headerRowsToHtml :: PandocMonad m
                 => WriterOptions
                 -> TablePart
                 -> [Ann.HeaderRow]
                 -> StateT WriterState m Html
headerRowsToHtml :: WriterOptions
-> TablePart -> [HeaderRow] -> StateT WriterState m Html
headerRowsToHtml opts :: WriterOptions
opts tablepart :: 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
attr rownum :: RowNumber
rownum rowbody :: [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 :: WriterOptions -> [BodyRow] -> StateT WriterState m Html
bodyRowsToHtml opts :: 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 [1..]
  where
    toTableRow :: RowNumber -> BodyRow -> TableRow
toTableRow rownum :: RowNumber
rownum (Ann.BodyRow attr :: Attr
attr _rownum :: RowNumber
_rownum rowhead :: [Cell]
rowhead rowbody :: [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 :: WriterOptions -> [TableRow] -> StateT WriterState m Html
rowListToHtml opts :: WriterOptions
opts rows :: [TableRow]
rows =
  (\x :: [Html]
x -> Html
nl Html -> Html -> Html
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)
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 :: [ColSpec] -> StateT WriterState m Html
colSpecListToHtml colspecs :: [ColSpec]
colspecs = do
  Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  let hasDefaultWidth :: (a, ColWidth) -> Bool
hasDefaultWidth (_, ColWidthDefault) = Bool
True
      hasDefaultWidth _                    = Bool
False

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

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

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

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

alignmentToString :: Alignment -> Maybe Text
alignmentToString :: Alignment -> Maybe Text
alignmentToString = \case
  AlignLeft    -> Text -> Maybe Text
forall a. a -> Maybe a
Just "left"
  AlignRight   -> Text -> Maybe Text
forall a. a -> Maybe a
Just "right"
  AlignCenter  -> Text -> Maybe Text
forall a. a -> Maybe a
Just "center"
  AlignDefault -> Maybe Text
forall a. Maybe a
Nothing

colspanAttrib :: ColSpan -> Attribute
colspanAttrib :: ColSpan -> Attribute
colspanAttrib = \case
  ColSpan 1 -> Attribute
forall a. Monoid a => a
mempty
  ColSpan n :: 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 1 -> Attribute
forall a. Monoid a => a
mempty
  RowSpan n :: 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 :: WriterOptions -> CellType -> Cell -> StateT WriterState m Html
cellToHtml opts :: WriterOptions
opts celltype :: CellType
celltype (Ann.Cell (colspec :: ColSpec
colspec :| _) _colNum :: ColNumber
_colNum cell :: 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 :: WriterOptions
-> CellType -> Alignment -> Cell -> StateT WriterState m Html
tableCellToHtml opts :: WriterOptions
opts ctype :: CellType
ctype colAlign :: Alignment
colAlign (Cell attr :: Attr
attr align :: Alignment
align rowspan :: RowSpan
rowspan colspan :: ColSpan
colspan item :: [Block]
item) = do
  Html
contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
item
  Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  let (ident :: Text
ident, cls :: [Text]
cls, kvs :: [(Text, Text)]
kvs) = Attr
attr
  let tag' :: Html -> Html
tag' = case CellType
ctype of
        BodyCell   -> Html -> Html
H.td
        HeaderCell -> Html -> Html
H.th
  let align' :: Alignment
align' = case Alignment
align of
        AlignDefault -> Alignment
colAlign
        _            -> Alignment
align
  let kvs' :: [(Text, Text)]
kvs' = case Alignment -> Maybe Text
alignmentToString Alignment
align' of
               Nothing ->
                 [(Text, Text)]
kvs
               Just alignStr :: Text
alignStr ->
                 if Bool
html5
                 then (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
addStyle ("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
== "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
                   (_, []) -> ("align", Text
alignStr) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                   (xs :: [(Text, Text)]
xs, _:rest :: [(Text, Text)]
rest) -> [(Text, Text)]
xs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ ("align", Text
alignStr) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
  [Attribute]
otherAttribs <- WriterOptions -> Attr -> StateT WriterState m [Attribute]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> StateT WriterState m [Attribute]
attrsToHtml WriterOptions
opts (Text
ident, [Text]
cls, [(Text, Text)]
kvs')
  let attribs :: Attribute
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
  Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
tag' (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Attribute
attribs (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
contents
    Html
nl

-- | Adds a key-value pair to the @style@ attribute.
addStyle :: (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
addStyle :: (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
addStyle (key :: Text
key, value :: Text
value) kvs :: [(Text, Text)]
kvs =
  let cssToStyle :: [(Text, Text)] -> Text
cssToStyle = Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text)
-> ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: Text
k, v :: Text
v) -> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ";")
  in 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
== "style") (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
    (_, []) ->
      -- no style attribute yet, add new one
      ("style", [(Text, Text)] -> Text
cssToStyle [(Text
key, Text
value)]) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
    (xs :: [(Text, Text)]
xs, (_,cssStyles :: Text
cssStyles):rest :: [(Text, Text)]
rest) ->
      -- modify the style attribute
      [(Text, Text)]
xs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ ("style", [(Text, Text)] -> Text
cssToStyle [(Text, Text)]
modifiedCssStyles) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
      where
        modifiedCssStyles :: [(Text, Text)]
modifiedCssStyles =
          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
key) (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)] -> ([(Text, Text)], [(Text, Text)]))
-> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)]
cssAttributes Text
cssStyles of
            (cssAttribs :: [(Text, Text)]
cssAttribs, []) -> (Text
key, Text
value) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
cssAttribs
            (pre :: [(Text, Text)]
pre, _:post :: [(Text, Text)]
post)    -> [(Text, Text)]
pre [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ (Text
key, Text
value) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
post

toListItems :: [Html] -> [Html]
toListItems :: [Html] -> [Html]
toListItems items :: [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 item :: Html
item = Html
nl Html -> Html -> Html
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 :: WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml opts :: WriterOptions
opts lst :: [Block]
lst =
  [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Html] -> [Html]) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse (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)
mapM (WriterOptions -> Block -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m Html
blockToHtml WriterOptions
opts) [Block]
lst
  where nonempty :: MarkupM a -> Bool
nonempty (Empty _) = Bool
False
        nonempty _         = Bool
True

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

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


-- | Convert Pandoc inline element to HTML.
inlineToHtml :: PandocMonad m
             => WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml :: WriterOptions -> Inline -> StateT WriterState m Html
inlineToHtml opts :: WriterOptions
opts inline :: Inline
inline = do
  Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  case Inline
inline of
    (Str str :: Text
str)      -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
strToHtml Text
str
    Space          -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
strToHtml " "
    SoftBreak      -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
                                     WrapNone     -> " "
                                     WrapAuto     -> " "
                                     WrapPreserve -> Html
nl
    LineBreak      -> Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ do
                        if Bool
html5 then Html
H5.br else Html
H.br
                        Text -> Html
strToHtml "\n"
    (Span ("",[cls :: Text
cls],[]) ils :: [Inline]
ils)
        | Text
cls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "csl-block" Bool -> Bool -> Bool
|| Text
cls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "csl-left-margin" Bool -> Bool -> Bool
||
          Text
cls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "csl-right-inline" Bool -> Bool -> Bool
|| Text
cls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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 (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 (id' :: Text
id',classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) ils :: [Inline]
ils) ->
                        let spanLikeTag :: Maybe (Html -> Html)
spanLikeTag = case [Text]
classes of
                                (c :: Text
c:_) -> do
                                  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
c Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
htmlSpanLikeElements)
                                  (Html -> Html) -> Maybe (Html -> Html)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Html -> Html) -> Maybe (Html -> Html))
-> (Html -> Html) -> Maybe (Html -> Html)
forall a b. (a -> b) -> a -> b
$ Tag -> Html -> Html
customParent (Text -> Tag
textTag Text
c)
                                _   -> Maybe (Html -> Html)
forall a. Maybe a
Nothing
                        in case Maybe (Html -> Html)
spanLikeTag of
                            Just tag :: Html -> Html
tag -> do
                              Html
h <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils
                              WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
id',[Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
classes',[(Text, Text)]
kvs') (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
tag Html
h
                            Nothing -> do
                              Html
h <- WriterOptions -> [Inline] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml WriterOptions
opts [Inline]
ils
                              WriterOptions -> Attr -> Html -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Html -> StateT WriterState m Html
addAttrs WriterOptions
opts (Text
id',[Text]
classes',[(Text, Text)]
kvs') (Html -> Html
H.span Html
h)
                            where
                              styles :: [Text]
styles = ["font-style:normal;"
                                       | "csl-no-emph" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                                    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ["font-weight:normal;"
                                       | "csl-no-strong" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                                    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ["font-variant:normal;"
                                       | "csl-no-smallcaps" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
                              kvs' :: [(Text, Text)]
kvs' = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
styles
                                        then [(Text, Text)]
kvs
                                        else ("style", [Text] -> Text
T.concat [Text]
styles) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                              classes' :: [Text]
classes' = [ Text
c | Text
c <- [Text]
classes
                                         , Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ "csl-no-emph"
                                                       , "csl-no-strong"
                                                       , "csl-no-smallcaps"
                                                       ]
                                         ]

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

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

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

blockListToNote :: PandocMonad m
                => WriterOptions -> Text -> [Block]
                -> StateT WriterState m Html
blockListToNote :: WriterOptions -> Text -> [Block] -> StateT WriterState m Html
blockListToNote opts :: WriterOptions
opts ref :: Text
ref blocks :: [Block]
blocks = do
  Bool
html5 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHtml5
  -- 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 = [("role","doc-backlink") | Bool
html5]
  let backlink :: [Inline]
backlink = [Attr -> [Inline] -> (Text, Text) -> Inline
Link ("",["footnote-back"],[(Text, Text)]
kvs)
                    [Text -> Inline
Str "↩"] ("#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "fnref" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref,"")]
  let blocks' :: [Block]
blocks'  = if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
blocks
                    then []
                    else let lastBlock :: Block
lastBlock   = [Block] -> Block
forall a. [a] -> a
last [Block]
blocks
                             otherBlocks :: [Block]
otherBlocks = [Block] -> [Block]
forall a. [a] -> [a]
init [Block]
blocks
                         in  case Block
lastBlock of
                                  Para [Image (_,cls :: [Text]
cls,_) _ (_,tit :: Text
tit)]
                                      | "fig:" Text -> Text -> Bool
`T.isPrefixOf` Text
tit
                                        Bool -> Bool -> Bool
|| "r-stretch" Text -> [Text] -> 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 lst :: [Inline]
lst  -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                                                 [[Inline] -> Block
Para ([Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
backlink)]
                                  Plain lst :: [Inline]
lst -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++
                                                 [[Inline] -> Block
Plain ([Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
backlink)]
                                  _         -> [Block]
otherBlocks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
lastBlock,
                                                 [Inline] -> Block
Plain [Inline]
backlink]
  Html
contents <- WriterOptions -> [Block] -> StateT WriterState m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml WriterOptions
opts [Block]
blocks'
  let noteItem :: Html
noteItem = Html -> Html
H.li (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! WriterOptions -> Text -> Attribute
prefixedId WriterOptions
opts ("fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
contents
  Maybe EPUBVersion
epubVersion <- (WriterState -> Maybe EPUBVersion)
-> StateT WriterState m (Maybe EPUBVersion)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe EPUBVersion
stEPUBVersion
  let noteItem' :: Html
noteItem' = case Maybe EPUBVersion
epubVersion of
                       Just EPUB3 -> Html
noteItem Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
!
                                       Tag -> AttributeValue -> Attribute
customAttribute "epub:type" "footnote"
                       _ | Bool
html5  -> Html
noteItem Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
!
                                       Tag -> AttributeValue -> Attribute
customAttribute "role" "doc-endnote"
                       _          -> Html
noteItem
  Html -> StateT WriterState m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> StateT WriterState m Html)
-> Html -> StateT WriterState m Html
forall a b. (a -> b) -> a -> b
$ Html
nl Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
noteItem'

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

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

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

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

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

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

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