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

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

Conversion of 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.ByteString.Base64 (encode)
import Data.Char (isAlphaNum, isLetter)
import Data.Default (Default (..), def)
import Data.Foldable (for_)
import Data.List.Split (splitWhen)
import qualified Data.List as L
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 ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> [Tag Text]
forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall a b. (a -> b) -> a -> b
$
             ParseOptions Text -> Text -> [Tag Text]
forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions ParseOptions Text
forall str. StringLike str => ParseOptions str
parseOptions{ optTagPosition = True }
             (Sources -> Text
sourcesToText (Sources -> Text) -> Sources -> Text
forall a b. (a -> b) -> a -> b
$ a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp)
      parseDoc :: ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
parseDoc = do
        blocks <- Bool -> Many Block -> Many Block
fixPlains Bool
False (Many Block -> Many Block)
-> ([Many Block] -> Many Block) -> [Many Block] -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Block] -> Many Block
forall a. Monoid a => [a] -> a
mconcat ([Many Block] -> Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Block]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Block]
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) (Many Block)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
block ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
        meta <- stateMeta . parserState <$> getState
        bs' <- replaceNotes (B.toList blocks)
        reportLogMessages
        return $ Pandoc meta $ extractMain bs'
      getError :: ParseError -> String
getError (ParseError -> [Message]
errorMessages -> [Message]
ms) = case [Message]
ms of
                                         []    -> String
""
                                         (Message
m:[Message]
_) -> Message -> String
messageString Message
m
  result <- (ReaderT HTMLLocal m (Either ParseError Pandoc)
 -> HTMLLocal -> m (Either ParseError Pandoc))
-> HTMLLocal
-> ReaderT HTMLLocal m (Either ParseError Pandoc)
-> m (Either ParseError Pandoc)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT HTMLLocal m (Either ParseError Pandoc)
-> HTMLLocal -> m (Either ParseError Pandoc)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HTMLLocal
forall a. Default a => a
def (ReaderT HTMLLocal m (Either ParseError Pandoc)
 -> m (Either ParseError Pandoc))
-> ReaderT HTMLLocal m (Either ParseError Pandoc)
-> m (Either ParseError Pandoc)
forall a b. (a -> b) -> a -> b
$
       ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
-> HTMLState
-> String
-> [Tag Text]
-> ReaderT HTMLLocal m (Either ParseError Pandoc)
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, Many Block)]
-> Maybe URI
-> Set Text
-> [LogMessage]
-> Map Text Macro
-> ReaderOptions
-> Bool
-> HTMLState
HTMLState ParserState
forall a. Default a => a
def{ stateOptions = opts }
         [] Maybe URI
forall a. Maybe a
Nothing Set Text
forall a. Set a
Set.empty [] Map Text Macro
forall k a. Map k a
M.empty ReaderOptions
opts Bool
False)
       String
"source" [Tag Text]
tags
  case result of
    Right Pandoc
doc -> Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
doc
    Left  ParseError
err -> PandocError -> m Pandoc
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
getError ParseError
err

-- Extract contents of main element if exactly one is present; otherwise
-- return all blocks.
extractMain :: [Block] -> [Block]
extractMain :: [Block] -> [Block]
extractMain [Block]
bs =
  case (Block -> [Block]) -> [Block] -> [Block]
forall c. Monoid c => (Block -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Block]
getMain [Block]
bs of
    [] -> [Block]
bs
    [Div (Text
"",[],[(Text, Text)]
_) [Block]
bs'] -> [Block]
bs'
    [Block]
bs' -> [Block]
bs'
 where
   getMain :: Block -> [Block]
   getMain :: Block -> [Block]
getMain b :: Block
b@(Div (Text
_,[Text]
_,[(Text, Text)]
kvs) [Block]
_)
     | Just Text
"main" <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"role" [(Text, Text)]
kvs = [Block
b]
   getMain Block
_ = []

-- Strip namespace prefixes on tags (not attributes)
stripPrefixes :: [Tag Text] -> [Tag Text]
stripPrefixes :: [Tag Text] -> [Tag Text]
stripPrefixes = (Tag Text -> Tag Text) -> [Tag Text] -> [Tag Text]
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 [(Text, Text)]
as) = Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':') Text
s) [(Text, Text)]
as
stripPrefix (TagClose Text
s)   = Text -> Tag Text
forall str. str -> Tag str
TagClose ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (Char -> Char -> Bool
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
  notes <- HTMLState -> [(Text, Many Block)]
noteTable (HTMLState -> [(Text, Many Block)])
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Text, Many Block)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  walkM (replaceNotes' notes) bs

replaceNotes' :: PandocMonad m
              => [(Text, Blocks)] -> Inline -> TagParser m Inline
replaceNotes' :: forall (m :: * -> *).
PandocMonad m =>
[(Text, Many Block)] -> Inline -> TagParser m Inline
replaceNotes' [(Text, Many Block)]
noteTbl (RawInline (Format Text
"noteref") Text
ref) =
  TagParser m Inline
-> (Many Block -> TagParser m Inline)
-> Maybe (Many Block)
-> TagParser m Inline
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TagParser m Inline
warnNotFound (Inline -> TagParser m Inline
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> TagParser m Inline)
-> (Many Block -> Inline) -> Many Block -> TagParser m Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inline
Note ([Block] -> Inline)
-> (Many Block -> [Block]) -> Many Block -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Block -> [Block]
forall a. Many a -> [a]
B.toList) (Maybe (Many Block) -> TagParser m Inline)
-> Maybe (Many Block) -> TagParser m Inline
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Many Block)] -> Maybe (Many Block)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ref [(Text, Many Block)]
noteTbl
 where
  warnNotFound :: TagParser m Inline
warnNotFound = do
    pos <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    logMessage $ ReferenceNotFound ref pos
    pure (Note [])
replaceNotes' [(Text, Many Block)]
_ Inline
x = Inline -> TagParser m Inline
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
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 = (HTMLLocal -> HTMLLocal)
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
forall a.
(HTMLLocal -> HTMLLocal)
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\HTMLLocal
s -> HTMLLocal
s {inChapter = 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 = (HTMLLocal -> HTMLLocal)
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
forall a.
(HTMLLocal -> HTMLLocal)
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\HTMLLocal
s -> HTMLLocal
s {inPlain = True})

