{-# 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 Data.List (foldl')
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Either (partitionEithers)
import Data.Monoid (First (..))
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (nonStrictRelativeTo, parseURIReference)
import Text.HTML.TagSoup
import Text.HTML.TagSoup.Match
import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.CSS (pickStyleAttrProps)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Definition
import Text.Pandoc.Readers.HTML.Parsing
import Text.Pandoc.Readers.HTML.Table (pTable)
import Text.Pandoc.Readers.HTML.TagCategories
import Text.Pandoc.Readers.HTML.Types
import Text.Pandoc.Readers.LaTeX (rawLaTeXInline)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.Options (
    Extension (Ext_epub_html_exts, Ext_empty_paragraphs, Ext_native_divs,
               Ext_native_spans, Ext_raw_html, Ext_line_blocks, Ext_raw_tex),
    ReaderOptions (readerExtensions, readerStripComments),
    extensionEnabled)
import Text.Pandoc.Parsing hiding ((<|>))
import Text.Pandoc.Shared (
    addMetaField, extractSpaces, htmlSpanLikeElements, renderTags',
    safeRead, tshow, formatCode)
import Text.Pandoc.URI (escapeURI)
import Text.Pandoc.Walk
import Text.TeXMath (readMathML, writeTeX)
import qualified Data.Sequence as Seq

-- | Convert HTML-formatted string to 'Pandoc' document.
readHtml :: (PandocMonad m, ToSources a)
         => ReaderOptions -- ^ Reader options
         -> a             -- ^ Input to parse
         -> m Pandoc
readHtml :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readHtml ReaderOptions
opts a
inp = do
  let tags :: [Tag Text]
tags = [Tag Text] -> [Tag Text]
stripPrefixes ([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 -> Blocks -> Blocks
fixPlains Bool
False (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Blocks]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Blocks]
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) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
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, Blocks)]
-> 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, Blocks)]
noteTable (HTMLState -> [(Text, Blocks)])
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Text, Blocks)]
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, Blocks)] -> Inline -> TagParser m Inline
replaceNotes' [(Text, Blocks)]
noteTbl (RawInline (Format Text
"noteref") Text
ref) =
  TagParser m Inline
-> (Blocks -> TagParser m Inline)
-> Maybe Blocks
-> 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)
-> (Blocks -> Inline) -> Blocks -> TagParser m Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inline
Note ([Block] -> Inline) -> (Blocks -> [Block]) -> Blocks -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [Block]
forall a. Many a -> [a]
B.toList) (Maybe Blocks -> TagParser m Inline)
-> Maybe Blocks -> TagParser m Inline
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Blocks)] -> Maybe Blocks
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ref [(Text, Blocks)]
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, Blocks)]
_ 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 Blocks
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 Blocks
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 Blocks
pHead = Text -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"head" (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ TagParser m Blocks
pTitle TagParser m Blocks -> TagParser m Blocks -> TagParser m Blocks
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 Blocks
pMetaTag TagParser m Blocks -> TagParser m Blocks -> TagParser m Blocks
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 Blocks
pBaseTag TagParser m Blocks -> TagParser m Blocks -> TagParser m Blocks
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
<|> (Blocks
forall a. Monoid a => a
mempty Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> TagParser m Blocks
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 Blocks
pTitle = Text -> TagParser m Inlines -> TagParser m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"title" TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline TagParser m Inlines
-> (Inlines -> TagParser m Blocks) -> TagParser m Blocks
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
>>= Inlines -> TagParser m Blocks
forall {a} {m :: * -> *} {u} {b} {s}.
(Monoid a, Monad m, HasMeta u, ToMetaValue b) =>
b -> ParsecT s u m a
setTitle (Inlines -> TagParser m Blocks)
-> (Inlines -> Inlines) -> Inlines -> TagParser m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines
        setTitle :: b -> ParsecT s u m a
setTitle b
t = a
forall a. Monoid a => a
mempty a -> ParsecT s u m () -> ParsecT s u m a
forall a b. a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (u -> u) -> ParsecT s u m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (Text -> b -> u -> u
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> u -> u
B.setMeta Text
"title" b
t)
        pMetaTag :: TagParser m Blocks
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 Blocks
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 Blocks
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) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
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) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
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"]
          -> Blocks
forall a. Monoid a => a
mempty Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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"
          -> Blocks
forall a. Monoid a => a
mempty Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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)
          -> Blocks
forall a. Monoid a => a
mempty Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eFootnotes
        Text
"p" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPara
        Text
"h1" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h2" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h3" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h4" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h5" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h6" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"blockquote" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBlockQuote
        Text
"pre" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pCodeBlock
        Text
"ul" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList
        Text
