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

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

Conversion of HTML to 'Pandoc' document.
-}
module Text.Pandoc.Readers.HTML ( readHtml
                                , htmlTag
                                , htmlInBalanced
                                , isInlineTag
                                , isBlockTag
                                , isTextTag
                                , isCommentTag
                                , toAttr
                                ) where

import Control.Applicative ((<|>))
import Control.Monad (guard, mzero, unless, void)
import Control.Monad.Except (throwError, catchError)
import Control.Monad.Reader (ask, asks, lift, local, runReaderT)
import Data.Text.Encoding.Base64 (encodeBase64)
import Data.Char (isAlphaNum, isLetter)
import Data.Default (Default (..), def)
import Data.Foldable (for_)
import Data.List.Split (splitWhen)
import Data.List (foldl')
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Either (partitionEithers)
import Data.Monoid (First (..))
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (nonStrictRelativeTo, parseURIReference)
import Text.HTML.TagSoup
import Text.HTML.TagSoup.Match
import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.CSS (pickStyleAttrProps)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Definition
import Text.Pandoc.Readers.HTML.Parsing
import Text.Pandoc.Readers.HTML.Table (pTable)
import Text.Pandoc.Readers.HTML.TagCategories
import Text.Pandoc.Readers.HTML.Types
import Text.Pandoc.Readers.LaTeX (rawLaTeXInline)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.Options (
    Extension (Ext_epub_html_exts, Ext_empty_paragraphs, Ext_native_divs,
               Ext_native_spans, Ext_raw_html, Ext_line_blocks, Ext_raw_tex),
    ReaderOptions (readerExtensions, readerStripComments),
    extensionEnabled)
import Text.Pandoc.Parsing hiding ((<|>))
import Text.Pandoc.Shared (
    addMetaField, extractSpaces, htmlSpanLikeElements, renderTags',
    safeRead, tshow, formatCode)
import Text.Pandoc.URI (escapeURI)
import Text.Pandoc.Walk
import Text.TeXMath (readMathML, writeTeX)
import qualified Data.Sequence as Seq

-- | Convert HTML-formatted string to 'Pandoc' document.
readHtml :: (PandocMonad m, ToSources a)
         => ReaderOptions -- ^ Reader options
         -> a             -- ^ Input to parse
         -> m Pandoc
readHtml :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readHtml ReaderOptions
opts a
inp = do
  let tags :: [Tag Text]
tags = [Tag Text] -> [Tag Text]
stripPrefixes forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags forall a b. (a -> b) -> a -> b
$
             forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions forall str. StringLike str => ParseOptions str
parseOptions{ optTagPosition :: Bool
optTagPosition = Bool
True }
             (Sources -> Text
sourcesToText forall a b. (a -> b) -> a -> b
$ forall a. ToSources a => a -> Sources
toSources a
inp)
      parseDoc :: ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
parseDoc = do
        Blocks
blocks <- Bool -> Blocks -> Blocks
fixPlains Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
        Meta
meta <- ParserState -> Meta
stateMeta forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLState -> ParserState
parserState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        [Block]
bs' <- forall (m :: * -> *).
PandocMonad m =>
[Block] -> TagParser m [Block]
replaceNotes (forall a. Many a -> [a]
B.toList Blocks
blocks)
        forall (m :: * -> *) st s.
(PandocMonad m, HasLogMessages st) =>
ParsecT s st m ()
reportLogMessages
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs'
      getError :: ParseError -> String
getError (ParseError -> [Message]
errorMessages -> [Message]
ms) = case [Message]
ms of
                                         []    -> String
""
                                         (Message
m:[Message]
_) -> Message -> String
messageString Message
m
  Either ParseError Pandoc
result <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$
       forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
parseDoc
       (ParserState
-> [(Text, Blocks)]
-> Maybe URI
-> Set Text
-> [LogMessage]
-> Map Text Macro
-> ReaderOptions
-> Bool
-> HTMLState
HTMLState forall a. Default a => a
def{ stateOptions :: ReaderOptions
stateOptions = ReaderOptions
opts }
         [] forall a. Maybe a
Nothing forall a. Set a
Set.empty [] forall k a. Map k a
M.empty ReaderOptions
opts Bool
False)
       String
"source" [Tag Text]
tags
  case Either ParseError Pandoc
result of
    Right Pandoc
doc -> forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
doc
    Left  ParseError
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ParseError -> String
getError ParseError
err

-- Strip namespace prefixes on tags (not attributes)
stripPrefixes :: [Tag Text] -> [Tag Text]
stripPrefixes :: [Tag Text] -> [Tag Text]
stripPrefixes = forall a b. (a -> b) -> [a] -> [b]
map Tag Text -> Tag Text
stripPrefix

stripPrefix :: Tag Text -> Tag Text
stripPrefix :: Tag Text -> Tag Text
stripPrefix (TagOpen Text
s [Attribute Text]
as) = forall str. str -> [Attribute str] -> Tag str
TagOpen ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/=Char
':') Text
s) [Attribute Text]
as
stripPrefix (TagClose Text
s)   = forall str. str -> Tag str
TagClose ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/=Char
':') Text
s)
stripPrefix Tag Text
x = Tag Text
x

replaceNotes :: PandocMonad m => [Block] -> TagParser m [Block]
replaceNotes :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> TagParser m [Block]
replaceNotes [Block]
bs = do
  [(Text, Blocks)]
notes <- HTMLState -> [(Text, Blocks)]
noteTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (forall (m :: * -> *).
PandocMonad m =>
[(Text, Blocks)] -> Inline -> TagParser m Inline
replaceNotes' [(Text, Blocks)]
notes) [Block]
bs

replaceNotes' :: PandocMonad m
              => [(Text, Blocks)] -> Inline -> TagParser m Inline
replaceNotes' :: forall (m :: * -> *).
PandocMonad m =>
[(Text, Blocks)] -> Inline -> TagParser m Inline
replaceNotes' [(Text, Blocks)]
noteTbl (RawInline (Format Text
"noteref") Text
ref) =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe TagParser m Inline
warnNotFound (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inline
Note forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ref [(Text, Blocks)]
noteTbl
 where
  warnNotFound :: TagParser m Inline
warnNotFound = do
    SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ReferenceNotFound Text
ref SourcePos
pos
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> Inline
Note [])
replaceNotes' [(Text, Blocks)]
_ Inline
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
x

setInChapter :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a
setInChapter :: forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInChapter = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\HTMLLocal
s -> HTMLLocal
s {inChapter :: Bool
inChapter = Bool
True})

setInPlain :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a
setInPlain :: forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInPlain = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\HTMLLocal
s -> HTMLLocal
s {inPlain :: Bool
inPlain = Bool
True})

pHtml :: PandocMonad m => TagParser m Blocks
pHtml :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHtml = do
  (TagOpen Text
"html" [Attribute Text]
attr) <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"xml:lang" [Attribute Text]
attr) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"lang" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text
  forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"html" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block

pBody :: PandocMonad m => TagParser m Blocks
pBody :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBody = do
  (TagOpen Text
"body" [Attribute Text]
attr) <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"xml:lang" [Attribute Text]
attr) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"lang" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text
  forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"body" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block

pHead :: PandocMonad m => TagParser m Blocks
pHead :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHead = forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"head" forall a b. (a -> b) -> a -> b
$ TagParser m Blocks
pTitle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TagParser m Blocks
pMetaTag forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TagParser m Blocks
pBaseTag forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny)
  where pTitle :: TagParser m Blocks
pTitle = forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"title" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {m :: * -> *} {u} {b} {s}.
(Monoid a, Monad m, HasMeta u, ToMetaValue b) =>
b -> ParsecT s u m a
setTitle forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines
        setTitle :: b -> ParsecT s u m a
setTitle b
t = forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"title" b
t)
        pMetaTag :: TagParser m Blocks
pMetaTag = do
          Tag Text
mt <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"meta" [])
          let name :: Text
name = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"name" Tag Text
mt
          if Text -> Bool
T.null Text
name
             then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
             else do
               let content :: Text
content = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"content" Tag Text
mt
               forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
s ->
                 let ps :: ParserState
ps = HTMLState -> ParserState
parserState HTMLState
s in
                 HTMLState
s{ parserState :: ParserState
parserState = ParserState
ps{
                      stateMeta :: Meta
stateMeta = forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
name (Text -> Inlines
B.text Text
content)
                                   (ParserState -> Meta
stateMeta ParserState
ps) } }
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
        pBaseTag :: TagParser m Blocks
pBaseTag = do
          Tag Text