-- Some items should be handled differently when in a list item tag, e.g. checkbox
setInListItem :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a
setInListItem :: forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInListItem = (HTMLLocal -> HTMLLocal)
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
forall a.
(HTMLLocal -> HTMLLocal)
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\HTMLLocal
s -> HTMLLocal
s {inListItem = True})

pHtml :: PandocMonad m => TagParser m Blocks
pHtml :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pHtml = do
  (TagOpen "html" attr) <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
  for_ (lookup "lang" attr <|> lookup "xml:lang" attr) $
    updateState . B.setMeta "lang" . B.text
  pInTags "html" block

pBody :: PandocMonad m => TagParser m Blocks
pBody :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pBody = do
  (TagOpen "body" attr) <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
  for_ (lookup "lang" attr <|> lookup "xml:lang" attr) $
    updateState . B.setMeta "lang" . B.text
  pInTags "body" block

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

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

namespaces :: PandocMonad m => [(Text, TagParser m Inlines)]
namespaces :: forall (m :: * -> *).
PandocMonad m =>
[(Text, TagParser m (Many Inline))]
namespaces = [(Text
mathMLNamespace, Bool -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Bool -> TagParser m (Many Inline)
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) =>
(Many Inline -> a) -> TagParser m a -> TagParser m a
eSwitch Many Inline -> a
constructor TagParser m a
parser = TagParser m a -> TagParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m a -> TagParser m a) -> TagParser m a -> TagParser m a
forall a b. (a -> b) -> a -> b
$ do
  Extension -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
  (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"switch" [])
  cases <- First (Many Inline) -> Maybe (Many Inline)
