{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ViewPatterns          #-}
{- |
   Module      : Text.Pandoc.Readers.HTML
   Copyright   : Copyright (C) 2006-2021 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
                                ) where

import Control.Applicative ((<|>))
import Control.Monad (guard, msum, mzero, unless, void)
import Control.Monad.Except (throwError, catchError)
import Control.Monad.Reader (ask, asks, lift, local, runReaderT)
import Data.ByteString.Base64 (encode)
import Data.Char (isAlphaNum, isLetter)
import Data.Default (Default (..), def)
import Data.Foldable (for_)
import Data.List.Split (splitWhen)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, isNothing)
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, blocksToInlines', crFilter, escapeURI, extractSpaces,
    htmlSpanLikeElements, renderTags', safeRead, tshow)
import Text.Pandoc.Walk
import Text.Parsec.Error
import Text.TeXMath (readMathML, writeTeX)

-- | Convert HTML-formatted string to 'Pandoc' document.
readHtml :: PandocMonad m
         => ReaderOptions -- ^ Reader options
         -> Text        -- ^ String to parse (assumes @'\n'@ line endings)
         -> m Pandoc
readHtml :: ReaderOptions -> Text -> m Pandoc
readHtml ReaderOptions
opts Text
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 :: Bool
optTagPosition = Bool
True }
             (Text -> Text
crFilter Text
inp)
      parseDoc :: ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
parseDoc = do
        Blocks
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
meta <- ParserState -> Meta
stateMeta (ParserState -> Meta)
-> (HTMLState -> ParserState) -> HTMLState -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLState -> ParserState
parserState (HTMLState -> Meta)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Meta
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
        [Block]
bs' <- [Block] -> TagParser m [Block]
forall (m :: * -> *).
PandocMonad m =>
[Block] -> TagParser m [Block]
replaceNotes (Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
blocks)
        ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *) st s.
(PandocMonad m, HasLogMessages st) =>
ParserT s st m ()
reportLogMessages
        Pandoc -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc)
-> Pandoc
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs'
      getError :: ParseError -> String
getError (ParseError -> [Message]
errorMessages -> [Message]
ms) = case [Message]
ms of
                                         []    -> String
""
                                         (Message
m:[Message]
_) -> Message -> String
messageString Message
m
  Either ParseError Pandoc
result <- (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
-> HTMLState
HTMLState ParserState
forall a. Default a => a
def{ stateOptions :: ReaderOptions
stateOptions = ReaderOptions
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)
       String
"source" [Tag Text]
tags
  case Either ParseError Pandoc
result of
    Right Pandoc
doc -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
doc
    Left  ParseError
err -> PandocError -> m Pandoc
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

-- 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 [Attribute Text]
as) = Text -> [Attribute 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) [Attribute 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 :: [Block] -> TagParser m [Block]
replaceNotes [Block]
bs = do
  HTMLState
st <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  [Block] -> TagParser m [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> TagParser m [Block]) -> [Block] -> TagParser m [Block]
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk ([(Text, Blocks)] -> Inline -> Inline
replaceNotes' (HTMLState -> [(Text, Blocks)]
noteTable HTMLState
st)) [Block]
bs

replaceNotes' :: [(Text, Blocks)] -> Inline -> Inline
replaceNotes' :: [(Text, Blocks)] -> Inline -> Inline
replaceNotes' [(Text, Blocks)]
noteTbl (RawInline (Format Text
"noteref") Text
ref) =
  Inline -> (Blocks -> Inline) -> Maybe Blocks -> Inline
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Inline
Str Text
"") ([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 -> Inline) -> Maybe Blocks -> 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
replaceNotes' [(Text, Blocks)]
_ Inline
x = Inline
x

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

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

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

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

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

block :: PandocMonad m => TagParser m Blocks
block :: TagParser m Blocks
block = ((do
  Tag Text
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)
  Extensions
exts <- (ReaderOptions -> Extensions)
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  case Tag Text
tag of
    TagOpen Text
name [Attribute 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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr
          epubExts :: Bool
epubExts = Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_epub_html_exts Extensions
exts
      in
      case Text
name of
        Text
_ | Text
name Text -> [Text] -> 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'
          -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eSection
        Text
_ | Bool
epubExts
          , Text
type' Text -> [Text] -> 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) ()
-> TagParser m Blocks
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) ()
-> TagParser m Blocks
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 (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) ()
-> TagParser m Blocks
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
"p" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPara
        Text
"h1" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h2" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h3" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h4" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h5" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"h6" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
        Text
"blockquote" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBlockQuote
        Text
"pre" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pCodeBlock
        Text
"ul" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList
        Text
"ol" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pOrderedList
        Text
"dl" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDefinitionList
        Text
"table" -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
TagParser m Blocks -> TagParser m Blocks
pTable TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
        Text
"hr" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHrule
        Text
"html" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHtml
        Text
"head" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHead
        Text
"body" -> TagParser 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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr
          -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pLineBlock
          | Bool
otherwise
          -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"section" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"main" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
        Text
"figure" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pFigure
        Text
"iframe" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pIframe
        Text
"style" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
        Text
"textarea" -> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
        Text
"switch"
          | Bool
epubExts
          -> (Inlines -> Blocks) -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch Inlines -> Blocks
B.para TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
        Text
_ -> TagParser m Blocks
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Tag Text
_ -> TagParser m Blocks
forall (m :: * -> *) a. MonadPlus m => m a
mzero) TagParser m Blocks -> TagParser m Blocks -> TagParser m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPlain TagParser m Blocks -> TagParser m Blocks -> TagParser m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock) TagParser m Blocks
-> (Blocks -> TagParser m Blocks) -> TagParser m Blocks
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) ()
-> TagParser m Blocks
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 :: [(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 :: (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 -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT 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 -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"switch" [])
  Maybe Inlines
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)
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParserT [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 -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"default" []))
  ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
  a