bt <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"base" [])
          forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
st -> HTMLState
st{ baseHref :: Maybe URI
baseHref =
               String -> Maybe URI
parseURIReference forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"href" Tag Text
bt }
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

block :: PandocMonad m => TagParser m Blocks
block :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block = ((do
  Tag Text
tag <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
isBlockTag)
  Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  case Tag Text
tag of
    TagOpen Text
name [Attribute Text]
attr ->
      let type' :: Text
type' = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$
                     forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr
          epubExts :: Bool
epubExts = Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_epub_html_exts Extensions
exts
      in
      case Text
name of
        Text
_ | Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
sectioningContent
          , Bool
epubExts
          , Text
"chapter" Text -> Text -> Bool
`T.isInfixOf` Text
type'
          -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eSection
        Text
_ | Bool
epubExts
          , Text
type' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"footnotes", Text
"rearnotes"]
          -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eFootnotes
        Text
_ | Bool
epubExts
          , Text
type' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"footnote", Text
"rearnote"]
          -> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => TagParser m ()
eFootnote
        Text
_ | Bool
epubExts
          , Text
type' forall a. Eq a => a -> a -> Bool
== Text
"toc"
          -> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => TagParser m ()
eTOC
        Text
_ | Text
"titlepage" Text -> Text -> Bool
`T.isInfixOf` Text
type'
          , Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text
"section" forall a. a -> [a] -> [a]
: [Text]
groupingContent)
          -> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => TagParser m ()
eTitlePage
        Text
"p" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPara
        Text
"h1" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h2" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h3" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h4" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h5" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h6" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"blockquote" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBlockQuote
        Text
"pre" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pCodeBlock
        Text
"ul" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList
        Text
"ol" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pOrderedList
        Text
"dl" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDefinitionList
        Text
"table" -> forall (m :: * -> *).
PandocMonad m =>
TagParser m Blocks -> TagParser m Blocks
pTable forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
        Text
"hr" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHrule
        Text
"html" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHtml
        Text
"head" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHead
        Text
"body" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBody
        Text
"div"
          | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_line_blocks Extensions
exts
          , Just Text
"line-block" <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr
          -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pLineBlock
          | Bool
otherwise
          -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"section" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"header" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"main" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"figure" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pFigure
        Text
"iframe" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pIframe
        Text
"style" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
        Text
"textarea" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
        Text
"switch"
          | Bool
epubExts
          -> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch Inlines -> Blocks
B.para forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
        Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Tag Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPlain forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Blocks
res ->
        Blocks
res forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> m ()
trace (Int -> Text -> Text
T.take Int
60 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ forall a. Many a -> [a]
B.toList Blocks
res)

namespaces :: PandocMonad m => [(Text, TagParser m Inlines)]
namespaces :: forall (m :: * -> *).
PandocMonad m =>
[(Text, TagParser m Inlines)]
namespaces = [(Text
mathMLNamespace, forall (m :: * -> *). PandocMonad m => Bool -> TagParser m Inlines
pMath Bool
True)]

mathMLNamespace :: Text
mathMLNamespace :: Text
mathMLNamespace = Text
"http://www.w3.org/1998/Math/MathML"

eSwitch :: (PandocMonad m, Monoid a)
        => (Inlines -> a)
        -> TagParser m a
        -> TagParser m a
eSwitch :: forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch Inlines -> a
constructor TagParser m a
parser = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
  forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"switch" [])
  Maybe Inlines
cases <- forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall a. Maybe a -> First a
First forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). PandocMonad m => TagParser m (Maybe Inlines)
eCase forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank) )
              (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"default" []))
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
  a
fallback <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"default" (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TagParser m a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank)
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
  forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"switch")
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
fallback Inlines -> a
constructor Maybe Inlines
cases

eCase :: PandocMonad m => TagParser m (Maybe Inlines)
eCase :: forall (m :: * -> *). PandocMonad m => TagParser m (Maybe Inlines)
eCase = do
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
  TagOpen Text
_ [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"case" [])
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  case forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup forall (m :: * -> *).
PandocMonad m =>
[(Text, TagParser m Inlines)]
namespaces forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"required-namespace" [Attribute Text]
attr of
    Just TagParser m Inlines
p -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"case" (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TagParser m Inlines
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank)
    Maybe (TagParser m Inlines)
Nothing -> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"case"))

eFootnote :: PandocMonad m => TagParser m ()
eFootnote :: forall (m :: * -> *). PandocMonad m => TagParser m ()
eFootnote = do
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
  TagOpen Text
tag [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy
    (\case
       TagOpen Text
_ [Attribute Text]
attr'
         -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr' of
              Just Text
"footnote" -> Bool
True
              Just Text
"rearnote" -> Bool
True
              Maybe Text
_ -> Bool
False
       Tag Text
_ -> Bool
False)
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  let ident :: Text
ident = forall a. a -> Maybe a -> a
fromMaybe Text
"" (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr)
  Blocks
content <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
s ->
    HTMLState
s {noteTable :: [(Text, Blocks)]
noteTable = (Text
ident, Blocks
content) forall a. a -> [a] -> [a]
: HTMLState -> [(Text, Blocks)]
noteTable HTMLState
s}

eFootnotes :: PandocMonad m => TagParser m Blocks
eFootnotes :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eFootnotes = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let notes :: [Text]
notes = [Text
"footnotes", Text
"rearnotes"]
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
  (TagOpen Text
tag [Attribute Text]
attr') <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notes)
          (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr)
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
s -> HTMLState
s{ inFootnotes :: Bool
inFootnotes = Bool
True }
  Blocks
result <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
s -> HTMLState
s{ inFootnotes :: Bool
inFootnotes = Bool
False }
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Blocks
result
     -- if it just contains notes, we don't need the container:
     then forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
result
     -- but there might be content other than notes, in which case
     -- we want a div:
     else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith ([Attribute Text] -> Attr
toAttr [Attribute Text]
attr') Blocks
result

eNoteref :: PandocMonad m => TagParser m Inlines
eNoteref :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
eNoteref = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
  TagOpen Text
tag [Attribute Text]
attr <-
    forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\case
                 TagOpen Text
_ [Attribute Text]
as
                    -> (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
as forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
as)
                        forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"noteref"
                 Tag Text
_  -> Bool
False)
  Text
ident <- case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" [Attribute Text]
attr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe (Char, Text)
T.uncons of
             Just (Char
'#', Text
rest) -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
rest
             Maybe (Char, Text)
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  [Tag Text]
_ <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\case
                                   TagClose Text
t -> Text
t forall a. Eq a => a -> a -> Bool
== Text
tag
                                   Tag Text
_          -> Bool
False))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"noteref" Text
ident

-- Strip TOC if there is one, better to generate again
eTOC :: PandocMonad m => TagParser m ()
eTOC :: forall (m :: * -> *). PandocMonad m => TagParser m ()
eTOC = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
  (TagOpen Text
tag [Attribute Text]
attr) <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"toc"
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)

pBulletList :: PandocMonad m => TagParser m Blocks
pBulletList :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"ul" [])
  let nonItem :: TagParser m (Tag Text)
nonItem = forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\Tag Text
t ->
                  Bool -> Bool
not (forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"li",Text
"ol",Text
"ul",Text
"dl"]) (forall a b. a -> b -> a
const Bool
True) Tag Text
t) Bool -> Bool -> Bool
&&
                  Bool -> Bool
not (Text -> Tag Text -> Bool
matchTagClose Text
"ul" Tag Text
t))
  -- note: if they have an <ol> or <ul> not in scope of a <li>,
  -- treat it as a list item, though it's not valid xhtml...
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem
  [Blocks]
items <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall (m :: * -> *) a.
PandocMonad m =>
TagParser m a -> TagParser m Blocks
pListItem' TagParser m (Tag Text)
nonItem) (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"ul")
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
B.bulletList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Blocks -> Blocks
fixPlains Bool
True) [Blocks]
items

pListItem :: PandocMonad m => TagParser m Blocks
pListItem :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pListItem = do
  TagOpen Text
_ [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"li" [])
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  let addId :: Text -> Blocks -> Blocks
addId Text
ident Blocks
bs = case forall a. Many a -> [a]
B.toList Blocks
bs of
                           (Plain [Inline]
ils:[Block]
xs) -> forall a. [a] -> Many a
B.fromList ([Inline] -> Block
Plain
                                [Attr -> [Inline] -> Inline
Span (Text
ident, [], []) [Inline]
ils] forall a. a -> [a] -> [a]
: [Block]
xs)
                           [Block]