forall a. First a -> Maybe a
getFirst (First (Many Inline) -> Maybe (Many Inline))
-> ([First (Many Inline)] -> First (Many Inline))
-> [First (Many Inline)]
-> Maybe (Many Inline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [First (Many Inline)] -> First (Many Inline)
forall a. Monoid a => [a] -> a
mconcat ([First (Many Inline)] -> Maybe (Many Inline))
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [First (Many Inline)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe (Many Inline))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (First (Many Inline))
-> TagParser m (Tag Text)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [First (Many Inline)]
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 (Maybe (Many Inline) -> First (Many Inline)
forall a. Maybe a -> First a
First (Maybe (Many Inline) -> First (Many Inline))
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe (Many Inline))
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (First (Many Inline))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe (Many Inline))
forall (m :: * -> *).
PandocMonad m =>
TagParser m (Maybe (Many Inline))
eCase ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe (Many Inline))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe (Many Inline))
forall a b.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank) )
              (TagParser m (Tag Text) -> TagParser m (Tag Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (TagParser m (Tag Text) -> TagParser m (Tag Text))
-> TagParser m (Tag Text) -> TagParser m (Tag Text)
forall a b. (a -> b) -> a -> b
$ TagParser m (Tag Text) -> TagParser m (Tag Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m (Tag Text) -> TagParser m (Tag Text))
-> TagParser m (Tag Text) -> TagParser m (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"default" []))
  skipMany pBlank
  fallback <- pInTags "default" (skipMany pBlank *> parser <* skipMany pBlank)
  skipMany pBlank
  pSatisfy (matchTagClose "switch")
  return $ maybe fallback constructor cases

eCase :: PandocMonad m => TagParser m (Maybe Inlines)
eCase :: forall (m :: * -> *).
PandocMonad m =>
TagParser m (Maybe (Many Inline))
eCase = do
  ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
  TagOpen _ attr' <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"case" [])
  let attr = [(Text, Text)] -> [(Text, Text)]
toStringAttr [(Text, Text)]
attr'
  case flip lookup namespaces =<< lookup "required-namespace" attr of
    Just TagParser m (Many Inline)
p -> Many Inline -> Maybe (Many Inline)
forall a. a -> Maybe a
Just (Many Inline -> Maybe (Many Inline))
-> TagParser m (Many Inline)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe (Many Inline))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> TagParser m (Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"case" (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m (Many Inline) -> TagParser m (Many Inline)
forall a b.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TagParser m (Many Inline)
p TagParser m (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m (Many Inline)
forall a b.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank)
    Maybe (TagParser m (Many Inline))
Nothing -> Maybe (Many Inline)
forall a. Maybe a
Nothing Maybe (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Tag Text]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe (Many Inline))
forall a b.
a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [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 ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny ((Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
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
  inNotes <- HTMLState -> Bool
inFootnotes (HTMLState -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  TagOpen tag attr' <- lookAhead $ pSatisfy
    (\case
       TagOpen Text
_ [(Text, Text)]
attr'
         -> case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [(Text, Text)]
attr' Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [(Text, Text)]
attr' of
              Just Text
"footnote" -> Bool
True
              Just Text
"rearnote" -> Bool
True
              Maybe Text
_ -> Bool
inNotes
       Tag Text
_ -> Bool
False)
  let attr = [(Text, Text)] -> [(Text, Text)]
toStringAttr [(Text, Text)]
attr'
  let ident = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
attr)
  content <- pInTags tag block
  updateState $ \HTMLState
s ->
    HTMLState
s {noteTable = (ident, content) : noteTable s}

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

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

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

pBulletList :: PandocMonad m => TagParser m Blocks
pBulletList :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pBulletList = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ do
  (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"ul" [])
  -- 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...
  ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
  orphans <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Block]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (do TagParser m (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"li" []))
                      TagParser m (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
forall str. Tag str -> Bool
isTagClose)
                      ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
block) -- e.g. <ul>, see #9187
  items <- manyTill pListItem (pCloses "ul")
  let items' = case [Many Block]
orphans of
                 [] -> [Many Block]
items
                 [Many Block]
xs -> [Many Block] -> Many Block
forall a. Monoid a => [a] -> a
mconcat [Many Block]
xs Many Block -> [Many Block] -> [Many Block]
forall a. a -> [a] -> [a]
: [Many Block]
items
  return $ B.bulletList $ map (fixPlains True) items'

pListItem :: PandocMonad m => TagParser m Blocks
pListItem :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pListItem = HTMLParser m [Tag Text] (Many Block)
-> HTMLParser m [Tag Text] (Many Block)
forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInListItem (HTMLParser m [Tag Text] (Many Block)
 -> HTMLParser m [Tag Text] (Many Block))
-> HTMLParser m [Tag Text] (Many Block)
-> HTMLParser m [Tag Text] (Many Block)
forall a b. (a -> b) -> a -> b
$ do
  TagOpen _ attr' <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"li" [])
  let attr = [(Text, Text)] -> [(Text, Text)]
toStringAttr [(Text, Text)]
attr'
  let addId Text
ident Many Block
bs = case Many Block -> [Block]
forall a. Many a -> [a]
B.toList Many Block
bs of
                           (Plain [Inline]
ils:[Block]
xs) -> [Block] -> Many Block
forall a. [a] -> Many a
B.fromList ([Inline] -> Block
Plain
                                [(Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
ident, [], []) [Inline]
ils] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs)
                           [Block]
_ -> (Text, [Text], [(Text, Text)]) -> Many Block -> Many Block
B.divWith (Text
ident, [], []) Many Block
bs
  item <- pInTags "li" block
  skipMany pBlank
  orphans <- many (do notFollowedBy (pSatisfy (matchTagOpen "li" []))
                      notFollowedBy (pSatisfy isTagClose)
                      block) -- e.g. <ul>, see #9187
  skipMany pBlank
  return $ maybe id addId (lookup "id" attr) $ item <> mconcat orphans

pCheckbox :: PandocMonad m => TagParser m Inlines
pCheckbox :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
pCheckbox = do
  TagOpen _ attr' <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool) -> TagParser m (Tag Text))
-> (Tag Text -> Bool) -> TagParser m (Tag Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"input" [(Text
"type",Text
"checkbox")]
  TagClose _ <- pSatisfy (matchTagClose "input")
  let attr = [(Text, Text)] -> [(Text, Text)]
toStringAttr [(Text, Text)]
attr'
  let isChecked = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"checked" [(Text, Text)]
attr
  let escapeSequence = Text -> Many Inline
B.str (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ if Bool
isChecked then Text
"\9746" else Text
"\9744"
  return $ escapeSequence <> B.space


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

  -- 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...
  skipMany pBlank
  orphans <- many (do notFollowedBy (pSatisfy (matchTagOpen "li" []))
                      notFollowedBy (pSatisfy isTagClose)
                      block) -- e.g. <ul>, see #9187
  if isNoteList
     then do
       _ <- manyTill (eFootnote <|> pBlank) (pCloses "ol")
       return mempty
     else do
       items <- manyTill pListItem (pCloses "ol")
       let items' = case [Many Block]
orphans of
                      [] -> [Many Block]
items
                      [Many Block]
xs -> [Many Block] -> Many Block
forall a. Monoid a => [a] -> a
mconcat [Many Block]
xs Many Block -> [Many Block] -> [Many Block]
forall a. a -> [a] -> [a]
: [Many Block]
items
       return $ B.orderedListWith (start, style, DefaultDelim) $
                map (fixPlains True) items'

pDefinitionList :: PandocMonad m => TagParser m Blocks
pDefinitionList :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pDefinitionList = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ do
  (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"dl" [])
  items <- ParsecT
  [Tag Text]
  HTMLState
  (ReaderT HTMLLocal m)
  (Many Inline, [Many Block])
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     [(Many Inline, [Many Block])]
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)
  (Many Inline, [Many Block])
forall (m :: * -> *).
PandocMonad m =>
TagParser m (Many Inline, [Many Block])
pDefListItem (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"dl")
  return $ B.definitionList items

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

fixPlains :: Bool -> Blocks -> Blocks
fixPlains :: Bool -> Many Block -> Many Block
fixPlains Bool
inList Many Block
bs = if (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isParaish [Block]
bs'
                         then [Block] -> Many Block
forall a. [a] -> Many a
B.fromList ([Block] -> Many Block) -> [Block] -> Many Block
forall a b. (a -> b) -> a -> b
$ (Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bs'
                         else Many Block
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' = Many Block -> [Block]
forall a. Many a -> [a]
B.toList Many Block
bs

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

pLineBlock :: PandocMonad m => TagParser m Blocks
pLineBlock :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pLineBlock = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ do
  Extension -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_line_blocks
  _ <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool) -> TagParser m (Tag Text))
-> (Tag Text -> Bool) -> TagParser m (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"div") ([(Text, Text)] -> [(Text, Text)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(Text
"class",Text
"line-block")])
  ils <- trimInlines . mconcat <$> manyTill inline (pSatisfy (tagClose (=="div")))
  let lns = ([Inline] -> Many Inline) -> [[Inline]] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList ([[Inline]] -> [Many Inline]) -> [[Inline]] -> [Many Inline]
forall a b. (a -> b) -> a -> b
$
            (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
LineBreak) ([Inline] -> [[Inline]]) -> [Inline] -> [[Inline]]
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
filter (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
/= Inline
SoftBreak) ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$
            Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList Many Inline
ils
  return $ B.lineBlock 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 (Many Block)
pDiv = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ do
  Extension -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_native_divs
  TagOpen tag attr' <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
-> (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
isDivLike (Bool -> [(Text, Text)] -> Bool
forall a b. a -> b -> a
const Bool
True)
  let (ident, classes, kvs) = toAttr attr'
  contents <- pInTags tag block
  let contents' = case Many Block -> Seq Block
forall a. Many a -> Seq a
B.unMany Many Block
contents of
                    Header Int
lev (Text
hident,[Text]
hclasses,[(Text, Text)]
hkvs) [Inline]
ils Seq.:<| Seq Block
rest
                        | Text
hident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ident ->
                          Seq Block -> Many Block
forall a. Seq a -> Many a
B.Many (Seq Block -> Many Block) -> Seq Block -> Many Block
forall a b. (a -> b) -> a -> b
$ Int -> (Text, [Text], [(Text, Text)]) -> [Inline] -> Block
Header Int
lev (Text
"",[Text]
hclasses,[(Text, Text)]
hkvs) [Inline]
ils Block -> Seq Block -> Seq Block
forall a. a -> Seq a -> Seq a
Seq.<| Seq Block
rest
                    Seq Block
_ -> Many Block
contents
  let classes' = if Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"section"
                    then Text
"section"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
classes
                    else [Text]
classes
      kvs' = if Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"main" Bool -> Bool -> Bool
&& Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"role" [(Text, Text)]
kvs)
               then (Text
"role", Text
"main")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs
               else [(Text, Text)]
kvs
  return $ B.divWith (ident, classes', kvs') contents'

pIframe :: PandocMonad m => TagParser m Blocks
pIframe :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pIframe = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ do
  Extension -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardDisabled Extension
Ext_raw_html
  tag <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"iframe") (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> ([(Text, Text)] -> Maybe Text) -> [(Text, Text)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src"))
  skipMany pBlank
  pCloses "iframe" <|> eof
  url <- canonicalizeUrl $ fromAttrib "src" tag
  if T.null url
     then ignore $ renderTags' [tag, TagClose "iframe"]
     else catchError
       (do (bs, mbMime) <- openURL url
           case 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
                    opts <- HTMLState -> ReaderOptions
readerOpts (HTMLState -> ReaderOptions)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ReaderOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                    Pandoc _ contents <- readHtml opts inp
                    return $ B.divWith ("",["iframe"],[]) $ B.fromList contents
               | Text
"image/" Text -> Text -> Bool
`T.isPrefixOf` Text
mt -> do
                    Many Block
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> Many Block
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Many Block -> Many Block
B.divWith (Text
"",[Text
"iframe"],[]) (Many Block -> Many Block) -> Many Block -> Many Block
forall a b. (a -> b) -> a -> b
$
                      Many Inline -> Many Block
B.plain (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
B.image Text
url Text
"" Many Inline
forall a. Monoid a => a
mempty
             Maybe Text
_ -> Many Block
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> Many Block
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Many Block -> Many Block
B.divWith (Text
"",[Text
"iframe"],[(Text
"src", Text
url)]) Many Block
forall a. Monoid a => a
mempty)
       (\PandocError
e -> do
         LogMessage -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage (LogMessage
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ())
-> LogMessage
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
url (PandocError -> Text
renderError PandocError
e)
         Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore (Text
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag, Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"iframe"])

pRawHtmlBlock :: PandocMonad m => TagParser m Blocks
pRawHtmlBlock :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pRawHtmlBlock = do
  raw <- Text -> TagParser m Text
forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"script" TagParser m Text -> TagParser m Text -> TagParser m Text
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> TagParser m Text
forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"style" TagParser m Text -> TagParser m Text -> TagParser m Text
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> TagParser m Text
forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"textarea"
          TagParser m Text -> TagParser m Text -> TagParser m Text
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TagParser m Text
forall (m :: * -> *). PandocMonad m => TagParser m Text
pRawTag
  exts <- getOption readerExtensions
  if extensionEnabled Ext_raw_html exts && not (T.null raw)
     then return $ B.rawBlock "html" raw
     else ignore 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
  pos <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) SourcePos
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:
  unless (T.null raw) $
    logMessage $ SkippedContent raw pos
  return mempty

pHtmlBlock :: PandocMonad m => Text -> TagParser m Text
pHtmlBlock :: forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
t = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Text
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Text
forall a b. (a -> b) -> a -> b
$ do
  open <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
t [])
  contents <- manyTill pAny (pSatisfy (matchTagClose t))
  return $ renderTags' $ [open] <> contents <> [TagClose t]

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

headerLevel :: Text -> TagParser m Int
headerLevel :: forall (m :: * -> *). Text -> TagParser m Int
headerLevel Text
tagtype =
  case Text -> Maybe Int
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))
--            <|>
              Int -> TagParser m Int
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
level
        Maybe Int
Nothing -> String -> TagParser m Int
forall a.
HasCallStack =>
String -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
Prelude.fail String
"Could not retrieve header level"

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

pHeader :: PandocMonad m => TagParser m Blocks
pHeader :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pHeader = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ do
  TagOpen tagtype attr' <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool) -> TagParser m (Tag Text))
-> (Tag Text -> Bool) -> TagParser m (Tag Text)
forall a b. (a -> b) -> a -> b
$
                           (Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"h1",Text
"h2",Text
"h3",Text
"h4",Text
"h5",Text
"h6"])
                           (Bool -> [(Text, Text)] -> Bool
forall a b. a -> b -> a
const Bool
True)
  let attr = [(Text, Text)] -> [(Text, Text)]