"ol" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pOrderedList
        Text
"dl" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDefinitionList
        Text
"table" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *).
PandocMonad m =>
TagParser m Blocks -> TagParser m Blocks
pTable ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
        Text
"hr" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHrule
        Text
"html" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHtml
        Text
"head" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHead
        Text
"body" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
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) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pLineBlock
          | Bool
otherwise
          -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"section" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"header" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"main" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"figure" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pFigure
        Text
"iframe" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pIframe
        Text
"style" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
        Text
"textarea" -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
        Text
"switch"
          | Bool
epubExts
          -> (Inlines -> Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch Inlines -> Blocks
B.para ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
        Text
_ -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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) Blocks
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) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPlain ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock) ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> (Blocks
    -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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
>>= \Blocks
res ->
        Blocks
res Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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
$ Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
res)

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

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

eSwitch :: (PandocMonad m, Monoid a)
        => (Inlines -> a)
        -> TagParser m a
        -> TagParser m a
eSwitch :: forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch Inlines -> a
constructor TagParser m a
parser = 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 Inlines -> Maybe Inlines
forall a. First a -> Maybe a
getFirst (First Inlines -> Maybe Inlines)
-> ([First Inlines] -> First Inlines)
-> [First Inlines]
-> Maybe Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [First Inlines] -> First Inlines
forall a. Monoid a => [a] -> a
mconcat ([First Inlines] -> Maybe Inlines)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [First Inlines]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (First Inlines)
-> TagParser m (Tag Text)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [First Inlines]
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 Inlines -> First Inlines
forall a. Maybe a -> First a
First (Maybe Inlines -> First Inlines)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (First Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines)
forall (m :: * -> *). PandocMonad m => TagParser m (Maybe Inlines)
eCase ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines)
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 Inlines)
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 Inlines
p -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> TagParser m Inlines
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> TagParser m Inlines -> TagParser m Inlines
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 Inlines -> TagParser m Inlines
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 Inlines
p TagParser m Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m Inlines
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 Inlines)
Nothing -> Maybe Inlines
forall a. Maybe a
Nothing Maybe Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Tag Text]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines)
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 Blocks
eFootnotes = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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 Inlines
eNoteref = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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 Blocks
pBulletList = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Blocks]
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) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block) -- e.g. <ul>, see #9187
  items <- manyTill pListItem (pCloses "ul")
  let items' = case [Blocks]
orphans of
                 [] -> [Blocks]
items
                 [Blocks]
xs -> [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat [Blocks]
xs Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
: [Blocks]
items
  return $ B.bulletList $ map (fixPlains True) items'

pListItem :: PandocMonad m => TagParser m Blocks
pListItem :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pListItem = HTMLParser m [Tag Text] Blocks -> HTMLParser m [Tag Text] Blocks
forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInListItem (HTMLParser m [Tag Text] Blocks -> HTMLParser m [Tag Text] Blocks)
-> HTMLParser m [Tag Text] Blocks -> HTMLParser m [Tag Text] Blocks
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 Blocks
bs = case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs of
                           (Plain [Inline]
ils:[Block]
xs) -> [Block] -> Blocks
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)]) -> Blocks -> Blocks
B.divWith (Text
ident, [], []) Blocks
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 Inlines
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 -> Inlines
B.str (Text -> Inlines) -> Text -> Inlines
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 Blocks
pOrderedList = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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 [Blocks]
orphans of
                      [] -> [Blocks]
items
                      [Blocks]
xs -> [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat [Blocks]
xs Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
: [Blocks]
items
       return $ B.orderedListWith (start, style, DefaultDelim) $
                map (fixPlains True) items'

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

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

pRawTag :: PandocMonad m => TagParser m Text
pRawTag :: forall (m :: * -> *). PandocMonad m => TagParser m Text
pRawTag = do
  tag <- 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 Blocks
pLineBlock = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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] -> Inlines) -> [[Inline]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([[Inline]] -> [Inlines]) -> [[Inline]] -> [Inlines]
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
$
            Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
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 Blocks
pDiv = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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 Blocks -> Seq Block
forall a. Many a -> Seq a
B.unMany Blocks
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 -> Blocks
forall a. Seq a -> Many a
B.Many (Seq Block -> Blocks) -> Seq Block -> Blocks
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
_ -> Blocks
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 Blocks
pIframe = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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"))
  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
                    Blocks -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[]) (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
                      Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image Text
url Text
"" Inlines
forall a. Monoid a => a
mempty
             Maybe Text
_ -> Blocks -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[(Text
"src", Text
url)]) Blocks
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) Blocks
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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 Blocks
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 Blocks
eSection = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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.
String -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not retrieve header level"