_ -> Attr -> Blocks -> Blocks
B.divWith (Text
ident, [], []) Blocks
bs
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Text -> Blocks -> Blocks
addId (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"li" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block

-- | Parses a list item just like 'pListItem', but allows sublists outside of
-- @li@ tags to be treated as items.
pListItem' :: PandocMonad m => TagParser m a -> TagParser m Blocks
pListItem' :: forall (m :: * -> *) a.
PandocMonad m =>
TagParser m a -> TagParser m Blocks
pListItem' TagParser m a
nonItem = (forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pListItem forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pOrderedList)
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m a
nonItem

parseListStyleType :: Text -> ListNumberStyle
parseListStyleType :: Text -> ListNumberStyle
parseListStyleType Text
"lower-roman" = ListNumberStyle
LowerRoman
parseListStyleType Text
"upper-roman" = ListNumberStyle
UpperRoman
parseListStyleType Text
"lower-alpha" = ListNumberStyle
LowerAlpha
parseListStyleType Text
"upper-alpha" = ListNumberStyle
UpperAlpha
parseListStyleType Text
"decimal"     = ListNumberStyle
Decimal
parseListStyleType Text
_             = ListNumberStyle
DefaultStyle

parseTypeAttr :: Text -> ListNumberStyle
parseTypeAttr :: Text -> ListNumberStyle
parseTypeAttr Text
"i" = ListNumberStyle
LowerRoman
parseTypeAttr Text
"I" = ListNumberStyle
UpperRoman
parseTypeAttr Text
"a" = ListNumberStyle
LowerAlpha
parseTypeAttr Text
"A" = ListNumberStyle
UpperAlpha
parseTypeAttr Text
"1" = ListNumberStyle
Decimal
parseTypeAttr Text
_   = ListNumberStyle
DefaultStyle

pOrderedList :: PandocMonad m => TagParser m Blocks
pOrderedList :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pOrderedList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
_ [Attribute Text]
attribs' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"ol" [])
  Bool
isNoteList <- HTMLState -> Bool
inFootnotes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let attribs :: [Attribute Text]
attribs = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attribs'
  let start :: Int
start = forall a. a -> Maybe a -> a
fromMaybe Int
1 forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start" [Attribute Text]
attribs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  let style :: ListNumberStyle
style = forall a. a -> Maybe a -> a
fromMaybe ListNumberStyle
DefaultStyle
         forall a b. (a -> b) -> a -> b
$  (Text -> ListNumberStyle
parseTypeAttr      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attribs)
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> ListNumberStyle
parseListStyleType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attribs)
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> ListNumberStyle
parseListStyleType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [Attribute Text]
attribs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
pickListStyle))
        where
          pickListStyle :: Text -> Maybe Text
pickListStyle = [Text] -> Text -> Maybe Text
pickStyleAttrProps [Text
"list-style-type", Text
"list-style"]

  let nonItem :: TagParser m (Tag Text)
nonItem = forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\Tag Text
t ->
                  Bool -> Bool
not (forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"li",Text
"ol",Text
"ul",Text
"dl"]) (forall a b. a -> b -> a
const Bool
True) Tag Text
t) Bool -> Bool -> Bool
&&
                  Bool -> Bool
not (Text -> Tag Text -> Bool
matchTagClose Text
"ol" Tag Text
t))
  -- note: if they have an <ol> or <ul> not in scope of a <li>,
  -- treat it as a list item, though it's not valid xhtml...
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem
  if Bool
isNoteList
     then do
       [()]
_ <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall (m :: * -> *). PandocMonad m => TagParser m ()
eFootnote forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank) (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"ol")
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     else do
       [Blocks]
items <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall (m :: * -> *) a.
PandocMonad m =>
TagParser m a -> TagParser m Blocks
pListItem' TagParser m (Tag Text)
nonItem) (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"ol")
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Blocks] -> Blocks
B.orderedListWith (Int
start, ListNumberStyle
style, ListNumberDelim
DefaultDelim) forall a b. (a -> b) -> a -> b
$
                forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Blocks -> Blocks
fixPlains Bool
True) [Blocks]
items

pDefinitionList :: PandocMonad m => TagParser m Blocks
pDefinitionList :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDefinitionList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dl" [])
  [(Inlines, [Blocks])]
items <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *).
PandocMonad m =>
TagParser m (Inlines, [Blocks])
pDefListItem (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"dl")
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(Inlines, [Blocks])] -> Blocks
B.definitionList [(Inlines, [Blocks])]
items

pDefListItem :: PandocMonad m => TagParser m (Inlines, [Blocks])
pDefListItem :: forall (m :: * -> *).
PandocMonad m =>
TagParser m (Inlines, [Blocks])
pDefListItem = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let nonItem :: TagParser m (Tag Text)
nonItem = forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\Tag Text
t -> Bool -> Bool
not (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dt" [] Tag Text
t) Bool -> Bool -> Bool
&&
                  Bool -> Bool
not (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dd" [] Tag Text
t) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Tag Text -> Bool
matchTagClose Text
"dl" Tag Text
t))
  [Inlines]
terms <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"dt" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline)
  [Blocks]
defs  <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"dd" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem
  let term :: Inlines
term = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Inlines
x Inlines
y -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
x
                                then Inlines -> Inlines
trimInlines Inlines
y
                                else Inlines
x forall a. Semigroup a => a -> a -> a
<> Inlines
B.linebreak forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
trimInlines Inlines
y)
                    forall a. Monoid a => a
mempty [Inlines]
terms
  forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
term, forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Blocks -> Blocks
fixPlains Bool
True) [Blocks]
defs)

fixPlains :: Bool -> Blocks -> Blocks
fixPlains :: Bool -> Blocks -> Blocks
fixPlains Bool
inList Blocks
bs = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isParaish [Block]
bs'
                         then forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bs'
                         else Blocks
bs
  where isParaish :: Block -> Bool
isParaish Para{}           = Bool
True
        isParaish CodeBlock{}      = Bool
True
        isParaish Header{}         = Bool
True
        isParaish BlockQuote{}     = Bool
True
        isParaish BulletList{}     = Bool -> Bool
not Bool
inList
        isParaish OrderedList{}    = Bool -> Bool
not Bool
inList
        isParaish DefinitionList{} = Bool -> Bool
not Bool
inList
        isParaish Block
_                = Bool
False
        plainToPara :: Block -> Block
plainToPara (Plain [Inline]
xs) = [Inline] -> Block
Para [Inline]
xs
        plainToPara Block
x          = Block
x
        bs' :: [Block]
bs' = forall a. Many a -> [a]
B.toList Blocks
bs

pRawTag :: PandocMonad m => TagParser m Text
pRawTag :: forall (m :: * -> *). PandocMonad m => TagParser m Text
pRawTag = do
  Tag Text
tag <- forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
  let ignorable :: a -> Bool
ignorable a
x = a
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"html",a
"head",a
"body",a
"!DOCTYPE",a
"?xml"]
  if forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen forall {a}. (Eq a, IsString a) => a -> Bool
ignorable (forall a b. a -> b -> a
const Bool
True) Tag Text
tag Bool -> Bool -> Bool
|| forall str. (str -> Bool) -> Tag str -> Bool
tagClose forall {a}. (Eq a, IsString a) => a -> Bool
ignorable Tag Text
tag
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag]

pLineBlock :: PandocMonad m => TagParser m Blocks
pLineBlock :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pLineBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_line_blocks
  Tag Text
_ <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"div") (forall a. Eq a => a -> a -> Bool
== [(Text
"class",Text
"line-block")])
  Inlines
ils <- Inlines -> Inlines
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str. (str -> Bool) -> Tag str -> Bool
tagClose (forall a. Eq a => a -> a -> Bool
==Text
"div")))
  let lns :: [Inlines]
lns = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (forall a. Eq a => a -> a -> Bool
== Inline
LineBreak) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Inline
SoftBreak) forall a b. (a -> b) -> a -> b
$
            forall a. Many a -> [a]
B.toList Inlines
ils
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Inlines] -> Blocks
B.lineBlock [Inlines]
lns

isDivLike :: Text -> Bool
isDivLike :: Text -> Bool
isDivLike Text
"div"     = Bool
True
isDivLike Text
"section" = Bool
True
isDivLike Text
"header"  = Bool
True
isDivLike Text
"main"    = Bool
True
isDivLike Text
_         = Bool
False

pDiv :: PandocMonad m => TagParser m Blocks
pDiv :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_native_divs
  TagOpen Text