fallback <- Text -> TagParser m a -> TagParser m a
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"default" (ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m a -> TagParser m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TagParser m a
parser TagParser m a
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank)
  ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
  (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"switch")
  a -> TagParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> TagParser m a) -> a -> TagParser m a
forall a b. (a -> b) -> a -> b
$ a -> (Inlines -> a) -> Maybe Inlines -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
fallback Inlines -> a
constructor Maybe Inlines
cases

eCase :: PandocMonad m => TagParser m (Maybe Inlines)
eCase :: 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 Text
_ [Attribute Text]
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 -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"case" [])
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  case (Text
 -> [(Text, TagParser m Inlines)] -> Maybe (TagParser m Inlines))
-> [(Text, TagParser m Inlines)]
-> Text
-> Maybe (TagParser m Inlines)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text
-> [(Text, TagParser m Inlines)] -> Maybe (TagParser m Inlines)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Text, TagParser m Inlines)]
forall (m :: * -> *).
PandocMonad m =>
[(Text, TagParser m Inlines)]
namespaces (Text -> Maybe (TagParser m Inlines))
-> Maybe Text -> Maybe (TagParser m Inlines)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"required-namespace" [Attribute Text]
attr of
    Just TagParser m Inlines
p -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines)
-> TagParser m Inlines -> TagParser 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 (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 (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]
-> TagParser m (Maybe Inlines)
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 :: TagParser m ()
eFootnote = TagParser m () -> TagParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m () -> TagParser m ())
-> TagParser m () -> TagParser m ()
forall a b. (a -> b) -> a -> b
$ do
  let notes :: [Text]
notes = [Text
"footnote", Text
"rearnote"]
  Extension -> TagParser m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_epub_html_exts
  (TagOpen Text
tag [Attribute Text]
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 :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  Bool -> TagParser m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> TagParser m ()) -> Bool -> TagParser m ()
forall a b. (a -> b) -> a -> b
$ Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notes)
          (Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr)
  let ident :: Text
ident = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr)
  Blocks
content <- Text -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
  Text -> Blocks -> TagParser m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Blocks -> TagParser m ()
addNote Text
ident Blocks
content

addNote :: PandocMonad m => Text -> Blocks -> TagParser m ()
addNote :: Text -> Blocks -> TagParser m ()
addNote Text
uid Blocks
cont = (HTMLState -> HTMLState) -> TagParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\HTMLState
s -> HTMLState
s {noteTable :: [(Text, Blocks)]
noteTable = (Text
uid, Blocks
cont) (Text, Blocks) -> [(Text, Blocks)] -> [(Text, Blocks)]
forall a. a -> [a] -> [a]
: HTMLState -> [(Text, Blocks)]
noteTable HTMLState
s})

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

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

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

pListItem :: PandocMonad m => TagParser m a -> TagParser m Blocks
pListItem :: TagParser m a -> TagParser m Blocks
pListItem TagParser m a
nonItem = do
  TagOpen Text
_ [Attribute Text]
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 -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"li" [])
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  let addId :: Text -> Blocks -> Blocks
addId Text
ident Blocks
bs = case 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
                                [Attr -> [Inline] -> Inline
Span (Text
ident, [], []) [Inline]
ils] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs)
                           [Block]
_ -> Attr -> Blocks -> Blocks
B.divWith (Text
ident, [], []) Blocks
bs
  (Blocks -> Blocks)
-> (Text -> Blocks -> Blocks) -> Maybe Text -> Blocks -> Blocks
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Blocks -> Blocks
forall a. a -> a
id Text -> Blocks -> Blocks
addId (Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr) (Blocks -> Blocks) -> TagParser m Blocks -> TagParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Text -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"li" TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block TagParser m Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TagParser m a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m a
nonItem

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

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

pOrderedList :: PandocMonad m => TagParser m Blocks
pOrderedList :: TagParser m Blocks
pOrderedList = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
_ [Attribute Text]
attribs' <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"ol" [])
  let attribs :: [Attribute Text]
attribs = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attribs'
  let start :: Int
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start" [Attribute Text]
attribs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  let style :: ListNumberStyle
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attribs)
        Maybe ListNumberStyle
-> Maybe ListNumberStyle -> Maybe ListNumberStyle
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attribs)
        Maybe ListNumberStyle
-> Maybe ListNumberStyle -> Maybe ListNumberStyle
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [Attribute Text]
attribs Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
pickListStyle))
        where
          pickListStyle :: Text -> Maybe Text
pickListStyle = [Text] -> Text -> Maybe Text
pickStyleAttrProps [Text
"list-style-type", Text
"list-style"]

  let nonItem :: TagParser m (Tag Text)
nonItem = (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 -> Bool) -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"li",Text
"ol",Text
"ul",Text
"dl"]) (Bool -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True) Tag Text
t) Bool -> Bool -> Bool
&&
                  Bool -> Bool
not (Text -> Tag Text -> Bool
matchTagClose Text
"ol" Tag Text
t))
  -- note: if they have an <ol> or <ul> not in scope of a <li>,
  -- treat it as a list item, though it's not valid xhtml...
  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
  [Blocks]
items <- TagParser 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 (TagParser m (Tag Text) -> TagParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
TagParser m a -> TagParser m Blocks
pListItem TagParser m (Tag Text)
nonItem) (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"ol")
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Blocks] -> Blocks
B.orderedListWith (Int
start, ListNumberStyle
style, ListNumberDelim
DefaultDelim) ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ (Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Blocks -> Blocks
fixPlains Bool
True) [Blocks]
items