eTitlePage :: PandocMonad m => TagParser m ()
eTitlePage :: forall (m :: * -> *). PandocMonad m => TagParser m ()
eTitlePage = 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 Blocks
pHeader = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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 Blocks
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 Blocks
pBlockQuote = do
  contents <- Text -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"blockquote" TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
  return $ B.blockQuote $ fixPlains False contents

pPlain :: PandocMonad m => TagParser m Blocks
pPlain :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPlain = do
  contents <- HTMLParser m [Tag Text] Inlines -> HTMLParser m [Tag Text] Inlines
forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInPlain (HTMLParser m [Tag Text] Inlines
 -> HTMLParser m [Tag Text] Inlines)
-> HTMLParser m [Tag Text] Inlines
-> HTMLParser m [Tag Text] Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Inlines]
-> HTMLParser m [Tag Text] Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HTMLParser m [Tag Text] Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 HTMLParser m [Tag Text] Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
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 Blocks
pPara = do
  contents <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"p" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
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 Blocks
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 = Blocks -> Either Blocks Blocks
forall a b. a -> Either a b
Left (Blocks -> Either Blocks Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"figcaption" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
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
<|>
             (Blocks -> Either Blocks Blocks
forall a b. b -> Either a b
Right (Blocks -> Either Blocks Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
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 Blocks
pCodeBlock = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
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 leading newline if any
  let result' = case Text -> Maybe (Char, Text)
T.uncons Text
rawText of
                     Just (Char
'\n', Text
xs) -> Text
xs
                     Maybe (Char, Text)
_               -> Text
rawText
  -- drop trailing newline if any
  let result = case Text -> Maybe (Text, Char)
T.unsnoc Text
result' of
                    Just (Text
result'', Char
'\n') -> Text
result''
                    Maybe (Text, Char)
_                     -> Text
result'
  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 Inlines
inline = TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText TagParser m Inlines -> TagParser m Inlines -> TagParser m Inlines
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 Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
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 Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
eNoteref
            | Bool
otherwise -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLink
        Text
"switch" -> (Inlines -> Inlines) -> TagParser m Inlines -> TagParser m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch Inlines -> Inlines
forall a. a -> a
id TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
        Text
"q" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pQ
        Text
"em" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph
        Text
"i"  -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph
        Text
"strong" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong
        Text
"b" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong
        Text
"sup" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSuperscript
        Text
"sub" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSubscript
        Text
"small" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSmall
        Text
"s" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
        Text
"strike" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
        Text
"del" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
        Text
"u" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline
        Text
"ins" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline
        Text
"br" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLineBreak
        Text
"img" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pImage
        Text
"svg" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSvg
        Text
"bdo" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pBdo
        Text
"tt" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode
        Text
"code" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode
        Text
"samp" -> Text -> Text -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> TagParser m Inlines
pCodeWithClass Text
"samp" Text
"sample"
        Text
"var" -> Text -> Text -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> TagParser m Inlines
pCodeWithClass Text
"var" Text
"variable"
        Text
"span" -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpan
        Text
"math" -> Bool -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => Bool -> TagParser m Inlines
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 Inlines -> TagParser m Inlines
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 Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCheckbox
        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 Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
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 Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpanLike
        Text
_ -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline
    TagText Text
_ -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText
    Tag Text
_ -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline

pSelfClosing :: PandocMonad m
             => (Text -> Bool) -> ([Attribute Text] -> Bool)
             -> TagParser m (Tag Text)
pSelfClosing :: forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([(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 Inlines
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 -> (Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote Inlines -> Inlines
forall a. a -> a
id
 where
  makeQuote :: (Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote Inlines -> Inlines
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 -> (Inlines -> Inlines
B.singleQuoted, QuoteContext
InSingleQuote)
                  QuoteContext
_             -> (Inlines -> Inlines
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 Inlines
pEmph = Text -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"em" Inlines -> Inlines
B.emph TagParser m Inlines -> TagParser m Inlines -> TagParser m Inlines
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 -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"i" Inlines -> Inlines
B.emph

pStrong :: PandocMonad m => TagParser m Inlines
pStrong :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong = Text -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"strong" Inlines -> Inlines
B.strong TagParser m Inlines -> TagParser m Inlines -> TagParser m Inlines
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 -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"b" Inlines -> Inlines
B.strong

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

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

pSpanLike :: PandocMonad m => TagParser m Inlines
pSpanLike :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpanLike =
  (Text -> TagParser m Inlines -> TagParser m Inlines)
-> TagParser m Inlines -> Set Text -> TagParser m Inlines
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr
    (\Text
tagName TagParser m Inlines
acc -> TagParser m Inlines
acc TagParser m Inlines -> TagParser m Inlines -> TagParser m Inlines
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 Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
parseTag Text
tagName)
    TagParser m Inlines
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) Inlines
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 Inlines
pSmall = Text -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"small" ((Text, [Text], [(Text, Text)]) -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"small"],[]))

pStrikeout :: PandocMonad m => TagParser m Inlines
pStrikeout :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout =
  Text -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"s" Inlines -> Inlines
B.strikeout TagParser m Inlines -> TagParser m Inlines -> TagParser m Inlines
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 -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"strike" Inlines -> Inlines
B.strikeout TagParser m Inlines -> TagParser m Inlines -> TagParser m Inlines
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 -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"del" Inlines -> Inlines
B.strikeout TagParser m Inlines -> TagParser m Inlines -> TagParser m Inlines
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 Inlines -> TagParser m Inlines
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 <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Inlines]
-> TagParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TagParser m Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Inlines]
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 Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
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 Inlines
pUnderline = Text -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"u" Inlines -> Inlines
B.underline TagParser m Inlines -> TagParser m Inlines -> TagParser m Inlines
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 -> (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"ins" Inlines -> Inlines
B.underline

pLineBreak :: PandocMonad m => TagParser m Inlines
pLineBreak :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLineBreak = do
  (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)
  Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.linebreak

pLink :: PandocMonad m => TagParser m Inlines
pLink :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLink = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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   ->
              Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces ((Text, [Text], [(Text, Text)]) -> Inlines -> Inlines
B.spanWith (Text, [Text], [(Text, Text)])
attr) Inlines
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 Inlines
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 Inlines
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 Inlines
pCodeWithClass Text
name Text
class' = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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 Inlines
pCode = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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 Inlines
code Text
open (Text, [Text], [(Text, Text)])
attr = do
  result <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Inlines]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Inlines]
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) Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
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 Inlines
pBdo = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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)]) -> Inlines -> Inlines
B.spanWith (Text
"", [], [(Text
"dir",Text -> Text
T.toLower Text
dir)]) Inlines
contents
    Maybe Text