tag [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
isDivLike (forall a b. a -> b -> a
const Bool
True)
  let (Text
ident, [Text]
classes, [Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
  Blocks
contents <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
  let contents' :: Blocks
contents' = case forall a. Many a -> Seq a
B.unMany Blocks
contents of
                    Header Int
lev (Text
hident,[Text]
hclasses,[Attribute Text]
hkvs) [Inline]
ils Seq.:<| Seq Block
rest
                        | Text
hident forall a. Eq a => a -> a -> Bool
== Text
ident ->
                          forall a. Seq a -> Many a
B.Many forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
"",[Text]
hclasses,[Attribute Text]
hkvs) [Inline]
ils forall a. a -> Seq a -> Seq a
Seq.<| Seq Block
rest
                    Seq Block
_ -> Blocks
contents
  let classes' :: [Text]
classes' = if Text
tag forall a. Eq a => a -> a -> Bool
== Text
"section"
                    then Text
"section"forall a. a -> [a] -> [a]
:[Text]
classes
                    else [Text]
classes
      kvs' :: [Attribute Text]
kvs' = if Text
tag forall a. Eq a => a -> a -> Bool
== Text
"main" Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"role" [Attribute Text]
kvs)
               then (Text
"role", Text
"main")forall a. a -> [a] -> [a]
:[Attribute Text]
kvs
               else [Attribute Text]
kvs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
ident, [Text]
classes', [Attribute Text]
kvs') Blocks
contents'

pIframe :: PandocMonad m => TagParser m Blocks
pIframe :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pIframe = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardDisabled Extension
Ext_raw_html
  Tag Text
tag <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"iframe") (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src"))
  forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"iframe" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  Text
url <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl forall a b. (a -> b) -> a -> b
$ forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
tag
  if Text -> Bool
T.null Text
url
     then forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag, forall str. str -> Tag str
TagClose Text
"iframe"]
     else forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
       (do (ByteString
bs, Maybe Text
mbMime) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
url
           case Maybe Text
mbMime of
             Just Text
mt
               | Text
"text/html" Text -> Text -> Bool
`T.isPrefixOf` Text
mt -> do
                    let inp :: Text
inp = ByteString -> Text
UTF8.toText ByteString
bs
                    ReaderOptions
opts <- HTMLState -> ReaderOptions
readerOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                    Pandoc Meta
_ [Block]
contents <- forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readHtml ReaderOptions
opts Text
inp
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[]) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
B.fromList [Block]
contents
               | Text
"image/" Text -> Text -> Bool
`T.isPrefixOf` Text
mt -> do
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[]) forall a b. (a -> b) -> a -> b
$
                      Inlines -> Blocks
B.plain forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image Text
url Text
"" forall a. Monoid a => a
mempty
             Maybe Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[(Text
"src", Text
url)]) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty)
       (\PandocError
e -> do
         forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
url (PandocError -> Text
renderError PandocError
e)
         forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag, forall str. str -> Tag str
TagClose Text
"iframe"])

pRawHtmlBlock :: PandocMonad m => TagParser m Blocks
pRawHtmlBlock :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock = do
  Text
raw <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"script" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"style" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"textarea"
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Text
pRawTag
  Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_html Extensions
exts Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
raw)
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
"html" Text
raw
     else forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore Text
raw

ignore :: (Monoid a, PandocMonad m) => Text -> TagParser m a
ignore :: forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore Text
raw = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  -- raw can be null for tags like <!DOCTYPE>; see paRawTag
  -- in this case we don't want a warning:
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
raw) forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
raw SourcePos
pos
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

pHtmlBlock :: PandocMonad m => Text -> TagParser m Text
pHtmlBlock :: forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
t = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Tag Text
open <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
t [])
  [Tag Text]
contents <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
t))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' forall a b. (a -> b) -> a -> b
$ [Tag Text
open] forall a. Semigroup a => a -> a -> a
<> [Tag Text]
contents forall a. Semigroup a => a -> a -> a
<> [forall str. str -> Tag str
TagClose Text
t]

-- Sets chapter context
eSection :: PandocMonad m => TagParser m Blocks
eSection :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eSection = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let matchChapter :: [(a, Text)] -> Bool
matchChapter [(a, Text)]
as = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
T.isInfixOf Text
"chapter")
                        (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"type" [(a, Text)]
as forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"epub:type" [(a, Text)]
as)
  let sectTag :: Tag Text -> Bool
sectTag = forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
sectioningContent) forall {a}. (Eq a, IsString a) => [(a, Text)] -> Bool
matchChapter
  TagOpen Text
tag [Attribute Text]
_ <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
sectTag
  forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInChapter (forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)

headerLevel :: Text -> TagParser m Int
headerLevel :: forall (m :: * -> *). Text -> TagParser m Int
headerLevel Text
tagtype =
  case forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Int -> Text -> Text
T.drop Int
1 Text
tagtype) of
        Just Int
level ->
--          try (do
--            guardEnabled Ext_epub_html_exts
--            asks inChapter >>= guard
--            return (level - 1))
--            <|>
              forall (m :: * -> *) a. Monad m => a -> m a
return Int
level
        Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not retrieve header level"

eTitlePage :: PandocMonad m => TagParser m ()
eTitlePage :: forall (m :: * -> *). PandocMonad m => TagParser m ()
eTitlePage = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let isTitlePage :: [(a, Text)] -> Bool
isTitlePage [(a, Text)]
as = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
T.isInfixOf Text
"titlepage")
       (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"type" [(a, Text)]
as forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"epub:type" [(a, Text)]
as)
  let groupTag :: Tag Text -> Bool
groupTag = forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (\Text
x -> Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
groupingContent Bool -> Bool -> Bool
|| Text
x forall a. Eq a => a -> a -> Bool
== Text
"section")
                          forall {a}. (Eq a, IsString a) => [(a, Text)] -> Bool
isTitlePage
  TagOpen Text
tag [Attribute Text]
_ <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
groupTag
  () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block

pHeader :: PandocMonad m => TagParser m Blocks
pHeader :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
tagtype [Attribute Text]
attr' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$
                           forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"h1",Text
"h2",Text
"h3",Text
"h4",Text
"h5",Text
"h6"])
                           (forall a b. a -> b -> a
const Bool
True)
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  Int
level <- forall (m :: * -> *). Text -> TagParser m Int
headerLevel Text
tagtype
  Inlines
contents <- Inlines -> Inlines
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
tagtype forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  let ident :: Text
ident = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr
  let classes :: [Text]
classes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr
  let keyvals :: [Attribute Text]
keyvals = [(Text
k,Text
v) | (Text
k,Text
v) <- [Attribute Text]
attr, Text
k forall a. Eq a => a -> a -> Bool
/= Text
"class", Text
k forall a. Eq a => a -> a -> Bool
/= Text
"id"]
  Attr
attr'' <- forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
 HasIdentifierList st) =>
Attr -> Inlines -> ParsecT s st m Attr
registerHeader (Text
ident, [Text]
classes, [Attribute Text]
keyvals) Inlines
contents
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
B.headerWith Attr
attr'' Int
level Inlines
contents

pHrule :: PandocMonad m => TagParser m Blocks
pHrule :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHrule = do
  forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing (forall a. Eq a => a -> a -> Bool
==Text
"hr") (forall a b. a -> b -> a
const Bool
True)
  Bool
inNotes <- HTMLState -> Bool
inFootnotes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
inNotes
              then forall a. Monoid a => a
mempty
              else Blocks
B.horizontalRule

pBlockQuote :: PandocMonad m => TagParser m Blocks
pBlockQuote :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBlockQuote = do
  Blocks
contents <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"blockquote" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
B.blockQuote forall a b. (a -> b) -> a -> b
$ Bool -> Blocks -> Blocks
fixPlains Bool
False Blocks
contents

pPlain :: PandocMonad m => TagParser m Blocks
pPlain :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPlain = do
  Inlines
contents <- forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInPlain forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
contents
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain Inlines
contents

pPara :: PandocMonad m => TagParser m Blocks
pPara :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPara = do
  Inlines
contents <- Inlines -> Inlines
trimInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"p" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
  (do forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardDisabled Extension
Ext_empty_paragraphs
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
contents)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> Blocks
B.para Inlines
contents)

pFigure :: PandocMonad m => TagParser m Blocks
pFigure :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pFigure = do
  TagOpen Text
tag [Attribute Text]
attrList <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"figure" []
  let parser :: ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