pDefinitionList :: PandocMonad m => TagParser m Blocks
pDefinitionList :: TagParser m Blocks
pDefinitionList = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser 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 -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dl" [])
  [(Inlines, [Blocks])]
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")
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ [(Inlines, [Blocks])] -> Blocks
B.definitionList [(Inlines, [Blocks])]
items

pDefListItem :: PandocMonad m => TagParser m (Inlines, [Blocks])
pDefListItem :: TagParser m (Inlines, [Blocks])
pDefListItem = TagParser m (Inlines, [Blocks]) -> TagParser m (Inlines, [Blocks])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m (Inlines, [Blocks])
 -> TagParser m (Inlines, [Blocks]))
-> TagParser m (Inlines, [Blocks])
-> TagParser 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 -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dt" [] Tag Text
t) Bool -> Bool -> Bool
&&
                  Bool -> Bool
not (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dd" [] Tag Text
t) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Tag Text -> Bool
matchTagClose Text
"dl" Tag Text
t))
  [Inlines]
terms <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
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 (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)
  [Blocks]
defs  <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (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
$ 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) Blocks
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m 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
"dd" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)
  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
  let term :: Inlines
term = (Inlines -> Inlines -> Inlines) -> [Inlines] -> Inlines
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Inlines
x Inlines
y -> 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
y) ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Inlines -> Inlines
trimInlines [Inlines]
terms
  (Inlines, [Blocks]) -> TagParser m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
term, (Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Blocks -> Blocks
fixPlains Bool
True) [Blocks]
defs)

fixPlains :: Bool -> Blocks -> Blocks
fixPlains :: Bool -> Blocks -> Blocks
fixPlains Bool
inList Blocks
bs = if (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 :: TagParser m Text
pRawTag = do
  Tag Text
tag <- TagParser m (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
  let ignorable :: a -> Bool
ignorable a
x = a
x 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 (Text -> Bool) -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
forall a. (Eq a, IsString a) => a -> Bool
ignorable (Bool -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True) Tag Text
tag Bool -> Bool -> Bool
|| (Text -> Bool) -> Tag Text -> Bool
forall str. (str -> Bool) -> Tag str -> Bool
tagClose Text -> Bool
forall a. (Eq a, IsString a) => a -> Bool
ignorable Tag Text
tag
     then Text -> TagParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
     else Text -> TagParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TagParser m Text) -> Text -> TagParser m Text
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag]

pLineBlock :: PandocMonad m => TagParser m Blocks
pLineBlock :: TagParser m Blocks
pLineBlock = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  Extension -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_line_blocks
  Tag Text
_ <- (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) -> ([Attribute 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") ([Attribute Text] -> [Attribute Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [(Text
"class",Text
"line-block")])
  Inlines
ils <- 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]
-> 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
-> TagParser m (Tag Text)
-> 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 ((Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Text -> Bool) -> Tag Text -> Bool
forall str. (str -> Bool) -> Tag str -> Bool
tagClose (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"div")))
  let lns :: [Inlines]
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
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Blocks
B.lineBlock [Inlines]
lns

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

pDiv :: PandocMonad m => TagParser m Blocks
pDiv :: TagParser m Blocks
pDiv = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  Extension -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_native_divs
  TagOpen Text