toStringAttr [(Text, Text)]
attr'
  level <- headerLevel tagtype
  contents <- trimInlines . mconcat <$> manyTill inline (pCloses tagtype <|> eof)
  let ident = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
attr
  let classes = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [(Text, Text)]
attr
  let keyvals = [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
attr, Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"class", Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"id"]
  attr'' <- registerHeader (ident, classes, keyvals) contents
  return $ B.headerWith attr'' level contents

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

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

pPlain :: PandocMonad m => TagParser m Blocks
pPlain :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pPlain = do
  contents <- HTMLParser m [Tag Text] (Many Inline)
-> HTMLParser m [Tag Text] (Many Inline)
forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInPlain (HTMLParser m [Tag Text] (Many Inline)
 -> HTMLParser m [Tag Text] (Many Inline))
-> HTMLParser m [Tag Text] (Many Inline)
-> HTMLParser m [Tag Text] (Many Inline)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Inline]
-> HTMLParser m [Tag Text] (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HTMLParser m [Tag Text] (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Inline]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 HTMLParser m [Tag Text] (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline
  if null contents
     then return mempty
     else return $ B.plain contents

pPara :: PandocMonad m => TagParser m Blocks
pPara :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pPara = do
  contents <- Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"p" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline
  (do guardDisabled Ext_empty_paragraphs
      guard (null contents)
      return mempty)
    <|> return (B.para contents)

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

pCodeBlock :: PandocMonad m => TagParser m Blocks
pCodeBlock :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Block)
pCodeBlock = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Block)
forall a b. (a -> b) -> a -> b
$ do
  TagOpen _ attr' <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, 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 <- case attr' of
    (Text, Text)