parser = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"figcaption" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
             (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)
  ([Blocks]
captions, [Blocks]
rest) <- forall a b. [Either a b] -> ([a], [b])
partitionEithers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
parser (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
tag forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  -- Concatenate all captions together
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> Blocks -> Blocks
B.figureWith ([Attribute Text] -> Attr
toAttr [Attribute Text]
attrList)
                        (Blocks -> Caption
B.simpleCaption (forall a. Monoid a => [a] -> a
mconcat [Blocks]
captions))
                        (forall a. Monoid a => [a] -> a
mconcat [Blocks]
rest)

pCodeBlock :: PandocMonad m => TagParser m Blocks
pCodeBlock :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pCodeBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
_ [Attribute Text]
attr' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"pre" [])
  -- if the `pre` has no attributes, try if it is followed by a `code`
  -- element and use those attributes if possible.
  Attr
attr <- case [Attribute Text]
attr' of
    Attribute Text
_:[Attribute Text]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Attribute Text] -> Attr
toAttr [Attribute Text]
attr')
    []  -> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Attr
nullAttr forall a b. (a -> b) -> a -> b
$ do
      TagOpen Text
_ [Attribute Text]
codeAttr <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"code" [])
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Attribute Text] -> Attr
toAttr
        [ (Text
k, Text
v') | (Text
k, Text
v) <- [Attribute Text]
codeAttr
                    -- strip language from class
                  , let v' :: Text
v' = if Text
k forall a. Eq a => a -> a -> Bool
== Text
"class"
                             then forall a. a -> Maybe a -> a
fromMaybe Text
v (Text -> Text -> Maybe Text
T.stripPrefix Text
"language-" Text
v)
                             else Text
v ]
  [Tag Text]
contents <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"pre" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  let rawText :: Text
rawText = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Tag Text -> Text
tagToText [Tag Text]
contents
  -- drop leading newline if any
  let result' :: Text
result' = case Text -> Maybe (Char, Text)
T.uncons Text
rawText of
                     Just (Char
'\n', Text
xs) -> Text
xs
                     Maybe (Char, Text)
_               -> Text
rawText
  -- drop trailing newline if any
  let result :: Text
result = case Text -> Maybe (Text, Char)
T.unsnoc Text
result' of
                    Just (Text
result'', Char
'\n') -> Text
result''
                    Maybe (Text, Char)
_                     -> Text
result'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith Attr
attr Text
result

tagToText :: Tag Text -> Text
tagToText :: Tag Text -> Text
tagToText (TagText Text
s)      = Text
s
tagToText (TagOpen Text
"br" [Attribute Text]
_) = Text
"\n"
tagToText Tag Text
_                = Text
""

inline :: PandocMonad m => TagParser m Inlines
inline :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline = forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
  Tag Text
tag <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
isInlineTag)
  Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  case Tag Text
tag of
    TagOpen Text
name [Attribute Text]
attr ->
      case Text
name of
        Text
"a" | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_epub_html_exts Extensions
exts
          , Just Text
"noteref" <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr
          , Just (Char
'#',Text
_) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" [Attribute Text]
attr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe (Char, Text)
T.uncons
            -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
eNoteref
            | Bool
otherwise -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLink
        Text
"switch" -> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch forall a. a -> a
id forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
        Text
"q" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pQ
        Text
"em" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph
        Text
"i"  -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph
        Text
"strong" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong
        Text
"b" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong
        Text
"sup" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSuperscript
        Text
"sub" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSubscript
        Text
"small" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSmall
        Text
"s" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
        Text
"strike" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
        Text
"del" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
        Text
"u" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline
        Text
"ins" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline
        Text
"br" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLineBreak
        Text
"img" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pImage
        Text
"svg" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSvg
        Text
"bdo" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pBdo
        Text
"tt" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode
        Text
"code" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode
        Text
"samp" -> forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> TagParser m Inlines
pCodeWithClass Text
"samp" Text
"sample"
        Text
"var" -> forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> TagParser m Inlines
pCodeWithClass Text
"var" Text
"variable"
        Text
"span" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpan
        Text
"math" -> forall (m :: * -> *). PandocMonad m => Bool -> TagParser m Inlines
pMath Bool
False
        Text
"script"
          | Just Text