tag [Attribute Text]
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) -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
isDivLike (Bool -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
  let (Text
ident, [Text]
classes, [Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
  Blocks
contents <- Text -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
  let classes' :: [Text]
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' :: [Attribute Text]
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"role" [Attribute Text]
kvs)
               then (Text
"role", Text
"main")Attribute Text -> [Attribute Text] -> [Attribute Text]
forall a. a -> [a] -> [a]
:[Attribute Text]
kvs
               else [Attribute Text]
kvs
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
ident, [Text]
classes', [Attribute Text]
kvs') Blocks
contents

pIframe :: PandocMonad m => TagParser m Blocks
pIframe :: TagParser m Blocks
pIframe = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  Extension -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardDisabled Extension
Ext_raw_html
  Tag Text
tag <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Text -> Bool) -> ([Attribute 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)
-> ([Attribute Text] -> Maybe Text) -> [Attribute Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src"))
  Text -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"iframe" ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  Text
url <- Text -> TagParser m Text
forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl (Text -> TagParser m Text) -> Text -> TagParser m Text
forall a b. (a -> b) -> a -> b
$ Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
tag
  if Text -> Bool
T.null Text
url
     then Text -> TagParser m Blocks
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore (Text -> TagParser m Blocks) -> Text -> TagParser 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"]
     else TagParser m Blocks
-> (PandocError -> TagParser m Blocks) -> TagParser m Blocks
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
       (do (ByteString
bs, Maybe Text
_) <- Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
url
           let inp :: Text
inp = ByteString -> Text
UTF8.toText ByteString
bs
           ReaderOptions
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 Meta
_ [Block]
contents <- ReaderOptions
-> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readHtml ReaderOptions
opts Text
inp
           Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[]) (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [Block]
contents)
       (\PandocError
e -> do
         LogMessage -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT s st m ()
logMessage (LogMessage
 -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ())
-> LogMessage
-> ParserT [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 -> TagParser m Blocks
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore (Text -> TagParser m Blocks) -> Text -> TagParser 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 :: TagParser m Blocks
pRawHtmlBlock = do
  Text
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 (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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TagParser m Text
forall (m :: * -> *). PandocMonad m => TagParser m Text
pRawTag
  Extensions
exts <- (ReaderOptions -> Extensions)
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_html Extensions
exts Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
raw)
     then Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
"html" Text
raw
     else Text -> TagParser m Blocks
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore Text
raw

ignore :: (Monoid a, PandocMonad m) => Text -> TagParser m a
ignore :: Text -> TagParser m a
ignore Text
raw = do
  SourcePos
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:
  Bool
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
raw) (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
$
    LogMessage -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParserT 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 -> SourcePos -> LogMessage
SkippedContent Text
raw SourcePos
pos
  a -> TagParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty

pHtmlBlock :: PandocMonad m => Text -> TagParser m Text
pHtmlBlock :: Text -> TagParser m Text
pHtmlBlock Text
t = TagParser m Text -> TagParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Text -> TagParser m Text)
-> TagParser m Text -> TagParser m Text
forall a b. (a -> b) -> a -> b
$ do
  Tag Text
open <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
t [])
  [Tag Text]
contents <- TagParser m (Tag Text)
-> TagParser 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 TagParser m (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny ((Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
t))
  Text -> TagParser m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TagParser m Text) -> Text -> TagParser m Text
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
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
t]

-- Sets chapter context
eSection :: PandocMonad m => TagParser m Blocks
eSection :: TagParser m Blocks
eSection = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser 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 (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) -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
sectioningContent) [Attribute Text] -> Bool
forall a. (Eq a, IsString a) => [(a, Text)] -> Bool
matchChapter
  TagOpen Text
tag [Attribute 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.
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
  TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInChapter (Text -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)

headerLevel :: Text -> TagParser m Int
headerLevel :: 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 (m :: * -> *) a. Monad m => a -> m a
return Int
level
        Maybe Int
Nothing -> String -> TagParser m Int
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not retrieve header level"

eTitlePage :: PandocMonad m => TagParser m ()
eTitlePage :: TagParser m ()
eTitlePage = TagParser m () -> TagParser m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m () -> TagParser m ())
-> TagParser m () -> TagParser 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 (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) -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (\Text
x -> Text
x Text -> [Text] -> 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")
                          [Attribute Text] -> Bool
forall a. (Eq a, IsString a) => [(a, Text)] -> Bool
isTitlePage
  TagOpen Text
tag [Attribute 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.
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
  () ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
-> TagParser m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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
tag ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block

pHeader :: PandocMonad m => TagParser m Blocks
pHeader :: TagParser m Blocks
pHeader = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
tagtype [Attribute Text]
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) -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> [Text] -> 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 -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
  let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
  let bodyTitle :: Bool
bodyTitle = Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
tagtype [Attribute Text]
attr' Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen (Text
"h1" :: Text)
                                               [(Text
"class",Text
"title")]
  Int
level <- Text -> TagParser m Int
forall (m :: * -> *). Text -> TagParser m Int
headerLevel Text
tagtype
  Inlines
contents <- 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]
-> 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
tagtype ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  let ident :: Text
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr
  let classes :: [Text]
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr
  let keyvals :: [Attribute Text]
keyvals = [(Text
k,Text
v) | (Text
k,Text
v) <- [Attribute Text]
attr, Text
k 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
attr'' <- Attr
-> Inlines
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) Attr
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
 HasIdentifierList st) =>
Attr -> Inlines -> ParserT s st m Attr
registerHeader (Text
ident, [Text]
classes, [Attribute Text]
keyvals) Inlines
contents
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ if Bool
bodyTitle
              then Blocks
forall a. Monoid a => a
mempty  -- skip a representation of the title in the body
              else Attr -> Int -> Inlines -> Blocks
B.headerWith Attr
attr'' Int
level Inlines
contents

pHrule :: PandocMonad m => TagParser m Blocks
pHrule :: TagParser m Blocks
pHrule = do
  (Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"hr") (Bool -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
B.horizontalRule

pBlockQuote :: PandocMonad m => TagParser m Blocks
pBlockQuote :: TagParser m Blocks
pBlockQuote = do
  Blocks
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
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
B.blockQuote (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Bool -> Blocks -> Blocks
fixPlains Bool
False Blocks
contents

pPlain :: PandocMonad m => TagParser m Blocks
pPlain :: TagParser m Blocks
pPlain = do
  Inlines
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 (m :: * -> *) t u a.
Stream s m t =>
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 Inlines -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
contents
     then Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
     else Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain Inlines
contents

pPara :: PandocMonad m => TagParser m Blocks
pPara :: TagParser m Blocks
pPara = do
  Inlines
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 Extension -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardDisabled Extension
Ext_empty_paragraphs
      Bool -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Inlines -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
contents)
      Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty)
    TagParser m Blocks -> TagParser m Blocks -> TagParser m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> Blocks
B.para Inlines
contents)

pFigure :: PandocMonad m => TagParser m Blocks
pFigure :: TagParser m Blocks
pFigure = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
_ [Attribute Text]
_ <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"figure" [])
  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
  let pImg :: ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines, Maybe a)
pImg  = (\Inlines
x -> (Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
x, Maybe a
forall a. Maybe a
Nothing)) (Inlines -> (Maybe Inlines, Maybe a))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines, Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               (TagOmission
-> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *) a.
PandocMonad m =>
TagOmission -> Text -> TagParser m a -> TagParser m a
pInTag TagOmission
TagsOmittable Text
"p" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pImage ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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)
      pCapt :: ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe a, Maybe Inlines)
pCapt = (\Inlines
x -> (Maybe a
forall a. Maybe a
Nothing, Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
x)) (Inlines -> (Maybe a, Maybe Inlines))
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe a, Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                Blocks
bs <- Text -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"figcaption" TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
                Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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