_:[(Text, Text)]
_ -> (Text, [Text], [(Text, Text)])
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Text, [Text], [(Text, Text)])
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Text)] -> (Text, [Text], [(Text, Text)])
toAttr [(Text, Text)]
attr')
    []  -> (Text, [Text], [(Text, Text)])
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Text, [Text], [(Text, Text)])
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Text, [Text], [(Text, Text)])
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text, [Text], [(Text, Text)])
nullAttr (ParsecT
   [Tag Text]
   HTMLState
   (ReaderT HTMLLocal m)
   (Text, [Text], [(Text, Text)])
 -> ParsecT
      [Tag Text]
      HTMLState
      (ReaderT HTMLLocal m)
      (Text, [Text], [(Text, Text)]))
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Text, [Text], [(Text, Text)])
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Text, [Text], [(Text, Text)])
forall a b. (a -> b) -> a -> b
$ do
      TagOpen _ codeAttr <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"code" [])
      pure $ toAttr
        [ (k, v') | (k, v) <- codeAttr
                    -- strip language from class
                  , let v' = if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"class"
                             then Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
v (Text -> Text -> Maybe Text
T.stripPrefix Text
"language-" Text
v)
                             else Text
v ]
  contents <- manyTill pAny (pCloses "pre" <|> eof)
  let rawText = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Text) -> [Tag Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Tag Text -> Text
tagToText [Tag Text]
contents
  -- drop trailing newline if any
  let result = case Text -> Maybe (Text, Char)
T.unsnoc Text
rawText of
                    Just (Text
result'', Char
'\n') -> Text
result''
                    Maybe (Text, Char)
_                     -> Text
rawText
  return $ B.codeBlockWith attr result

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

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

pSelfClosing :: PandocMonad m
             => (Text -> Bool) -> ([Attribute Text] -> Bool)
             -> TagParser m (Tag Text)
pSelfClosing :: forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([(Text, Text)] -> Bool) -> TagParser m (Tag Text)
pSelfClosing Text -> Bool
f [(Text, Text)] -> Bool
g = do
  open <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
f [(Text, Text)] -> Bool
g)
  optional $ pSatisfy (tagClose f)
  return open

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

pEmph :: PandocMonad m => TagParser m Inlines
pEmph :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
pEmph = Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"em" Many Inline -> Many Inline
B.emph TagParser m (Many Inline)
-> TagParser m (Many Inline) -> TagParser m (Many Inline)
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"i" Many Inline -> Many Inline
B.emph

pStrong :: PandocMonad m => TagParser m Inlines
pStrong :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
pStrong = Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"strong" Many Inline -> Many Inline
B.strong TagParser m (Many Inline)
-> TagParser m (Many Inline) -> TagParser m (Many Inline)
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"b" Many Inline -> Many Inline
B.strong

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

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

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

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

pStrikeout :: PandocMonad m => TagParser m Inlines
pStrikeout :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
pStrikeout =
  Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"s" Many Inline -> Many Inline
B.strikeout TagParser m (Many Inline)
-> TagParser m (Many Inline) -> TagParser m (Many Inline)
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"strike" Many Inline -> Many Inline
B.strikeout TagParser m (Many Inline)
-> TagParser m (Many Inline) -> TagParser m (Many Inline)
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"del" Many Inline -> Many Inline
B.strikeout TagParser m (Many Inline)
-> TagParser m (Many Inline) -> TagParser m (Many Inline)
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    TagParser m (Many Inline) -> TagParser m (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"span" [(Text
"class",Text
"strikeout")])
            contents <- [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Inline]
-> TagParser m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TagParser m (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Inline]
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 TagParser m (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"span")
            return $ B.strikeout contents)

pUnderline :: PandocMonad m => TagParser m Inlines
pUnderline :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
pUnderline = Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"u" Many Inline -> Many Inline
B.underline TagParser m (Many Inline)
-> TagParser m (Many Inline) -> TagParser m (Many Inline)
forall a.
ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
"ins" Many Inline -> Many Inline
B.underline

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

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

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

pSvg :: PandocMonad m => TagParser m Inlines
pSvg :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
pSvg = do
  Extension -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
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@(TagOpen _ attr') <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [(Text, Text)] -> Tag Text -> Bool
matchTagOpen Text
"svg" [])
  let (ident,cls,_) = toAttr attr'
  contents <- many (notFollowedBy (pCloses "svg") >> pAny)
  closet <- TagClose "svg" <$ (pCloses "svg" <|> eof)
  let rawText = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' (Tag Text
opent Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Tag Text]
contents [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. [a] -> [a] -> [a]
++ [Tag Text
closet])
  let svgData = Text
"data:image/svg+xml;base64," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                   ByteString -> Text
UTF8.toText (ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText Text
rawText)
  let kvs = [(Text
"width", Text
"1em") | Text
"fa-w-14" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls Bool -> Bool -> Bool
||
                                Text
"fa-w-16" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls Bool -> Bool -> Bool
||
                                Text
"fa-fw" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls] -- #10134
  return $ B.imageWith (ident,cls,kvs) svgData mempty mempty

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

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

code :: PandocMonad m => Text -> Attr -> TagParser m Inlines
code :: forall (m :: * -> *).
PandocMonad m =>
Text -> (Text, [Text], [(Text, Text)]) -> TagParser m (Many Inline)
code Text
open (Text, [Text], [(Text, Text)])
attr = do
  result <- [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Inline]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Many Inline]
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) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
open)
  return $ formatCode attr 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 (Many Inline)
pBdo = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
 -> ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  TagOpen _ attr' <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
-> (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"bdo") (Bool -> [(Text, Text)] -> Bool
forall a b. a -> b -> a
const Bool
True)
  let attr = [(Text, Text)] -> [(Text, Text)]
toStringAttr [(Text, Text)]
attr'
  contents <- pInTags "bdo" inline
  return $ case lookup "dir" attr of
    -- Only bdo with a direction matters
    Just Text
dir -> (Text, [Text], [(Text, Text)]) -> Many Inline -> Many Inline
B.spanWith (Text
"", [], [(Text
"dir",Text -> Text
T.toLower Text
dir)]) Many Inline
contents
    Maybe Text
Nothing  -> Many Inline
contents

pSpan :: PandocMonad m => TagParser m Inlines
pSpan :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
pSpan = do
  (TagOpen _ attr') <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
-> (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"span") (Bool -> [(Text, Text)] -> Bool
forall a b. a -> b -> a
const Bool
True))
  exts <- getOption readerExtensions
  let attr = [(Text, Text)] -> (Text, [Text], [(Text, Text)])
toAttr [(Text, Text)]
attr'
  case attr of
     (Text
_,[Text]
cls,[(Text, Text)]
_) -- skip MathJaX-generated HTML; see #10673
       | Text