x <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr
          , Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` Text
x -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pScriptMath
        Text
_ | Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Text
htmlSpanLikeElements -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpanLike
        Text
_ -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline
    TagText Text
_ -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText
    Tag Text
_ -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline

pSelfClosing :: PandocMonad m
             => (Text -> Bool) -> ([Attribute Text] -> Bool)
             -> TagParser m (Tag Text)
pSelfClosing :: forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing Text -> Bool
f [Attribute Text] -> Bool
g = do
  Tag Text
open <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
f [Attribute Text] -> Bool
g)
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str. (str -> Bool) -> Tag str -> Bool
tagClose Text -> Bool
f)
  forall (m :: * -> *) a. Monad m => a -> m a
return Tag Text
open

pQ :: PandocMonad m => TagParser m Inlines
pQ :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pQ = do
  TagOpen Text
_ [Attribute Text]
attrs <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
"q" (forall a b. a -> b -> a
const Bool
True)
  case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"cite" [Attribute Text]
attrs of
    Just Text
url -> do
      let uid :: Text
uid = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
                   forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"name" [Attribute Text]
attrs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attrs
      let cls :: [Text]
cls = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attrs
      Text
url' <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl Text
url
      forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
uid, [Text]
cls, [(Text
"cite", Text -> Text
escapeURI Text
url')])
    Maybe Text
Nothing -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote forall a. a -> a
id
 where
  makeQuote :: (Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote Inlines -> Inlines
wrapper = do
    QuoteContext
ctx <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HTMLLocal -> QuoteContext
quoteContext
    let (Inlines -> Inlines
constructor, QuoteContext
innerContext) = case QuoteContext
ctx of
                  QuoteContext
InDoubleQuote -> (Inlines -> Inlines
B.singleQuoted, QuoteContext
InSingleQuote)
                  QuoteContext
_             -> (Inlines -> Inlines
B.doubleQuoted, QuoteContext
InDoubleQuote)
    Inlines
content <- forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
innerContext
                  (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"q"))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Inlines -> Inlines
constructor forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
wrapper) Inlines
content

pEmph :: PandocMonad m => TagParser m Inlines
pEmph :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"em" Inlines -> Inlines
B.emph forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"i" Inlines -> Inlines
B.emph

pStrong :: PandocMonad m => TagParser m Inlines
pStrong :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"strong" Inlines -> Inlines
B.strong forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"b" Inlines -> Inlines
B.strong

pSuperscript :: PandocMonad m => TagParser m Inlines
pSuperscript :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSuperscript = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"sup" Inlines -> Inlines
B.superscript

pSubscript :: PandocMonad m => TagParser m Inlines
pSubscript :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSubscript = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"sub" Inlines -> Inlines
B.subscript

pSpanLike :: PandocMonad m => TagParser m Inlines
pSpanLike :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpanLike =
  forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr
    (\Text
tagName TagParser m Inlines
acc -> TagParser m Inlines
acc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {m :: * -> *}.
PandocMonad m =>
Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
parseTag Text
tagName)
    forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Set Text
htmlSpanLikeElements
  where
    parseTag :: Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
parseTag Text
tagName = do
      TagOpen Text
_ [Attribute Text]
attrs <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
tagName (forall a b. a -> b -> a
const Bool
True)
      let (Text
ids, [Text]
cs, [Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attrs
      Inlines
content <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
tagName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
ids, Text
tagName forall a. a -> [a] -> [a]
: [Text]
cs, [Attribute Text]
kvs) Inlines
content

pSmall :: PandocMonad m => TagParser m Inlines
pSmall :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSmall = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"small" (Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"small"],[]))

pStrikeout :: PandocMonad m => TagParser m Inlines
pStrikeout :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout =
  forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"s" Inlines -> Inlines
B.strikeout forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"strike" Inlines -> Inlines
B.strikeout forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"del" Inlines -> Inlines
B.strikeout forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"span" [(Text
"class",Text
"strikeout")])
            Inlines
contents <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"span")
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
B.strikeout Inlines
contents)

pUnderline :: PandocMonad m => TagParser m Inlines
pUnderline :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"u" Inlines -> Inlines
B.underline forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"ins" Inlines -> Inlines
B.underline

pLineBreak :: PandocMonad m => TagParser m Inlines
pLineBreak :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLineBreak = do
  forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing (forall a. Eq a => a -> a -> Bool
==Text
"br") (forall a b. a -> b -> a
const Bool
True)
  forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.linebreak

pLink :: PandocMonad m => TagParser m Inlines
pLink :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLink = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  tag :: Tag Text
tag@(TagOpen Text
_ [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
"a" (forall a b. a -> b -> a
const Bool
True)
  let title :: Text
title = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"title" Tag Text
tag
  let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k forall a. Eq a => a -> a -> Bool
/= Text
"title" Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
/= Text
"href") [Attribute Text]
attr'
  Inlines
lab <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"a")
  HTMLState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if HTMLState -> Bool
inFootnotes HTMLState
st Bool -> Bool -> Bool
&& Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
"role" Tag Text
tag forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"doc-backlink"
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     else do
       -- check for href; if href, then a link, otherwise a span
       case Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
"href" Tag Text
tag of
            Maybe Text
Nothing   ->
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
B.spanWith Attr
attr) Inlines
lab
            Just Text
url' -> do
              Text
url <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl Text
url'
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces
                        (Attr -> Text -> Text -> Inlines -> Inlines
B.linkWith Attr
attr (Text -> Text
escapeURI Text
url) Text
title) Inlines
lab

pImage :: PandocMonad m => TagParser m Inlines
pImage :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pImage = do
  tag :: Tag Text
tag@(TagOpen Text
_ [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing (forall a. Eq a => a -> a -> Bool
==Text
"img") (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src")
  Text
url <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl forall a b. (a -> b) -> a -> b
$ forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
tag
  let title :: Text
title = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"title" Tag Text
tag
  let alt :: Text
alt = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"alt" Tag Text
tag
  let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k forall a. Eq a => a -> a -> Bool
/= Text
"alt" Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
/= Text
"title" Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
/= Text
"src") [Attribute Text]
attr'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith Attr
attr (Text -> Text
escapeURI Text
url) Text
title (Text -> Inlines
B.text Text
alt)

pSvg :: PandocMonad m => TagParser m Inlines
pSvg :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSvg = do
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardDisabled Extension
Ext_raw_html
  -- if raw_html enabled, parse svg tag as raw
  opent :: Tag Text
opent@(TagOpen Text
_ [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"svg" [])
  let (Text
ident,[Text]
cls,[Attribute Text]
_) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
  [Tag Text]
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"svg") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny)
  Tag Text
closet <- forall str. str -> Tag str
TagClose Text
"svg" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"svg" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  let rawText :: Text
rawText = Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' (Tag Text
opent forall a. a -> [a] -> [a]
: [Tag Text]
contents forall a. [a] -> [a] -> [a]
++ [Tag Text
closet])
  let svgData :: Text
svgData = Text
"data:image/svg+xml;base64," forall a. Semigroup a => a -> a -> a
<> Text -> Text
encodeBase64 Text
rawText
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text
ident,[Text]
cls,[]) Text
svgData forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

pCodeWithClass :: PandocMonad m => Text -> Text -> TagParser m Inlines
pCodeWithClass :: forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> TagParser m Inlines
pCodeWithClass Text
name Text
class' = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
open [Attribute Text]
attr' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
== Text
name) (forall a b. a -> b -> a
const Bool
True)
  let (Text
ids,[Text]
cs,[Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
      cs' :: [Text]
cs'          = Text
class' forall a. a -> [a] -> [a]
: [Text]
cs
  forall (m :: * -> *).
PandocMonad m =>
Text -> Attr -> TagParser m Inlines
code Text
open (Text
ids,[Text]
cs',[Attribute Text]
kvs)

pCode :: PandocMonad m => TagParser m Inlines
pCode :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  (TagOpen Text
open [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"code",Text
"tt"]) (forall a b. a -> b -> a
const Bool
True)
  let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
  forall (m :: * -> *).
PandocMonad m =>
Text -> Attr -> TagParser m Inlines
code Text
open Attr
attr

code :: PandocMonad m => Text -> Attr -> TagParser m Inlines
code :: forall (m :: * -> *).
PandocMonad m =>
Text -> Attr -> TagParser m Inlines
code Text
open Attr
attr = do
  Inlines
result <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
open)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
formatCode Attr
attr Inlines
result

-- https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdo
-- Bidirectional Text Override
pBdo :: PandocMonad m => TagParser m Inlines
pBdo :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pBdo = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
_ [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"bdo") (forall a b. a -> b -> a
const Bool
True)
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  Inlines
contents <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"bdo" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [Attribute Text]
attr of
    -- Only bdo with a direction matters
    Just Text
dir -> Attr -> Inlines -> Inlines
B.spanWith (Text
"", [], [(Text
"dir",Text -> Text
T.toLower Text
dir)]) Inlines
contents
    Maybe Text
Nothing  -> Inlines
contents

pSpan :: PandocMonad m => TagParser m Inlines
pSpan :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpan = do
  (TagOpen Text
_ [Attribute Text]
attr') <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"span") (forall a b. a -> b -> a
const Bool
True))
  Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_native_spans Extensions
exts
     then do
       Inlines
contents <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
       let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
       let classes :: [Text]
classes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr'
       let styleAttr :: Text
styleAttr   = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [Attribute Text]
attr'
       let fontVariant :: Text
fontVariant = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$
                          [Text] -> Text -> Maybe Text
pickStyleAttrProps [Text
"font-variant"] Text
styleAttr
       let isSmallCaps :: Bool
isSmallCaps = Text
fontVariant forall a. Eq a => a -> a -> Bool
== Text
"small-caps" Bool -> Bool -> Bool
||
                           Text
"smallcaps" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
       let tag :: Inlines -> Inlines
tag = if Bool
isSmallCaps then Inlines -> Inlines
B.smallcaps else Attr -> Inlines -> Inlines
B.spanWith Attr
attr
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
tag Inlines
contents
     else if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_html Extensions
exts
             then do
               Tag Text
tag <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"span") (forall a b. a -> b -> a
const Bool
True)
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"html" forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag]
             else forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline -- just contents

pRawHtmlInline :: PandocMonad m => TagParser m Inlines
pRawHtmlInline :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline = do
  Bool
inplain <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HTMLLocal -> Bool
inPlain
  Tag Text
result <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str. (str -> Bool) -> Tag str -> Bool
tagComment (forall a b. a -> b -> a
const Bool
True))
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if Bool
inplain
                   then forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag Text -> Bool
isBlockTag)
                   else forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
isInlineTag
  Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  let raw :: Text
raw = [Tag Text] -> Text
renderTags' [Tag Text
result]
  if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_html Extensions
exts
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"html" Text
raw
     else forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore Text
raw

mathMLToTeXMath :: Text -> Either Text Text
mathMLToTeXMath :: Text -> Either Text Text
mathMLToTeXMath Text
s = [Exp] -> Text
writeTeX forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text [Exp]
readMathML Text
s

pScriptMath :: PandocMonad m => TagParser m Inlines
pScriptMath :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pScriptMath = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
_ [Attribute Text]
attr' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"script") (forall a b. a -> b -> a
const Bool
True)
  Bool
isdisplay <- case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr' of
                    Just Text
x | Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` Text
x
                      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"display" Text -> Text -> Bool
`T.isSuffixOf` Text
x
                    Maybe Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  Text
contents <- forall str. StringLike str => [Tag str] -> str
innerText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"script"))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Bool
isdisplay then Text -> Inlines
B.displayMath else Text -> Inlines
B.math) Text
contents

pMath :: PandocMonad m => Bool -> TagParser m Inlines
pMath :: forall (m :: * -> *). PandocMonad m => Bool -> TagParser m Inlines
pMath Bool
inCase = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  open :: Tag Text
open@(TagOpen Text
_ [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"math") (forall a b. a -> b -> a
const Bool
True)
  -- we'll assume math tags are MathML unless specially marked
  -- otherwise...
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inCase forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Eq a => a -> a -> Bool
== Text
mathMLNamespace) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"xmlns" [Attribute Text]
attr))
  [Tag Text]
contents <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"math"))
  case Text -> Either Text Text
mathMLToTeXMath (forall str. StringLike str => [Tag str] -> str
renderTags forall a b. (a -> b) -> a -> b
$
          [Tag Text
open] forall a. Semigroup a => a -> a -> a
<> [Tag Text]
contents forall a. Semigroup a => a -> a -> a
<> [forall str. str -> Tag str
TagClose Text
"math"]) of
       Left Text
_   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"math"],[Attribute Text]
attr) forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.text forall a b. (a -> b) -> a -> b
$
                             forall str. StringLike str => [Tag str] -> str
innerText [Tag Text]
contents
       Right Text
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
       Right Text
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"display" [Attribute Text]
attr of
                                 Just Text