Nothing  -> Inlines
contents

pSpan :: PandocMonad m => TagParser m Inlines
pSpan :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpan = do
  (TagOpen _ 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
"katex-html"],[(Text, Text)]
_) -> Inlines
forall a. Monoid a => a
mempty Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
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) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
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 Inlines -> Inlines
B.smallcaps else (Text, [Text], [(Text, Text)]) -> Inlines -> Inlines
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) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline -- just contents

pRawHtmlInline :: PandocMonad m => TagParser m Inlines
pRawHtmlInline :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline = do
  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 Inlines
pScriptMath = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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 Inlines
pMath Bool
inCase = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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 -> Inlines
B.displayMath
                       Maybe Text
_ -> Text -> Inlines
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 -> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
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
_   -> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"math"],[(Text, Text)]
attr) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$
                                 [Tag Text] -> Text
forall str. StringLike str => [Tag str] -> str
innerText [Tag Text]
contents
           Right Text
"" -> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
           Right Text
x  -> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
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 -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
tagtype Inlines -> Inlines
f = (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f (Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tagtype ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline

pTagText :: PandocMonad m => TagParser m Inlines
pTagText :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText = ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
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) Inlines)
-> PandocError
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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 [Inlines]
result  -> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines)
-> Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [Inlines]
result

type InlinesParser m = HTMLParser m Sources

pTagContents :: PandocMonad m => InlinesParser m Inlines
pTagContents :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents =
      Text -> Inlines
B.displayMath (Text -> Inlines)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Text
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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 -> Inlines
B.math        (Text -> Inlines)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Text
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pStr
  ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSpace
  ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
forall st (m :: * -> *) s.
(HasReaderOptions st, HasLastStrPosition st, HasQuoteContext st m,
 Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
smartPunctuation ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents
  ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pRawTeX
  ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSymbol
  ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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) Inlines
forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pBad

pRawTeX :: PandocMonad m => InlinesParser m Inlines
pRawTeX :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
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) Inlines
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 Inlines
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 Inlines
pSymbol = Text -> Inlines
B.str (Text -> Inlines) -> (Char -> Text) -> Char -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Inlines)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Char
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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 Inlines
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 Inlines
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) Inlines)
-> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
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 Inlines -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.softbreak
               else Inlines -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) Inlines
forall a. a -> ParsecT Sources HTMLState (ReaderT HTMLLocal m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.space

getTagName :: Tag Text -> Maybe Text
getTagName :: Tag Text -> Maybe Text
getTagName (TagOpen Text
t [(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
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. String -> ParsecT Sources st m a
forall (m :: * -> *) a. MonadFail m => 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