"mjx-chtml" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls -> Many Inline
forall a. Monoid a => a
mempty Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b.
a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline
       | Text
"MathJax_CHTML" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls -> Many Inline
forall a. Monoid a => a
mempty Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b.
a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline
       | Text
"MathJax_Preview" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls -> Many Inline
forall a. Monoid a => a
mempty Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b.
a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline
       | Text
"MJX_Assistive_MathML" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls -> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline
     (Text
_,[Text
"katex-html"],[(Text, Text)]
_) -> Many Inline
forall a. Monoid a => a
mempty Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b.
a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) b
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline
       -- skip HTML generated by KaTeX, since we get
       -- the math by parsing mathml (#9971)
     (Text, [Text], [(Text, Text)])
_ | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_native_spans Extensions
exts -> do
           contents <- Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline
           let classes = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [(Text, Text)]
attr'
           let styleAttr   = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [(Text, Text)]
attr'
           let fontVariant = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
                              [Text] -> Text -> Maybe Text
pickStyleAttrProps [Text
"font-variant"] Text
styleAttr
           let isSmallCaps = Text
fontVariant Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"small-caps" Bool -> Bool -> Bool
||
                               Text
"smallcaps" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
           let tag = if Bool
isSmallCaps then Many Inline -> Many Inline
B.smallcaps else (Text, [Text], [(Text, Text)]) -> Many Inline -> Many Inline
B.spanWith (Text, [Text], [(Text, Text)])
attr
           return $ tag contents
       | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_html Extensions
exts -> do
            tag <- (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text))
-> (Tag Text -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"span") (Bool -> [(Text, Text)] -> Bool
forall a b. a -> b -> a
const Bool
True)
            return $ B.rawInline "html" $ renderTags' [tag]
       | Bool
otherwise  -> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline -- just contents

pRawHtmlInline :: PandocMonad m => TagParser m Inlines
pRawHtmlInline :: forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
pRawHtmlInline = do
  inplain <- (HTMLLocal -> Bool)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HTMLLocal -> Bool
inPlain
  result <- pSatisfy (tagComment (const True))
            <|> if inplain
                   then pSatisfy (not . isBlockTag)
                   else pSatisfy isInlineTag
  exts <- getOption readerExtensions
  let raw = [Tag Text] -> Text
renderTags' [Tag Text
result]
  if extensionEnabled Ext_raw_html exts
     then return $ B.rawInline "html" raw
     else ignore raw

mathMLToTeXMath :: Text -> Either Text Text
mathMLToTeXMath :: Text -> Either Text Text
mathMLToTeXMath Text
s = [Exp] -> Text
writeTeX ([Exp] -> Text) -> Either Text [Exp] -> Either Text Text
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 (Many Inline)
pScriptMath = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
 -> ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  TagOpen _ attr' <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool) -> TagParser m (Tag Text))
-> (Tag Text -> Bool) -> TagParser m (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"script") (Bool -> [(Text, Text)] -> Bool
forall a b. a -> b -> a
const Bool
True)
  isdisplay <- case lookup "type" attr' of
                    Just Text
x | Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` Text
x
                      -> Bool -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Bool
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Bool)
-> Bool -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Bool
forall a b. (a -> b) -> a -> b
$ Text
"display" Text -> Text -> Bool
`T.isSuffixOf` Text
x
                    Maybe Text
_ -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Bool
forall a. ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  contents <- innerText <$> manyTill pAny (pSatisfy (matchTagClose "script"))
  return $ (if isdisplay then B.displayMath else B.math) contents

pMath :: PandocMonad m => Bool -> TagParser m Inlines
pMath :: forall (m :: * -> *).
PandocMonad m =>
Bool -> TagParser m (Many Inline)
pMath Bool
inCase = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
 -> ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b. (a -> b) -> a -> b
$ do
  open@(TagOpen _ attr') <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Tag Text -> Bool) -> TagParser m (Tag Text))
-> (Tag Text -> Bool) -> TagParser m (Tag Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ([(Text, Text)] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"math") (Bool -> [(Text, Text)] -> Bool
forall a b. a -> b -> a
const Bool
True)
  -- we'll assume math tags are MathML unless specially marked
  -- otherwise...
  let attr = [(Text, Text)] -> [(Text, Text)]
toStringAttr [(Text, Text)]
attr'
  unless inCase $
    guard (maybe True (== mathMLNamespace) (lookup "xmlns" attr))
  let constructor = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"display" [(Text, Text)]
attr of
                       Just Text
"block" -> Text -> Many Inline
B.displayMath
                       Maybe Text
_ -> Text -> Many Inline
B.math
  contents <- manyTill pAny (pSatisfy (matchTagClose "math"))
  -- KaTeX and others include original TeX in annotation tag;
  -- just use this if present rather than parsing MathML:
  case extractTeXAnnotation contents of
    Just Text
x -> Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline
 -> ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline))
-> Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
constructor Text
x
    Maybe Text
Nothing ->
      case Text -> Either Text Text
mathMLToTeXMath ([Tag Text] -> Text
forall str. StringLike str => [Tag str] -> str
renderTags ([Tag Text] -> Text) -> [Tag Text] -> Text
forall a b. (a -> b) -> a -> b
$
              [Tag Text
open] [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. Semigroup a => a -> a -> a
<> [Tag Text]
contents [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"math"]) of
           Left Text
_   -> Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline
 -> ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline))
-> Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"math"],[(Text, Text)]
attr) (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.text (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$
                                 [Tag Text] -> Text
forall str. StringLike str => [Tag str] -> str
innerText [Tag Text]
contents
           Right Text
"" -> Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty
           Right Text
x  -> Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline
 -> ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline))
-> Many Inline
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
constructor Text
x

extractTeXAnnotation :: [Tag Text] -> Maybe Text
extractTeXAnnotation :: [Tag Text] -> Maybe Text
extractTeXAnnotation [] = Maybe Text
forall a. Maybe a
Nothing
extractTeXAnnotation (TagOpen Text
"annotation" [(Text
"encoding",Text
"application/x-tex")]
                       : [Tag Text]
ts) =
  Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
forall str. StringLike str => [Tag str] -> str
innerText ([Tag Text] -> Text) -> [Tag Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Tag Text -> Bool) -> [Tag Text] -> [Tag Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~/= Text -> Tag Text
forall str. str -> Tag str
TagClose (Text
"annotation" :: Text)) [Tag Text]
ts
extractTeXAnnotation (Tag Text
_:[Tag Text]
ts) = [Tag Text] -> Maybe Text
extractTeXAnnotation [Tag Text]
ts


pInlinesInTags :: PandocMonad m => Text -> (Inlines -> Inlines)
               -> TagParser m Inlines
pInlinesInTags :: forall (m :: * -> *).
PandocMonad m =>
Text -> (Many Inline -> Many Inline) -> TagParser m (Many Inline)
pInlinesInTags Text
tagtype Many Inline -> Many Inline
f = (Many Inline -> Many Inline) -> Many Inline -> Many Inline
extractSpaces Many Inline -> Many Inline
f (Many Inline -> Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tagtype ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (m :: * -> *). PandocMonad m => TagParser m (Many Inline)
inline

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

type InlinesParser m = HTMLParser m Sources

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

pRawTeX :: PandocMonad m => InlinesParser m Inlines
pRawTeX :: forall (m :: * -> *).
PandocMonad m =>
InlinesParser m (Many Inline)
pRawTeX = do
  ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
 -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall a b. (a -> b) -> a -> b
$ ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
 -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall a b. (a -> b) -> a -> b
$ do
    Char -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\'
    [ParsecT Sources HTMLState (ReaderT HTMLLocal m) String]
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT Sources HTMLState (ReaderT HTMLLocal m) String]
 -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String)
-> [ParsecT Sources HTMLState (ReaderT HTMLLocal m) String]
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall a b. (a -> b) -> a -> b
$ (String -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String)
-> [String]
-> [ParsecT Sources HTMLState (ReaderT HTMLLocal m) String]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
 -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String)
-> (String
    -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String)
-> String
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
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"]
  Extension -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_raw_tex
  inp <- ParsecT Sources HTMLState (ReaderT HTMLLocal m) Sources
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  st <- getState
  res <- lift $ runParserT (withRaw rawLaTeXInline) st "chunk" inp
  case res of
       Left ParseError
_                -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall a. ParsecT Sources HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Right (Text
contents, Text
raw) -> do
         _ <- Int
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) 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) ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
         return $ B.rawInline "tex" contents

pStr :: PandocMonad m => InlinesParser m Inlines
pStr :: forall (m :: * -> *).
PandocMonad m =>
InlinesParser m (Many Inline)
pStr = do
  result <- ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
 -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool)
 -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char)
-> (Char -> Bool)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
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)
  updateLastStrPos
  return $ B.str $ T.pack 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 (Many Inline)
pSymbol = Text -> Many Inline
B.str (Text -> Many Inline) -> (Char -> Text) -> Char -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Many Inline)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\128' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
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 (Many Inline)
pBad = do
  c <- (Char -> Bool)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
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' = 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
'?'
  return $ B.str $ T.singleton c'

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

getTagName :: Tag Text -> Maybe Text
getTagName :: Tag Text -> Maybe Text
getTagName (TagOpen Text
t [(Text, Text)]
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
getTagName (TagClose Text
t)  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
getTagName Tag Text
_             = Maybe 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" [(Text, Text)]
_ -> Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` Text -> Tag Text -> Text
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
"style" [(Text, Text)]
_  -> Bool
True -- see #10643, invalid but it happens
  TagClose Text
"style"   -> Bool
True
  TagOpen Text
name [(Text, 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 Text -> Set Text -> Bool
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 Text -> Text -> Bool
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
|| Tag Text -> 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 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockTags
                                    Bool -> Bool -> Bool
|| Text
x Text -> Set Text -> Bool
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 = (Text -> Bool) -> Tag Text -> Bool
forall str. (str -> Bool) -> Tag str -> Bool
tagText (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True)

isCommentTag :: Tag Text -> Bool
isCommentTag :: Tag Text -> Bool
isCommentTag = (Text -> Bool) -> Tag Text -> Bool
forall str. (str -> Bool) -> Tag str -> Bool
tagComment (Bool -> Text -> Bool
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 = ParsecT Sources st m Text -> ParsecT Sources st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m Text -> ParsecT Sources st m Text)
-> ParsecT Sources st m Text -> ParsecT Sources st m Text
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Sources st m Char -> ParsecT Sources st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
  sources <- ParsecT Sources st m Sources
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  let ts = [Tag Text] -> [Tag Text]
forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags
        ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall a b. (a -> b) -> a -> b
$ ParseOptions Text -> Text -> [Tag Text]
forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions ParseOptions Text
forall str. StringLike str => ParseOptions str
parseOptions{ optTagWarning = True,
                                         optTagPosition = True }
        (Text -> [Tag Text]) -> Text -> [Tag Text]
forall a b. (a -> b) -> a -> b
$ Sources -> Text
sourcesToText Sources
sources
  case ts of
    (TagPosition Int
sr Int
sc : t :: Tag Text
t@(TagOpen Text
tn [(Text, Text)]
_) : [Tag Text]
rest) -> do
       Bool -> ParsecT Sources st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources st m ())
-> Bool -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ Tag Text -> Bool
f Tag Text
t
       Bool -> ParsecT Sources st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources st m ())
-> Bool -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Bool
hasTagWarning (Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Int -> [Tag Text] -> [Tag Text]
forall a. Int -> [a] -> [a]
take Int
1 [Tag Text]
rest)
       case Text -> [Tag Text] -> [Tag Text]
htmlInBalanced' Text
tn (Tag Text
tTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:[Tag Text]
rest) of
            []  -> ParsecT Sources st m Text
forall a. ParsecT Sources st m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
            [Tag Text]
xs  -> case [Tag Text] -> [Tag Text]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sr
                          let cs :: Int
cs = Int
ec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sc
                          lscontents <- [Text] -> Text
T.unlines ([Text] -> Text)
-> ParsecT Sources st m [Text] -> ParsecT Sources st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Sources st m Text -> ParsecT Sources st m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
ls ParsecT Sources st m Text
forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine
                          cscontents <- count cs anyChar
                          closetag <- do
                            x <- many (satisfy (/='>'))
                            char '>'
                            return (x <> ">")
                          return $ lscontents <> T.pack cscontents <> T.pack closetag
                        [Tag Text]