"block" -> Text -> Inlines
B.displayMath Text
x
                                 Maybe Text
_            -> Text -> Inlines
B.math Text
x

pInlinesInTags :: PandocMonad m => Text -> (Inlines -> Inlines)
               -> TagParser m Inlines
pInlinesInTags :: forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
tagtype Inlines -> Inlines
f = (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tagtype forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline

pTagText :: PandocMonad m => TagParser m Inlines
pTagText :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  (TagText Text
str) <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall str. Tag str -> Bool
isTagText
  HTMLState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  HTMLLocal
qu <- forall r (m :: * -> *). MonadReader r m => m r
ask
  Either ParseError [Inlines]
parsed <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
            forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HTMLLocal
qu forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents) HTMLState
st String
"text"
               ([(SourcePos, Text)] -> Sources
Sources [(SourcePos
pos, Text
str)])
  case Either ParseError [Inlines]
parsed of
       Left ParseError
_        -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError forall a b. (a -> b) -> a -> b
$
                        Text
"Could not parse `" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"'"
       Right [Inlines]
result  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Inlines]
result

type InlinesParser m = HTMLParser m Sources

pTagContents :: PandocMonad m => InlinesParser m Inlines
pTagContents :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents =
      Text -> Inlines
B.displayMath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
mathDisplay
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Inlines
B.math        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
mathInline
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pStr
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSpace
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall st (m :: * -> *) s.
(HasReaderOptions st, HasLastStrPosition st, HasQuoteContext st m,
 Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
smartPunctuation forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pRawTeX
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSymbol
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pBad

pRawTeX :: PandocMonad m => InlinesParser m Inlines
pRawTeX :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pRawTeX = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\'
    forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string) [String
"begin", String
"eqref", String
"ref"]
  forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_raw_tex
  Sources
inp <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  HTMLState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Either ParseError (Attribute Text)
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (forall (m :: * -> *) st a.
Monad m =>
ParsecT Sources st m a -> ParsecT Sources st m (a, Text)
withRaw forall (m :: * -> *) s.
(PandocMonad m, HasMacros s, HasReaderOptions s) =>
ParsecT Sources s m Text
rawLaTeXInline) HTMLState
st String
"chunk" Sources
inp
  case Either ParseError (Attribute Text)
res of
       Left ParseError
_                -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Right (Text
contents, Text
raw) -> do
         String
_ <- forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count (Text -> Int
T.length Text
raw) forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"tex" Text
contents

pStr :: PandocMonad m => InlinesParser m Inlines
pStr :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pStr = do
  String
result <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \Char
c ->
                     Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpecial Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isBad Char
c)
  forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParsecT s st m ()
updateLastStrPos
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
result

isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial Char
'"'     = Bool
True
isSpecial Char
'\''    = Bool
True
isSpecial Char
'.'     = Bool
True
isSpecial Char
'-'     = Bool
True
isSpecial Char
'$'     = Bool
True
isSpecial Char
'\\'    = Bool
True
isSpecial Char
'\8216' = Bool
True
isSpecial Char
'\8217' = Bool
True
isSpecial Char
'\8220' = Bool
True
isSpecial Char
'\8221' = Bool
True
isSpecial Char
_       = Bool
False

pSymbol :: PandocMonad m => InlinesParser m Inlines
pSymbol :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSymbol = Text -> Inlines
B.str forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpecial

isBad :: Char -> Bool
isBad :: Char -> Bool
isBad Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\128' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\159' -- not allowed in HTML

pBad :: PandocMonad m => InlinesParser m Inlines
pBad :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pBad = do
  Char
c <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isBad
  let c' :: Char
c' = case Char
c of
                Char
'\128' -> Char
'\8364'
                Char
'\130' -> Char
'\8218'
                Char
'\131' -> Char
'\402'
                Char
'\132' -> Char
'\8222'
                Char
'\133' -> Char
'\8230'
                Char
'\134' -> Char
'\8224'
                Char
'\135' -> Char
'\8225'
                Char
'\136' -> Char
'\710'
                Char
'\137' -> Char
'\8240'
                Char
'\138' -> Char
'\352'
                Char
'\139' -> Char
'\8249'
                Char
'\140' -> Char
'\338'
                Char
'\142' -> Char
'\381'
                Char
'\145' -> Char
'\8216'
                Char
'\146' -> Char
'\8217'
                Char
'\147' -> Char
'\8220'
                Char
'\148' -> Char
'\8221'
                Char
'\149' -> Char
'\8226'
                Char
'\150' -> Char
'\8211'
                Char
'\151' -> Char
'\8212'
                Char
'\152' -> Char
'\732'
                Char
'\153' -> Char
'\8482'
                Char
'\154' -> Char
'\353'
                Char
'\155' -> Char
'\8250'
                Char
'\156' -> Char
'\339'
                Char
'\158' -> Char
'\382'
                Char
'\159' -> Char
'\376'
                Char
_      -> Char
'?'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c'

pSpace :: PandocMonad m => InlinesParser m Inlines
pSpace :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSpace = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
xs ->
            if Char
'\n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
xs
               then forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.softbreak
               else forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.space

getTagName :: Tag Text -> Maybe Text
getTagName :: Tag Text -> Maybe Text
getTagName (TagOpen Text
t [Attribute Text]
_) = forall a. a -> Maybe a
Just Text
t
getTagName (TagClose Text
t)  = forall a. a -> Maybe a
Just Text
t
getTagName Tag Text
_             = forall a. Maybe a
Nothing

isInlineTag :: Tag Text -> Bool
isInlineTag :: Tag Text -> Bool
isInlineTag Tag Text
t = Tag Text -> Bool
isCommentTag Tag Text
t Bool -> Bool -> Bool
|| case Tag Text
t of
  TagOpen Text
"script" [Attribute Text]
_ -> Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"type" Tag Text
t
  TagClose Text
"script"  -> Bool
True
  TagOpen Text
name [Attribute Text]
_     -> Text -> Bool
isInlineTagName Text
name
  TagClose Text
name      -> Text -> Bool
isInlineTagName Text
name
  Tag Text
_                  -> Bool
False
 where isInlineTagName :: Text -> Bool
isInlineTagName Text
x =
         Text
x forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
blockTags Bool -> Bool -> Bool
||
         Int -> Text -> Text
T.take Int
1 Text
x forall a. Eq a => a -> a -> Bool
== Text
"?" -- processing instr.

isBlockTag :: Tag Text -> Bool
isBlockTag :: Tag Text -> Bool
isBlockTag Tag Text
t = Bool
isBlockTagName Bool -> Bool -> Bool
|| forall str. Tag str -> Bool
isTagComment Tag Text
t
                 where isBlockTagName :: Bool
isBlockTagName =
                         case Tag Text -> Maybe Text
getTagName Tag Text
t of
                              Just Text
x
                                | Text
"?" Text -> Text -> Bool
`T.isPrefixOf` Text
x -> Bool
True
                                | Text
"!" Text -> Text -> Bool
`T.isPrefixOf` Text
x -> Bool
True
                                | Bool
otherwise -> Text
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockTags
                                    Bool -> Bool -> Bool
|| Text
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
eitherBlockOrInline
                              Maybe Text
Nothing -> Bool
False

isTextTag :: Tag Text -> Bool
isTextTag :: Tag Text -> Bool
isTextTag = forall str. (str -> Bool) -> Tag str -> Bool
tagText (forall a b. a -> b -> a
const Bool
True)

isCommentTag :: Tag Text -> Bool
isCommentTag :: Tag Text -> Bool
isCommentTag = forall str. (str -> Bool) -> Tag str -> Bool
tagComment (forall a b. a -> b -> a
const Bool
True)

--- parsers for use in markdown, textile readers

-- | Matches a stretch of HTML in balanced tags.
htmlInBalanced :: Monad m
               => (Tag Text -> Bool)
               -> ParsecT Sources st m Text
htmlInBalanced :: forall (m :: * -> *) st.
Monad m =>
(Tag Text -> Bool) -> ParsecT Sources st m Text
htmlInBalanced Tag Text -> Bool
f = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
  Sources
sources <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  let ts :: [Tag Text]
ts = forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags
        forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions forall str. StringLike str => ParseOptions str
parseOptions{ optTagWarning :: Bool
optTagWarning = Bool
True,
                                         optTagPosition :: Bool
optTagPosition = Bool
True }
        forall a b. (a -> b) -> a -> b
$ Sources -> Text
sourcesToText Sources
sources
  case [Tag Text]