$ [Block] -> Inlines
blocksToInlines' ([Block] -> Inlines) -> [Block] -> Inlines
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs
      pSkip :: ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe a, Maybe a)
pSkip = (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing) (Maybe a, Maybe a)
-> TagParser m (Tag Text)
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe a, Maybe a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Bool -> Bool
not (Bool -> Bool) -> (Tag Text -> Bool) -> Tag Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Tag Text -> Bool
matchTagClose Text
"figure")
  [(Maybe Inlines, Maybe Inlines)]
res <- ParsecT
  [Tag Text]
  HTMLState
  (ReaderT HTMLLocal m)
  (Maybe Inlines, Maybe Inlines)
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     [(Maybe Inlines, Maybe Inlines)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT
  [Tag Text]
  HTMLState
  (ReaderT HTMLLocal m)
  (Maybe Inlines, Maybe Inlines)
forall a.
ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe Inlines, Maybe a)
pImg ParsecT
  [Tag Text]
  HTMLState
  (ReaderT HTMLLocal m)
  (Maybe Inlines, Maybe Inlines)
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Maybe Inlines, Maybe Inlines)
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Maybe Inlines, Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  [Tag Text]
  HTMLState
  (ReaderT HTMLLocal m)
  (Maybe Inlines, Maybe Inlines)
forall a.
ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe a, Maybe Inlines)
pCapt ParsecT
  [Tag Text]
  HTMLState
  (ReaderT HTMLLocal m)
  (Maybe Inlines, Maybe Inlines)
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Maybe Inlines, Maybe Inlines)
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Maybe Inlines, Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  [Tag Text]
  HTMLState
  (ReaderT HTMLLocal m)
  (Maybe Inlines, Maybe Inlines)
forall a a.
ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) (Maybe a, Maybe a)
pSkip)
  let mbimg :: Maybe Inlines
mbimg = [Maybe Inlines] -> Maybe Inlines
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe Inlines] -> Maybe Inlines)
-> [Maybe Inlines] -> Maybe Inlines
forall a b. (a -> b) -> a -> b
$ ((Maybe Inlines, Maybe Inlines) -> Maybe Inlines)
-> [(Maybe Inlines, Maybe Inlines)] -> [Maybe Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Inlines, Maybe Inlines) -> Maybe Inlines
forall a b. (a, b) -> a
fst [(Maybe Inlines, Maybe Inlines)]
res
  let mbcap :: Maybe Inlines
mbcap = [Maybe Inlines] -> Maybe Inlines
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe Inlines] -> Maybe Inlines)
-> [Maybe Inlines] -> Maybe Inlines
forall a b. (a -> b) -> a -> b
$ ((Maybe Inlines, Maybe Inlines) -> Maybe Inlines)
-> [(Maybe Inlines, Maybe Inlines)] -> [Maybe Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Inlines, Maybe Inlines) -> Maybe Inlines
forall a b. (a, b) -> b
snd [(Maybe Inlines, Maybe Inlines)]
res
  TagClose Text
_ <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"figure")
  let caption :: Inlines