_ -> ParsecT Sources st m Text
forall a. ParsecT Sources st m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    [Tag Text]
_ -> ParsecT Sources st m Text
forall a. ParsecT Sources st m a
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 = [Tag Text] -> Maybe [Tag Text] -> [Tag Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Tag Text] -> [Tag Text]) -> Maybe [Tag Text] -> [Tag Text]
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' [(Text, Text)]
_):[Tag Text]
rest) | Text
tn' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tagname =
              (Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:) ([Tag Text] -> [Tag Text]) -> Maybe [Tag Text] -> Maybe [Tag Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Tag Text] -> Maybe [Tag Text]
go (Int
n Int -> Int -> Int
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' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tagname =
              [Tag Text] -> Maybe [Tag Text]
forall a. a -> Maybe a
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' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tagname =
              (Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:) ([Tag Text] -> [Tag Text]) -> Maybe [Tag Text] -> Maybe [Tag Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Tag Text] -> Maybe [Tag Text]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Tag Text]
rest
        go Int
n (Tag Text
t:[Tag Text]
ts') = (Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:) ([Tag Text] -> [Tag Text]) -> Maybe [Tag Text] -> Maybe [Tag Text]
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
_ [] = Maybe [Tag Text]
forall a. Maybe a
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 = ParsecT Sources st m (Tag Text, Text)
-> ParsecT Sources st m (Tag Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m (Tag Text, Text)
 -> ParsecT Sources st m (Tag Text, Text))
-> ParsecT Sources st m (Tag Text, Text)
-> ParsecT Sources st m (Tag Text, Text)
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Sources st m Char -> ParsecT Sources st m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
  startpos <- ParsecT Sources st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  sources <- getInput
  let inp = Sources -> Text
sourcesToText Sources
sources
  let ts = [Tag Text] -> [Tag Text]
forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall a b. (a -> b) -> a -> b
$ ParseOptions Text -> Text -> [Tag Text]
forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions
                               ParseOptions Text
forall str. StringLike str => ParseOptions str
parseOptions{ optTagWarning = False
                                           , optTagPosition = True }
                               (Text
inp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ")
                               -- add space to ensure that
                               -- we get a TagPosition after the tag
  (next, ln, col) <- case ts of
                      (TagPosition{} : Tag Text
next : TagPosition Int
ln Int
col : [Tag Text]
_)
                        | Tag Text -> Bool
f Tag Text
next -> (Tag Text, Int, Int) -> ParsecT Sources st m (Tag Text, Int, Int)
forall a. a -> ParsecT Sources st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, Int
ln, Int
col)
                      [Tag Text]
_ -> ParsecT Sources st m (Tag Text, Int, Int)
forall a. ParsecT Sources st m a
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
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
  let 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
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 = if Int
ln Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                  then SourcePos -> Int -> SourcePos
setSourceColumn SourcePos
startpos
                         (SourcePos -> Int
sourceColumn SourcePos
startpos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
col Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
                         Int
col
  let endAngle = ParsecT Sources u m () -> ParsecT Sources u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u m () -> ParsecT Sources u m ())
-> ParsecT Sources u m () -> ParsecT Sources u m ()
forall a b. (a -> b) -> a -> b
$
        do Char -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>'
           pos <- ParsecT Sources u m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
           guard $ pos >= endpos

  let handleTag Text
tagname = do
       -- basic sanity check, since the parser is very forgiving
       -- and finds tags in stuff like x<y)
       Bool -> ParsecT Sources u m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources u m ()) -> Bool -> ParsecT Sources u m ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isName Text
tagname Bool -> Bool -> Bool
|| Text -> Bool
isPI Text
tagname
       Bool -> ParsecT Sources u m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources u m ()) -> Bool -> ParsecT Sources u m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
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","")]
       Bool -> ParsecT Sources u m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources u m ()) -> Bool -> ParsecT Sources u m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.last Text
tagname Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':'
       Char -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<'
       rendered <- ParsecT Sources u m Char
-> ParsecT Sources u m () -> ParsecT Sources u m String
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 Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar ParsecT Sources u m ()
forall {u}. ParsecT Sources u m ()
endAngle
       return (next, T.pack $ "<" ++ rendered ++ ">")
  case next of
       TagComment Text
s
         | Text
"<!--" Text -> Text -> Bool
`T.isPrefixOf` Text
inp -> do
          String -> ParsecT Sources st m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"<!--"
          Int -> ParsecT Sources st m Char -> ParsecT Sources st m 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) ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
          String -> ParsecT Sources st m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"-->"
          stripComments <- (ReaderOptions -> Bool) -> ParsecT Sources st m Bool
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Bool
readerStripComments
          if stripComments
             then return (next, "")
             else return (next, "<!--" <> s <> "-->")
         | Bool
otherwise -> String -> ParsecT Sources st m (Tag Text, Text)
forall a. HasCallStack => String -> ParsecT Sources st m a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
Prelude.fail String
"bogus comment mode, HTML5 parse error"
       TagOpen Text
tagname [(Text, Text)]
attr -> do
         Bool -> ParsecT Sources st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources st m ())
-> Bool -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isPI Text
tagname Bool -> Bool -> Bool
|| ((Text, Text) -> Bool) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
isName (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
attr
         Text -> ParsecT Sources st m (Tag Text, Text)
forall {u}. Text -> ParsecT Sources u m (Tag Text, Text)
handleTag Text
tagname
       TagClose Text
tagname ->
         Text -> ParsecT Sources st m (Tag Text, Text)
forall {u}. Text -> ParsecT Sources u m (Tag Text, Text)
handleTag Text
tagname
       Tag Text
_ -> ParsecT Sources st m (Tag Text, Text)
forall a. ParsecT Sources st m a
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
  | Text
"data:" Text -> Text -> Bool
`T.isPrefixOf` Text
url = Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Text
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
url
  | Bool
otherwise = do
     mbBaseHref <- HTMLState -> Maybe URI
baseHref (HTMLState -> Maybe URI)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe URI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
     return $ case (parseURIReference (T.unpack url), mbBaseHref) of
                   (Just URI
rel, Just URI
bs) -> URI -> Text
forall a. Show a => a -> Text
tshow (URI
rel URI -> URI -> URI
`nonStrictRelativeTo` URI
bs)
                   (Maybe URI, Maybe URI)
_                   -> Text
url