ts of
    (TagPosition Int
sr Int
sc : t :: Tag Text
t@(TagOpen Text
tn [Attribute Text]
_) : [Tag Text]
rest) -> do
       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Tag Text -> Bool
f Tag Text
t
       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Bool
hasTagWarning (Tag Text
t forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
1 [Tag Text]
rest)
       case Text -> [Tag Text] -> [Tag Text]
htmlInBalanced' Text
tn (Tag Text
tforall a. a -> [a] -> [a]
:[Tag Text]
rest) of
            []  -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
            [Tag Text]
xs  -> case forall a. [a] -> [a]
reverse [Tag Text]
xs of
                        (TagClose Text
_ : TagPosition Int
er Int
ec : [Tag Text]
_) -> do
                          let ls :: Int
ls = Int
er forall a. Num a => a -> a -> a
- Int
sr
                          let cs :: Int
cs = Int
ec forall a. Num a => a -> a -> a
- Int
sc
                          Text
lscontents <- [Text] -> Text
T.unlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
ls forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine
                          String
cscontents <- forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
cs forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
                          String
closetag <- do
                            String
x <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/=Char
'>'))
                            forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>'
                            forall (m :: * -> *) a. Monad m => a -> m a
return (String
x forall a. Semigroup a => a -> a -> a
<> String
">")
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
lscontents forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cscontents forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
closetag
                        [Tag Text]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
    [Tag Text]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

htmlInBalanced' :: Text
                -> [Tag Text]
                -> [Tag Text]
htmlInBalanced' :: Text -> [Tag Text] -> [Tag Text]
htmlInBalanced' Text
tagname [Tag Text]
ts = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ Int -> [Tag Text] -> Maybe [Tag Text]
go Int
0 [Tag Text]
ts
  where go :: Int -> [Tag Text] -> Maybe [Tag Text]
        go :: Int -> [Tag Text] -> Maybe [Tag Text]
go Int
n (t :: Tag Text
t@(TagOpen Text
tn' [Attribute Text]
_):[Tag Text]
rest) | Text
tn' forall a. Eq a => a -> a -> Bool
== Text
tagname =
              (Tag Text
t forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Tag Text] -> Maybe [Tag Text]
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) [Tag Text]
rest
        go Int
1 (t :: Tag Text
t@(TagClose Text
tn'):[Tag Text]
_) | Text
tn' forall a. Eq a => a -> a -> Bool
== Text
tagname =
              forall (m :: * -> *) a. Monad m => a -> m a
return [Tag Text
t]
        go Int
n (t :: Tag Text
t@(TagClose Text
tn'):[Tag Text]
rest)  | Text
tn' forall a. Eq a => a -> a -> Bool
== Text
tagname =
              (Tag Text
t forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Tag Text] -> Maybe [Tag Text]
go (Int
n forall a. Num a => a -> a -> a
- Int
1) [Tag Text]
rest
        go Int
n (Tag Text
t:[Tag Text]
ts') = (Tag Text
t forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Tag Text] -> Maybe [Tag Text]
go Int
n [Tag Text]
ts'
        go Int
_ [] = forall (m :: * -> *) a. MonadPlus m => m a
mzero

hasTagWarning :: [Tag Text] -> Bool
hasTagWarning :: [Tag Text] -> Bool
hasTagWarning (TagWarning Text
_:[Tag Text]
_) = Bool
True
hasTagWarning [Tag Text]
_                = Bool
False

-- | Matches a tag meeting a certain condition.
htmlTag :: (HasReaderOptions st, Monad m)
        => (Tag Text -> Bool)
        -> ParsecT Sources st m (Tag Text, Text)
htmlTag :: forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParsecT Sources st m (Tag Text, Text)
htmlTag Tag Text -> Bool
f = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
  SourcePos
startpos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Sources
sources <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  let inp :: Text
inp = Sources -> Text
sourcesToText Sources
sources
  let ts :: [Tag Text]
ts = forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions
                               forall str. StringLike str => ParseOptions str
parseOptions{ optTagWarning :: Bool
optTagWarning = Bool
False
                                           , optTagPosition :: Bool
optTagPosition = Bool
True }
                               (Text
inp forall a. Semigroup a => a -> a -> a
<> Text
" ")
                               -- add space to ensure that
                               -- we get a TagPosition after the tag
  (Tag Text
next, Int
ln, Int
col) <- case [Tag Text]
ts of
                      (TagPosition{} : Tag Text
next : TagPosition Int
ln Int
col : [Tag Text]
_)
                        | Tag Text -> Bool
f Tag Text
next -> forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, Int
ln, Int
col)
                      [Tag Text]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

  -- <www.boe.es/buscar/act.php?id=BOE-A-1996-8930#a66>
  -- should NOT be parsed as an HTML tag, see #2277,
  -- so we exclude . even though it's a valid character
  -- in XML element names
  let isNameChar :: Char -> Bool
isNameChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
  let isName :: Text -> Bool
isName Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
                   Maybe (Char, Text)
Nothing      -> Bool
False
                   Just (Char
c, Text
cs) -> Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isNameChar Text
cs
  let isPI :: Text -> Bool
isPI Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
                 Just (Char
'?', Text
_) -> Bool
True -- processing instruction
                 Maybe (Char, Text)
_             -> Bool
False
  let endpos :: SourcePos
endpos = if Int
ln forall a. Eq a => a -> a -> Bool
== Int
1
                  then SourcePos -> Int -> SourcePos
setSourceColumn SourcePos
startpos
                         (SourcePos -> Int
sourceColumn SourcePos
startpos forall a. Num a => a -> a -> a
+ (Int
col forall a. Num a => a -> a -> a
- Int
1))
                  else SourcePos -> Int -> SourcePos
setSourceColumn (SourcePos -> Int -> SourcePos
setSourceLine SourcePos
startpos
                                        (SourcePos -> Int
sourceLine SourcePos
startpos forall a. Num a => a -> a -> a
+ (Int
ln forall a. Num a => a -> a -> a
- Int
1)))
                         Int
col
  let endAngle :: ParsecT Sources u m ()
endAngle = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$
        do forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>'
           SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
           forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SourcePos
pos forall a. Ord a => a -> a -> Bool
>= SourcePos
endpos

  let handleTag :: Text -> ParsecT Sources u m (Tag Text, Text)
handleTag Text
tagname = do
       -- basic sanity check, since the parser is very forgiving
       -- and finds tags in stuff like x<y)
       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text -> Bool
isName Text
tagname Bool -> Bool -> Bool
|| Text -> Bool
isPI Text
tagname
       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
tagname
       -- <https://example.org> should NOT be a tag either.
       -- tagsoup will parse it as TagOpen "https:" [("example.org","")]
       forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text -> Char
T.last Text
tagname forall a. Eq a => a -> a -> Bool
/= Char
':'
       forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<'
       String
rendered <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar forall {u}. ParsecT Sources u m ()
endAngle
       forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"<" forall a. [a] -> [a] -> [a]
++ String
rendered forall a. [a] -> [a] -> [a]
++ String
">")
  case Tag Text
next of
       TagComment Text
s
         | Text
"<!--" Text -> Text -> Bool
`T.isPrefixOf` Text
inp -> do
          forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"<!--"
          forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count (Text -> Int
T.length Text
s) forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
          forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"-->"
          Bool
stripComments <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Bool
readerStripComments
          if Bool
stripComments
             then forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, Text
"")
             else forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, Text
"<!--" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"-->")
         | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"bogus comment mode, HTML5 parse error"
       TagOpen Text
tagname [Attribute Text]
attr -> do
         forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text -> Bool
isPI Text
tagname Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
isName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [Attribute Text]
attr
         forall {u}. Text -> ParsecT Sources u m (Tag Text, Text)
handleTag Text
tagname
       TagClose Text
tagname ->
         forall {u}. Text -> ParsecT Sources u m (Tag Text, Text)
handleTag Text
tagname
       Tag Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- Utilities

-- | Adjusts a url according to the document's base URL.
canonicalizeUrl :: PandocMonad m => Text -> TagParser m Text
canonicalizeUrl :: forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl Text
url = do
  Maybe URI
mbBaseHref <- HTMLState -> Maybe URI
baseHref forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (String -> Maybe URI
parseURIReference (Text -> String
T.unpack Text
url), Maybe URI
mbBaseHref) of
                (Just URI
rel, Just URI
bs) -> forall a. Show a => a -> Text
tshow (URI
rel URI -> URI -> URI
`nonStrictRelativeTo` URI
bs)
                (Maybe URI, Maybe URI)
_                   -> Text
url