caption = Inlines -> Maybe Inlines -> Inlines
forall a. a -> Maybe a -> a
fromMaybe Inlines
forall a. Monoid a => a
mempty Maybe Inlines
mbcap
  case Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline]) -> Maybe Inlines -> Maybe [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Inlines
mbimg of
       Just [Image Attr
attr [Inline]
_ (Text
url, Text
tit)] ->
         Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith Attr
attr Text
url (Text
"fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tit) Inlines
caption
       Maybe [Inline]
_ -> TagParser m Blocks
forall (m :: * -> *) a. MonadPlus m => m a
mzero

pCodeBlock :: PandocMonad m => TagParser m Blocks
pCodeBlock :: TagParser m Blocks
pCodeBlock = TagParser m Blocks -> TagParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Blocks -> TagParser m Blocks)
-> TagParser m Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
_ [Attribute Text]
attr' <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"pre" [])
  let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
  [Tag Text]
contents <- TagParser m (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> 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 TagParser m (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"pre" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  let rawText :: Text
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' :: Text
result' = case Text -> Maybe (Char, Text)
T.uncons Text
rawText of
                     Just (Char
'\n', Text
xs) -> Text
xs
                     Maybe (Char, Text)
_               -> Text
rawText
  -- drop trailing newline if any
  let result :: Text
result = case Text -> Maybe (Text, Char)
T.unsnoc Text
result' of
                    Just (Text
result'', Char
'\n') -> Text
result''
                    Maybe (Text, Char)
_                     -> Text
result'
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> TagParser m Blocks) -> Blocks -> TagParser m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith Attr
attr Text
result

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

inline :: PandocMonad m => TagParser m Inlines
inline :: 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
  Tag Text
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)
  Extensions
exts <- (ReaderOptions -> Extensions)
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  case Tag Text
tag of
    TagOpen Text
name [Attribute Text]
attr ->
      case Text
name of
        Text
"a" | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_epub_html_exts Extensions
exts
          , Just Text
"noteref" <- Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr
          , Just (Char
'#',Text
_) <- Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" [Attribute Text]
attr Maybe Text -> (Text -> Maybe (Char, Text)) -> Maybe (Char, Text)
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
"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
"script"
          | Just Text
x <- Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr
          , Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` Text
x -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pScriptMath
        Text
_ | Text
name Text -> Set Text -> 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 :: (Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing Text -> Bool
f [Attribute Text] -> Bool
g = do
  Tag Text
open <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy ((Text -> Bool) -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
f [Attribute Text] -> Bool
g)
  TagParser m (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (TagParser m (Tag Text)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ())
-> TagParser m (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
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 -> Bool) -> Tag Text -> Bool
forall str. (str -> Bool) -> Tag str -> Bool
tagClose Text -> Bool
f)
  Tag Text -> TagParser m (Tag Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Tag Text
open

pQ :: PandocMonad m => TagParser m Inlines
pQ :: TagParser m Inlines
pQ = do
  TagOpen Text
_ [Attribute Text]
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 -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
"q" (Bool -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
  case Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"cite" [Attribute Text]
attrs of
    Just Text
url -> do
      let uid :: Text
uid = 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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"name" [Attribute Text]
attrs Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute 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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attrs
      Text
url' <- Text -> TagParser m Text
forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl Text
url
      (Inlines -> Inlines) -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote ((Inlines -> Inlines) -> TagParser m Inlines)
-> (Inlines -> Inlines) -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
uid, [Text]
cls, [(Text
"cite", Text -> Text
escapeURI Text
url')])
    Maybe Text
Nothing -> (Inlines -> Inlines) -> TagParser 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
    QuoteContext
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 (Inlines -> Inlines
constructor, QuoteContext
innerContext) = case QuoteContext
ctx of
                  QuoteContext
InDoubleQuote -> (Inlines -> Inlines
B.singleQuoted, QuoteContext
InSingleQuote)
                  QuoteContext
_             -> (Inlines -> Inlines
B.doubleQuoted, QuoteContext
InDoubleQuote)
    Inlines
content <- QuoteContext
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
innerContext
                  ([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
"q"))
    Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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 (Inlines -> Inlines
constructor (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
wrapper) Inlines
content

pEmph :: PandocMonad m => TagParser m Inlines
pEmph :: 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 (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 :: 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 (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 :: 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 :: 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 :: 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 (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 (m :: * -> *) a. MonadPlus m => m a
mzero
    Set Text
htmlSpanLikeElements
  where
    parseTag :: Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
parseTag Text
tagName = do
      TagOpen Text
_ [Attribute Text]
attrs <- (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 -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
tagName (Bool -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
      let (Text
ids, [Text]
cs, [Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attrs
      Inlines
content <- [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
tagName ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
      Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
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
$ Attr -> Inlines -> Inlines
B.spanWith (Text
ids, Text
tagName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs, [Attribute Text]
kvs) Inlines
content

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

pStrikeout :: PandocMonad m => TagParser m Inlines
pStrikeout :: 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 (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 (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 (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 -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"span" [(Text
"class",Text
"strikeout")])
            Inlines
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")
            Inlines -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines) -> Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
B.strikeout Inlines
contents)

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

pLink :: PandocMonad m => TagParser m Inlines
pLink :: TagParser m Inlines
pLink = TagParser m Inlines -> TagParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Inlines -> TagParser m Inlines)
-> TagParser m Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  Tag Text
tag <- (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 -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
"a" (Bool -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
  let title :: Text
title = Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"title" Tag Text
tag
  -- take id from id attribute if present, otherwise name
  let uid :: Text
uid = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"name" Tag Text
tag) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
               Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
"id" Tag Text
tag
  let cls :: [Text]
cls = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"class" Tag Text
tag
  Inlines
lab <- [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
"a")
  -- check for href; if href, then a link, otherwise a span
  case Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
"href" Tag Text
tag of
       Maybe Text
Nothing   ->
         Inlines -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines) -> Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
B.spanWith (Text
uid, [Text]
cls, [])) Inlines
lab
       Just Text
url' -> do
         Text
url <- Text -> TagParser m Text
forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl Text
url'
         Inlines -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines) -> Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Text -> Text -> Inlines -> Inlines
B.linkWith (Text
uid, [Text]
cls, []) (Text -> Text
escapeURI Text
url) Text
title) Inlines
lab

pImage :: PandocMonad m => TagParser m Inlines
pImage :: TagParser m Inlines
pImage = do
  Tag Text
tag <- (Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute 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)
-> ([Attribute Text] -> Maybe Text) -> [Attribute Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src")
  Text
url <- Text -> TagParser m Text
forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl (Text -> TagParser m Text) -> Text -> TagParser m Text
forall a b. (a -> b) -> a -> b
$ Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
tag
  let title :: Text
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
alt = Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"alt" Tag Text
tag
  let uid :: Text
uid = Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"id" Tag Text
tag
  let cls :: [Text]
cls = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"class" Tag Text
tag
  let getAtt :: Text -> [Attribute Text]
getAtt Text
k = case Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
k Tag Text
tag of
                   Text
"" -> []
                   Text
v  -> [(Text
k, Text
v)]
  let kvs :: [Attribute Text]
kvs = (Text -> [Attribute Text]) -> [Text] -> [Attribute Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Attribute Text]
getAtt [Text
"width", Text
"height", Text
"sizes", Text
"srcset"]
  Inlines -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines) -> Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text
uid, [Text]
cls, [Attribute Text]
kvs) (Text -> Text
escapeURI Text
url) Text
title (Text -> Inlines
B.text Text
alt)

pSvg :: PandocMonad m => TagParser m Inlines
pSvg :: TagParser m Inlines
pSvg = do
  Extension -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardDisabled Extension
Ext_raw_html
  -- if raw_html enabled, parse svg tag as raw
  opent :: Tag Text
opent@(TagOpen Text
_ [Attribute Text]
attr') <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"svg" [])
  let (Text
ident,[Text]
cls,[Attribute Text]
_) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
  [Tag Text]
contents <- TagParser m (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Tag Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [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 (Text -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"svg") ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m (Tag Text) -> TagParser m (Tag Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TagParser m (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny)
  Tag Text
closet <- Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"svg" Tag Text
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m (Tag Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"svg" ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  let rawText :: Text
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
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)
  Inlines -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines) -> Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text
ident,[Text]
cls,[]) Text
svgData Text
forall a. Monoid a => a
mempty Inlines
forall a. Monoid a => a
mempty

pCodeWithClass :: PandocMonad m => Text -> Text -> TagParser m Inlines
pCodeWithClass :: Text -> Text -> TagParser m Inlines
pCodeWithClass Text
name Text
class' = TagParser m Inlines -> TagParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Inlines -> TagParser m Inlines)
-> TagParser m Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  TagOpen Text
open [Attribute Text]
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) -> ([Attribute 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 -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
  [Tag Text]
result <- TagParser m (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> 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 TagParser m (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
open)
  let (Text
ids,[Text]
cs,[Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
      cs' :: [Text]
cs'          = Text
class' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs
  Inlines -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines)
-> ([Tag Text] -> Inlines) -> [Tag Text] -> TagParser m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Inlines
B.codeWith (Text
ids,[Text]
cs',[Attribute Text]
kvs) (Text -> Inlines) -> ([Tag Text] -> Text) -> [Tag Text] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    [Text] -> Text
T.unwords ([Text] -> Text) -> ([Tag Text] -> [Text]) -> [Tag Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> ([Tag Text] -> Text) -> [Tag Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> Text
forall str. StringLike str => [Tag str] -> str
innerText ([Tag Text] -> TagParser m Inlines)
-> [Tag Text] -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ [Tag Text]
result

pCode :: PandocMonad m => TagParser m Inlines
pCode :: TagParser m Inlines
pCode = TagParser m Inlines -> TagParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Inlines -> TagParser m Inlines)
-> TagParser m Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  (TagOpen Text
open [Attribute Text]
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) -> ([Attribute Text] -> Bool) -> Tag Text -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"code",Text
"tt"]) (Bool -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
  let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
  [Tag Text]
result <- TagParser m (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> 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 TagParser m (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
open)
  Inlines -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines) -> Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
B.codeWith Attr
attr (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
forall str. StringLike str => [Tag str] -> str
innerText [Tag Text]
result

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

pSpan :: PandocMonad m => TagParser m Inlines
pSpan :: TagParser m Inlines
pSpan = TagParser m Inlines -> TagParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Inlines -> TagParser m Inlines)
-> TagParser m Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  Extension -> ParserT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_native_spans
  TagOpen Text
_ [Attribute Text]
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) -> ([Attribute 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 -> [Attribute Text] -> Bool
forall a b. a -> b -> a
const Bool
True)
  let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
  Inlines
contents <- Text -> TagParser m Inlines -> TagParser m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
  let isSmallCaps :: Bool
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                    where styleAttr :: Text
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [Attribute Text]
attr'
                          fontVariant :: Text
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
                          classes :: [Text]
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 -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr'
  let tag :: Inlines -> Inlines
tag = if Bool
isSmallCaps then Inlines -> Inlines
B.smallcaps else Attr -> Inlines -> Inlines
B.spanWith Attr
attr
  Inlines -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines) -> Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
tag Inlines
contents

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

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

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

pInlinesInTags :: PandocMonad m => Text -> (Inlines -> Inlines)
               -> TagParser m Inlines
pInlinesInTags :: Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
tagtype Inlines -> Inlines
f = (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f (Inlines -> Inlines) -> TagParser m Inlines -> TagParser m 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
tagtype TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline

pTagText :: PandocMonad m => TagParser m Inlines
pTagText :: TagParser m Inlines
pTagText = TagParser m Inlines -> TagParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m Inlines -> TagParser m Inlines)
-> TagParser m Inlines -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  (TagText Text
str) <- (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
isTagText
  HTMLState
st <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  HTMLLocal
qu <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) HTMLLocal
forall r (m :: * -> *). MonadReader r m => m r
ask
  Either ParseError [Inlines]
parsed <- ReaderT HTMLLocal m (Either ParseError [Inlines])
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Either ParseError [Inlines])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT HTMLLocal m (Either ParseError [Inlines])
 -> ParsecT
      [Tag Text]
      HTMLState
      (ReaderT HTMLLocal m)
      (Either ParseError [Inlines]))
-> ReaderT HTMLLocal m (Either ParseError [Inlines])
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     (Either ParseError [Inlines])
forall a b. (a -> b) -> a -> b
$ m (Either ParseError [Inlines])
-> ReaderT HTMLLocal m (Either ParseError [Inlines])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either ParseError [Inlines])
 -> ReaderT HTMLLocal m (Either ParseError [Inlines]))
-> m (Either ParseError [Inlines])
-> ReaderT HTMLLocal m (Either ParseError [Inlines])
forall a b. (a -> b) -> a -> b
$
            (ReaderT HTMLLocal m (Either ParseError [Inlines])
 -> HTMLLocal -> m (Either ParseError [Inlines]))
-> HTMLLocal
-> ReaderT HTMLLocal m (Either ParseError [Inlines])
-> m (Either ParseError [Inlines])
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT HTMLLocal m (Either ParseError [Inlines])
-> HTMLLocal -> m (Either ParseError [Inlines])
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HTMLLocal
qu (ReaderT HTMLLocal m (Either ParseError [Inlines])
 -> m (Either ParseError [Inlines]))
-> ReaderT HTMLLocal m (Either ParseError [Inlines])
-> m (Either ParseError [Inlines])
forall a b. (a -> b) -> a -> b
$ ParsecT Text HTMLState (ReaderT HTMLLocal m) [Inlines]
-> HTMLState
-> String
-> Text
-> ReaderT HTMLLocal m (Either ParseError [Inlines])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (ParsecT Text HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT Text HTMLState (ReaderT HTMLLocal m) [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents) HTMLState
st String
"text" Text
str
  case Either ParseError [Inlines]
parsed of
       Left ParseError
_        -> PandocError -> TagParser m Inlines
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> TagParser m Inlines)
-> PandocError -> TagParser 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 -> TagParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> TagParser m Inlines) -> Inlines -> TagParser 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 Text

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

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

pStr :: PandocMonad m => InlinesParser m Inlines
pStr :: InlinesParser m Inlines
pStr = do
  String
result <- ParsecT Text HTMLState (ReaderT HTMLLocal m) Char
-> ParsecT Text 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]
many1 (ParsecT Text HTMLState (ReaderT HTMLLocal m) Char
 -> ParsecT Text HTMLState (ReaderT HTMLLocal m) String)
-> ParsecT Text HTMLState (ReaderT HTMLLocal m) Char
-> ParsecT Text HTMLState (ReaderT HTMLLocal m) String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT Text HTMLState (ReaderT HTMLLocal m) Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool)
 -> ParsecT Text HTMLState (ReaderT HTMLLocal m) Char)
-> (Char -> Bool)
-> ParsecT Text 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)
  ParserT Text HTMLState (ReaderT HTMLLocal m) ()
forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParserT s st m ()
updateLastStrPos
  Inlines -> InlinesParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> InlinesParser m Inlines)
-> Inlines -> InlinesParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
result

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

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

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

getTagName :: Tag Text -> Maybe Text
getTagName :: Tag Text -> Maybe Text
getTagName (TagOpen Text
t [Attribute Text]
_) = 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 -> Maybe Text
getTagName Tag Text
t of
    Maybe Text
Nothing  -> Bool
False
    Just Text
"script" -> 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
    Just 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)
               -> ParserT Text st m Text
htmlInBalanced :: (Tag Text -> Bool) -> ParserT Text st m Text
htmlInBalanced Tag Text -> Bool
f = ParserT Text st m Text -> ParserT Text st m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m Text -> ParserT Text st m Text)
-> ParserT Text st m Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text st m Char -> ParsecT Text 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 Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<')
  Text
inp <- ParserT Text st m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  let ts :: [Tag Text]
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 :: Bool
optTagWarning = Bool
True,
                                       optTagPosition :: Bool
optTagPosition = Bool
True } Text
inp
  case [Tag Text]
ts of
    (TagPosition Int
sr Int
sc : t :: Tag Text
t@(TagOpen Text
tn [Attribute Text]
_) : [Tag Text]
rest) -> do
       Bool -> ParsecT Text st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text st m ()) -> Bool -> ParsecT Text st m ()
forall a b. (a -> b) -> a -> b
$ Tag Text -> Bool
f Tag Text
t
       Bool -> ParsecT Text st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text st m ()) -> Bool -> ParsecT Text 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
            []  -> ParserT Text st m Text
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
                          Text
lscontents <- [Text] -> Text
T.unlines ([Text] -> Text)
-> ParsecT Text st m [Text] -> ParserT Text st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParserT Text st m Text -> ParsecT Text 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 ParserT Text st m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
anyLine
                          String
cscontents <- Int -> ParsecT Text st m Char -> ParsecT Text 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 Int
cs ParsecT Text st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
                          String
closetag <- do
                            String
x <- ParsecT Text st m Char -> ParsecT Text st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'>'))
                            Char -> ParsecT Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
                            String -> ParsecT Text st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">")
                          Text -> ParserT Text st m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT Text st m Text) -> Text -> ParserT Text st m Text
forall a b. (a -> b) -> a -> b
$ Text
lscontents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cscontents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
closetag
                        [Tag Text]
_ -> ParserT Text st m Text
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    [Tag Text]
_ -> ParserT Text st m Text
forall (m :: * -> *) a. MonadPlus m => m a
mzero

htmlInBalanced' :: Text
                -> [Tag Text]
                -> [Tag Text]
htmlInBalanced' :: Text -> [Tag Text] -> [Tag Text]
htmlInBalanced' Text
tagname [Tag Text]
ts = [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' [Attribute 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 (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 (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)
        -> ParserT Text st m (Tag Text, Text)
htmlTag :: (Tag Text -> Bool) -> ParserT Text st m (Tag Text, Text)
htmlTag Tag Text -> Bool
f = ParserT Text st m (Tag Text, Text)
-> ParserT Text st m (Tag Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text st m (Tag Text, Text)
 -> ParserT Text st m (Tag Text, Text))
-> ParserT Text st m (Tag Text, Text)
-> ParserT Text st m (Tag Text, Text)
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text st m Char -> ParsecT Text 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 Text st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<')
  SourcePos
startpos <- ParsecT Text st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Text
inp <- ParsecT Text st m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  let ts :: [Tag Text]
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 :: Bool
optTagWarning = Bool
False
                                           , optTagPosition :: Bool
optTagPosition = Bool
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
  (Tag Text
next, Int
ln, Int
col) <- case [Tag Text]
ts of
                      (TagPosition{} : Tag Text
next : TagPosition Int
ln Int
col : [Tag Text]
_)
                        | Tag Text -> Bool
f Tag Text
next -> (Tag Text, Int, Int) -> ParsecT Text st m (Tag Text, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, Int
ln, Int
col)
                      [Tag Text]
_ -> ParsecT Text st m (Tag Text, Int, Int)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

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

-- Utilities

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