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

import Control.Applicative ((<|>))
import Control.Arrow (first)
import Control.Monad (guard, mplus, msum, mzero, unless, void)
import Control.Monad.Except (throwError)
import Control.Monad.Reader (ReaderT, ask, asks, lift, local, runReaderT)
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 (URI, nonStrictRelativeTo, parseURIReference)
import Text.HTML.TagSoup
import Text.HTML.TagSoup.Match
import Text.Pandoc.Builder (Blocks, HasMeta (..), Inlines, trimInlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Definition
import Text.Pandoc.Readers.LaTeX (rawLaTeXInline)
import Text.Pandoc.Readers.LaTeX.Types (Macro)
import Text.Pandoc.XML (html5Attributes, html4Attributes, rdfaAttributes)
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, elemText, splitTextBy,
                           onlySimpleTableCells, safeRead, tshow)
import Text.Pandoc.Walk
import Text.Parsec.Error
import Text.TeXMath (readMathML, writeTeX)
import Data.ByteString.Base64 (encode)

-- | 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]) -> [Tag Text] -> [Tag Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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

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

data HTMLState =
  HTMLState
  {  HTMLState -> ParserState
parserState :: ParserState,
     HTMLState -> [(Text, Blocks)]
noteTable   :: [(Text, Blocks)],
     HTMLState -> Maybe URI
baseHref    :: Maybe URI,
     HTMLState -> Set Text
identifiers :: Set.Set Text,
     HTMLState -> [LogMessage]
logMessages :: [LogMessage],
     HTMLState -> Map Text Macro
macros      :: M.Map Text Macro,
     HTMLState -> ReaderOptions
readerOpts  :: ReaderOptions
  }

data HTMLLocal = HTMLLocal { HTMLLocal -> QuoteContext
quoteContext :: QuoteContext
                           , HTMLLocal -> Bool
inChapter    :: Bool -- ^ Set if in chapter section
                           , HTMLLocal -> Bool
inPlain      :: Bool -- ^ Set if in pPlain
                           }

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})

type HTMLParser m s = ParserT s HTMLState (ReaderT HTMLLocal m)

type TagParser m = HTMLParser m [Tag Text]

pHtml :: PandocMonad m => TagParser m Blocks
pHtml :: TagParser m Blocks
pHtml = 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
"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) ((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 = 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
  Blocks
res <- [TagParser m Blocks] -> TagParser m Blocks
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
            [ TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eSection
            , (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
            , 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
            , 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
            , 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
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPara
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBlockQuote
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pCodeBlock
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pList
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHrule
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pTable
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHtml
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHead
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBody
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pLineBlock
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPlain
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pFigure
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pIframe
            , TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
            ]
  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)
  Blocks -> TagParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return 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)

pList :: PandocMonad m => TagParser m Blocks
pList :: TagParser m Blocks
pList = TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList 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
pOrderedList 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
pDefinitionList

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 (Int
start, ListNumberStyle
style) = (Int
sta', ListNumberStyle
sty')
                       where sta :: Text
sta = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"1" (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
"start" [Attribute Text]
attribs
                             sta' :: Int
sta' = 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 -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
sta

                             pickListStyle :: Text -> Maybe Text
pickListStyle = [Text] -> Text -> Maybe Text
pickStyleAttrProps [Text
"list-style-type", Text
"list-style"]

                             typeAttr :: Text
typeAttr  = 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]
attribs
                             classAttr :: Text
classAttr = 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
"class" [Attribute Text]
attribs
                             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]
attribs
                             listStyle :: Text
listStyle = 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 -> Maybe Text
pickListStyle Text
styleAttr

                             sty' :: ListNumberStyle
sty' = ListNumberStyle -> [ListNumberStyle] -> ListNumberStyle
forall a. Eq a => a -> [a] -> a
foldOrElse ListNumberStyle
DefaultStyle
                                      [ Text -> ListNumberStyle
parseTypeAttr      Text
typeAttr
                                      , Text -> ListNumberStyle
parseListStyleType Text
classAttr
                                      , Text -> ListNumberStyle
parseListStyleType Text
listStyle
                                      ]
  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

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
  let isDivLike :: a -> Bool
isDivLike a
"div"     = Bool
True
      isDivLike a
"section" = Bool
True
      isDivLike a
"main"    = Bool
True
      isDivLike a
_         = Bool
False
  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
forall a. (Eq a, IsString a) => a -> 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
  (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

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

pTable :: PandocMonad m => TagParser m Blocks
pTable :: TagParser m Blocks
pTable = 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
"table" [])
  let attribs :: Attr
attribs = [Attribute Text] -> Attr
toAttr [Attribute Text]
attribs'
  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
  Inlines
caption <- Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty (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
$ 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
"caption" ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline 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
  [ColWidth]
widths' <- ([[ColWidth]] -> [ColWidth]
forall a. Monoid a => [a] -> a
mconcat ([[ColWidth]] -> [ColWidth])
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [[ColWidth]]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [ColWidth]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [ColWidth]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [[ColWidth]]
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) [ColWidth]
forall (m :: * -> *). PandocMonad m => TagParser m [ColWidth]
pColgroup) ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [ColWidth]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [ColWidth]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [ColWidth]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ColWidth
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [ColWidth]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ColWidth
forall (m :: * -> *). PandocMonad m => TagParser m ColWidth
pCol
  let pTh :: ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
pTh = [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT
   [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
 -> ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)])
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall a b. (a -> b) -> a -> b
$ Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"tr" (Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *).
PandocMonad m =>
Text -> TagParser m [(Alignment, Blocks)]
pCell Text
"th")
      pTr :: ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
pTr = ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT
   [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
 -> ParsecT
      [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)])
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall a b. (a -> b) -> a -> b
$ 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) ()
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"tr" (Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *).
PandocMonad m =>
Text -> TagParser m [(Alignment, Blocks)]
pCell Text
"td" ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *).
PandocMonad m =>
Text -> TagParser m [(Alignment, Blocks)]
pCell Text
"th")
      pTBody :: TagParser m [[(Alignment, Blocks)]]
pTBody = Bool
-> Text
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall (m :: * -> *) a.
PandocMonad m =>
Bool -> Text -> TagParser m a -> TagParser m a
pInTag Bool
True Text
"tbody" (TagParser m [[(Alignment, Blocks)]]
 -> TagParser m [[(Alignment, Blocks)]])
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall a b. (a -> b) -> a -> b
$ ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> TagParser m [[(Alignment, 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) [(Alignment, Blocks)]
pTr
  [(Alignment, Blocks)]
head'' <- Bool
-> Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *) a.
PandocMonad m =>
Bool -> Text -> TagParser m a -> TagParser m a
pInTag Bool
False Text
"thead" ([(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
pTr) ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
-> Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *) a.
PandocMonad m =>
Bool -> Text -> TagParser m a -> TagParser m a
pInTag Bool
True Text
"thead" ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
pTh
  [Blocks]
head'  <- ((Alignment, Blocks) -> Blocks)
-> [(Alignment, Blocks)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment, Blocks) -> Blocks
forall a b. (a, b) -> b
snd ([(Alignment, Blocks)] -> [Blocks])
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             Bool
-> Text
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *) a.
PandocMonad m =>
Bool -> Text -> TagParser m a -> TagParser m a
pInTag Bool
True Text
"tbody"
               (if [(Alignment, Blocks)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Alignment, Blocks)]
head'' then ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
pTh else [(Alignment, Blocks)]
-> ParsecT
     [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Alignment, Blocks)]
head'')
  [[(Alignment, Blocks)]]
topfoot <- [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (TagParser m [[(Alignment, Blocks)]]
 -> TagParser m [[(Alignment, Blocks)]])
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Text
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall (m :: * -> *) a.
PandocMonad m =>
Bool -> Text -> TagParser m a -> TagParser m a
pInTag Bool
False Text
"tfoot" (TagParser m [[(Alignment, Blocks)]]
 -> TagParser m [[(Alignment, Blocks)]])
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall a b. (a -> b) -> a -> b
$ ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> TagParser m [[(Alignment, Blocks)]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
pTr
  [[[(Alignment, Blocks)]]]
rowsLs <- TagParser m [[(Alignment, Blocks)]]
-> ParsecT
     [Tag Text]
     HTMLState
     (ReaderT HTMLLocal m)
     [[[(Alignment, Blocks)]]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many TagParser m [[(Alignment, Blocks)]]
pTBody
  [[(Alignment, Blocks)]]
bottomfoot <- [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (TagParser m [[(Alignment, Blocks)]]
 -> TagParser m [[(Alignment, Blocks)]])
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall a b. (a -> b) -> a -> b
$ Bool
-> Text
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall (m :: * -> *) a.
PandocMonad m =>
Bool -> Text -> TagParser m a -> TagParser m a
pInTag Bool
False Text
"tfoot" (TagParser m [[(Alignment, Blocks)]]
 -> TagParser m [[(Alignment, Blocks)]])
-> TagParser m [[(Alignment, Blocks)]]
-> TagParser m [[(Alignment, Blocks)]]
forall a b. (a -> b) -> a -> b
$ ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
-> TagParser m [[(Alignment, Blocks)]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT
  [Tag Text] HTMLState (ReaderT HTMLLocal m) [(Alignment, Blocks)]
pTr
  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
"table")
  let rows'' :: [[(Alignment, Blocks)]]
rows'' = [[[(Alignment, Blocks)]]] -> [[(Alignment, Blocks)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[(Alignment, Blocks)]]]
rowsLs [[(Alignment, Blocks)]]
-> [[(Alignment, Blocks)]] -> [[(Alignment, Blocks)]]
forall a. Semigroup a => a -> a -> a
<> [[(Alignment, Blocks)]]
topfoot [[(Alignment, Blocks)]]
-> [[(Alignment, Blocks)]] -> [[(Alignment, Blocks)]]
forall a. Semigroup a => a -> a -> a
<> [[(Alignment, Blocks)]]
bottomfoot
  let rows''' :: [[Blocks]]
rows''' = ([(Alignment, Blocks)] -> [Blocks])
-> [[(Alignment, Blocks)]] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map (((Alignment, Blocks) -> Blocks)
-> [(Alignment, Blocks)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment, Blocks) -> Blocks
forall a b. (a, b) -> b
snd) [[(Alignment, Blocks)]]
rows''
  -- fail on empty table
  Bool -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ())
-> Bool -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
head' Bool -> Bool -> Bool
&& [[Blocks]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Blocks]]
rows'''
  let isSimple :: Bool
isSimple = [[[Block]]] -> Bool
onlySimpleTableCells ([[[Block]]] -> Bool) -> [[[Block]]] -> Bool
forall a b. (a -> b) -> a -> b
$ (Blocks -> [Block]) -> [Blocks] -> [[Block]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Blocks -> [Block]
forall a. Many a -> [a]
B.toList ([Blocks] -> [[Block]]) -> [[Blocks]] -> [[[Block]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Blocks]
head'[Blocks] -> [[Blocks]] -> [[Blocks]]
forall a. a -> [a] -> [a]
:[[Blocks]]
rows'''
  let cols :: Int
cols = if [Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
head'
                then [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([Blocks] -> Int) -> [[Blocks]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Blocks]]
rows''')
                else [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Blocks]
head'
  -- add empty cells to short rows
  let addEmpties :: [a] -> [a]
addEmpties [a]
r = case Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
r of
                           Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> [a]
r [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
n a
forall a. Monoid a => a
mempty
                             | Bool
otherwise -> [a]
r
  let rows :: [[Blocks]]
rows = ([Blocks] -> [Blocks]) -> [[Blocks]] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> [Blocks]
forall a. Monoid a => [a] -> [a]
addEmpties [[Blocks]]
rows'''
  let aligns :: [Alignment]
aligns = case [[(Alignment, Blocks)]]
rows'' of
                    ([(Alignment, Blocks)]
cs:[[(Alignment, Blocks)]]
_) -> Int -> [Alignment] -> [Alignment]
forall a. Int -> [a] -> [a]
take Int
cols ([Alignment] -> [Alignment]) -> [Alignment] -> [Alignment]
forall a b. (a -> b) -> a -> b
$ ((Alignment, Blocks) -> Alignment)
-> [(Alignment, Blocks)] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment, Blocks) -> Alignment
forall a b. (a, b) -> a
fst [(Alignment, Blocks)]
cs [Alignment] -> [Alignment] -> [Alignment]
forall a. [a] -> [a] -> [a]
++ Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault
                    [[(Alignment, Blocks)]]
_      -> Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
cols Alignment
AlignDefault
  let widths :: [ColWidth]
widths = if [ColWidth] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColWidth]
widths'
                  then if Bool
isSimple
                       then Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
cols ColWidth
ColWidthDefault
                       else Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
cols (Double -> ColWidth
ColWidth (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols))
                  else [ColWidth]
widths'
  let toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
B.simpleCell
      toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
  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
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Blocks
B.tableWith Attr
attribs
                   (Blocks -> Caption
B.simpleCaption (Blocks -> Caption) -> Blocks -> Caption
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain Inlines
caption)
                   ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [ColWidth]
widths)
                   (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ [Blocks] -> [Row]
toHeaderRow [Blocks]
head')
                   [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
rows]
                   (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])

pCol :: PandocMonad m => TagParser m ColWidth
pCol :: TagParser m ColWidth
pCol = TagParser m ColWidth -> TagParser m ColWidth
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m ColWidth -> TagParser m ColWidth)
-> TagParser m ColWidth -> TagParser m ColWidth
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
"col" [])
  let attribs :: [Attribute Text]
attribs = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attribs'
  ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
  TagParser m (Tag Text)
-> 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 -> Tag Text -> Bool
matchTagClose Text
"col")
  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 width :: Double
width = case Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [Attribute Text]
attribs of
                Maybe Text
Nothing -> case Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [Attribute Text]
attribs of
                  Just (Text -> Text -> Maybe Text
T.stripPrefix Text
"width:" -> Just Text
xs) | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%') Text
xs ->
                    Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead ((Char -> Bool) -> Text -> Text
T.filter
                      (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
" \t\r\n%'\";" :: [Char])) Text
xs)
                  Maybe Text
_ -> Double
0.0
                Just (Text -> Maybe (Text, Char)
T.unsnoc -> Just (Text
xs, Char
'%')) ->
                  Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
xs
                Maybe Text
_ -> Double
0.0
  if Double
width Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0.0
    then ColWidth -> TagParser m ColWidth
forall (m :: * -> *) a. Monad m => a -> m a
return (ColWidth -> TagParser m ColWidth)
-> ColWidth -> TagParser m ColWidth
forall a b. (a -> b) -> a -> b
$ Double -> ColWidth
ColWidth (Double -> ColWidth) -> Double -> ColWidth
forall a b. (a -> b) -> a -> b
$ Double
width Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0
    else ColWidth -> TagParser m ColWidth
forall (m :: * -> *) a. Monad m => a -> m a
return ColWidth
ColWidthDefault

pColgroup :: PandocMonad m => TagParser m [ColWidth]
pColgroup :: TagParser m [ColWidth]
pColgroup = TagParser m [ColWidth] -> TagParser m [ColWidth]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m [ColWidth] -> TagParser m [ColWidth])
-> TagParser m [ColWidth] -> TagParser m [ColWidth]
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
"colgroup" [])
  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) ColWidth
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m [ColWidth]
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) ColWidth
forall (m :: * -> *). PandocMonad m => TagParser m ColWidth
pCol (Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"colgroup" 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) TagParser m [ColWidth]
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> TagParser m [ColWidth]
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

noColOrRowSpans :: Tag Text -> Bool
noColOrRowSpans :: Tag Text -> Bool
noColOrRowSpans Tag Text
t = Text -> Bool
isNullOrOne Text
"colspan" Bool -> Bool -> Bool
&& Text -> Bool
isNullOrOne Text
"rowspan"
  where isNullOrOne :: Text -> Bool
isNullOrOne Text
x = case Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
x Tag Text
t of
                              Text
""  -> Bool
True
                              Text
"1" -> Bool
True
                              Text
_   -> Bool
False

pCell :: PandocMonad m => Text -> TagParser m [(Alignment, Blocks)]
pCell :: Text -> TagParser m [(Alignment, Blocks)]
pCell Text
celltype = TagParser m [(Alignment, Blocks)]
-> TagParser m [(Alignment, Blocks)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (TagParser m [(Alignment, Blocks)]
 -> TagParser m [(Alignment, Blocks)])
-> TagParser m [(Alignment, Blocks)]
-> TagParser m [(Alignment, Blocks)]
forall a b. (a -> b) -> a -> b
$ 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
  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 (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
t -> Tag Text
t 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
celltype [] Bool -> Bool -> Bool
&& Tag Text -> Bool
noColOrRowSpans Tag Text
t)
  let extractAlign' :: [p] -> p
extractAlign' []                 = p
""
      extractAlign' (p
"text-align":p
x:[p]
_) = p
x
      extractAlign' (p
_:[p]
xs)             = [p] -> p
extractAlign' [p]
xs
  let extractAlign :: Text -> Text
extractAlign = [Text] -> Text
forall p. (IsString p, Eq p) => [p] -> p
extractAlign' ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Text -> Bool
`elemText` Text
" \t;:")
  let align :: Alignment
align = case Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
"align" Tag Text
tag Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                   (Text -> Text
extractAlign (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
"style" Tag Text
tag) of
                   Just Text
"left"   -> Alignment
AlignLeft
                   Just Text
"right"  -> Alignment
AlignRight
                   Just Text
"center" -> Alignment
AlignCenter
                   Maybe Text
_             -> Alignment
AlignDefault
  Blocks
res <- Text
-> (Tag Text -> Bool) -> TagParser m Blocks -> TagParser m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> (Tag Text -> Bool) -> TagParser m a -> TagParser m a
pInTags' Text
celltype Tag Text -> Bool
noColOrRowSpans TagParser m Blocks
forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
  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
  [(Alignment, Blocks)] -> TagParser m [(Alignment, Blocks)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Alignment
align, Blocks
res)]

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
<$>
               (Bool
-> Text
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
forall (m :: * -> *) a.
PandocMonad m =>
Bool -> Text -> TagParser m a -> TagParser m a
pInTag Bool
True 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] -> TagParser m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
           [ TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
eNoteref
           , (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
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pQ
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSuperscript
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSubscript
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpanLike
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSmall
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLineBreak
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLink
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pImage
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSvg
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pBdo
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode
           , [Attribute Text] -> TagParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Attribute Text] -> TagParser m Inlines
pCodeWithClass [(Text
"samp",Text
"sample"),(Text
"var",Text
"variable")]
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpan
           , Bool -> TagParser m Inlines
forall (m :: * -> *). PandocMonad m => Bool -> TagParser m Inlines
pMath Bool
False
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pScriptMath
           , TagParser m Inlines
forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline
           ]

pLocation :: PandocMonad m => TagParser m ()
pLocation :: TagParser m ()
pLocation = do
  (TagPosition Int
r Int
c) <- (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSat Tag Text -> Bool
forall str. Tag str -> Bool
isTagPosition
  SourcePos -> TagParser m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> TagParser m ()) -> SourcePos -> TagParser m ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> SourcePos
newPos String
"input" Int
r Int
c

pSat :: PandocMonad m => (Tag Text -> Bool) -> TagParser m (Tag Text)
pSat :: (Tag Text -> Bool) -> TagParser m (Tag Text)
pSat Tag Text -> Bool
f = do
  SourcePos
pos <- ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  (Tag Text -> Text)
-> (Tag Text -> SourcePos)
-> (Tag Text -> Maybe (Tag Text))
-> TagParser m (Tag Text)
forall s (m :: * -> *) t a st.
Stream s m t =>
(t -> Text)
-> (t -> SourcePos) -> (t -> Maybe a) -> ParsecT s st m a
token Tag Text -> Text
forall a. Show a => a -> Text
tshow (SourcePos -> Tag Text -> SourcePos
forall a b. a -> b -> a
const SourcePos
pos) (\Tag Text
x -> if Tag Text -> Bool
f Tag Text
x then Tag Text -> Maybe (Tag Text)
forall a. a -> Maybe a
Just Tag Text
x else Maybe (Tag Text)
forall a. Maybe a
Nothing)

pSatisfy :: PandocMonad m => (Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy :: (Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
f = 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
$ ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> 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 ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (m :: * -> *). PandocMonad m => TagParser m ()
pLocation ParsecT [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
>> (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSat Tag Text -> Bool
f

pAny :: PandocMonad m => TagParser m (Tag Text)
pAny :: TagParser m (Tag Text)
pAny = (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Bool -> Tag Text -> Bool
forall a b. a -> b -> a
const Bool
True)

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 = [TagParser m Inlines] -> TagParser m Inlines
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([TagParser m Inlines] -> TagParser m Inlines)
-> [TagParser m Inlines] -> TagParser m Inlines
forall a b. (a -> b) -> a -> b
$ (TagParser m Inlines -> TagParser m Inlines)
-> [TagParser m Inlines] -> [TagParser m Inlines]
forall a b. (a -> b) -> [a] -> [b]
map 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
citedQuote, TagParser m Inlines
normalQuote]
  where citedQuote :: TagParser m Inlines
citedQuote = 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
"q" ((Attribute Text -> Bool) -> [Attribute Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"cite") (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))

          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
"cite" Tag Text
tag
          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 -> 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)])
        normalQuote :: TagParser m Inlines
normalQuote = do
          (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)
          (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
        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

-- Unlike fromAttrib from tagsoup, this distinguishes
-- between a missing attribute and an attribute with empty content.
maybeFromAttrib :: Text -> Tag Text -> Maybe Text
maybeFromAttrib :: Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
name (TagOpen Text
_ [Attribute Text]
attrs) = Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name [Attribute Text]
attrs
maybeFromAttrib Text
_ Tag Text
_ = Maybe Text
forall a. Maybe a
Nothing

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 => [(T.Text,Text)] -> TagParser m Inlines
pCodeWithClass :: [Attribute Text] -> TagParser m Inlines
pCodeWithClass [Attribute Text]
elemToClass = 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
  let tagTest :: Text -> Bool
tagTest = (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Text] -> Text -> Bool)
-> ([Attribute Text] -> [Text]) -> [Attribute Text] -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute Text -> Text) -> [Attribute Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attribute Text -> Text
forall a b. (a, b) -> a
fst ([Attribute Text] -> Text -> Bool)
-> [Attribute Text] -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Attribute Text]
elemToClass
  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 -> Bool
tagTest (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] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text]
cs (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
cs) (Maybe Text -> [Text])
-> ([Attribute Text] -> Maybe Text) -> [Attribute Text] -> [Text]
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
open ([Attribute Text] -> [Text]) -> [Attribute Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Attribute Text]
elemToClass
  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
forall a. NamedTag (Tag a) => Tag a -> 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
forall a. NamedTag (Tag a) => Tag a -> 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

toStringAttr :: [(Text, Text)] -> [(Text, Text)]
toStringAttr :: [Attribute Text] -> [Attribute Text]
toStringAttr = (Attribute Text -> Attribute Text)
-> [Attribute Text] -> [Attribute Text]
forall a b. (a -> b) -> [a] -> [b]
map Attribute Text -> Attribute Text
forall b. (Text, b) -> (Text, b)
go
  where
   go :: (Text, b) -> (Text, b)
go (Text
x,b
y) =
     case Text -> Text -> Maybe Text
T.stripPrefix Text
"data-" Text
x of
       Just Text
x' | Text
x' Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` (Set Text
html5Attributes Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<>
                                     Set Text
html4Attributes Set Text -> Set Text -> Set Text
forall a. Semigroup a => a -> a -> a
<> Set Text
rdfaAttributes)
         -> (Text
x',b
y)
       Maybe Text
_ -> (Text
x,b
y)

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

pInTags :: (PandocMonad m, Monoid a) => Text -> TagParser m a -> TagParser m a
pInTags :: Text -> TagParser m a -> TagParser m a
pInTags Text
tagtype TagParser m a
parser = Text -> (Tag Text -> Bool) -> TagParser m a -> TagParser m a
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> (Tag Text -> Bool) -> TagParser m a -> TagParser m a
pInTags' Text
tagtype (Bool -> Tag Text -> Bool
forall a b. a -> b -> a
const Bool
True) TagParser m a
parser

pInTags' :: (PandocMonad m, Monoid a)
         => Text
         -> (Tag Text -> Bool)
         -> TagParser m a
         -> TagParser m a
pInTags' :: Text -> (Tag Text -> Bool) -> TagParser m a -> TagParser m a
pInTags' Text
tagtype Tag Text -> Bool
tagtest 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
  (Tag Text -> Bool) -> TagParser m (Tag Text)
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\Tag Text
t -> Tag Text
t 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
tagtype [] Bool -> Bool -> Bool
&& Tag Text -> Bool
tagtest Tag Text
t)
  [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [a]
-> TagParser m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TagParser m a
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) [a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill TagParser m a
parser (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)

-- parses p, preceded by an opening tag (optional if tagsOptional)
-- and followed by a closing tag (optional if tagsOptional)
pInTag :: PandocMonad m => Bool -> Text -> TagParser m a -> TagParser m a
pInTag :: Bool -> Text -> TagParser m a -> TagParser m a
pInTag Bool
tagsOptional Text
tagtype TagParser m a
p = 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
  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
  (if Bool
tagsOptional then ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal 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 else ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void) (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ())
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
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
tagtype [])
  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
  a
x <- TagParser m a
p
  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
  (if Bool
tagsOptional then ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal 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 else ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void) (ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
 -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ())
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) ()
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 -> Tag Text -> Bool
matchTagClose Text
tagtype)
  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
  a -> TagParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

pCloses :: PandocMonad m => Text -> TagParser m ()
pCloses :: Text -> TagParser m ()
pCloses Text
tagtype = 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
  Tag Text
t <- 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
$ \Tag Text
tag -> Tag Text -> Bool
forall str. Tag str -> Bool
isTagClose Tag Text
tag Bool -> Bool -> Bool
|| Tag Text -> Bool
forall str. Tag str -> Bool
isTagOpen Tag Text
tag
  case Tag Text
t of
       (TagClose Text
t') | Text
t' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tagtype -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
-> TagParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) (Tag Text)
forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
       (TagOpen Text
t' [Attribute Text]
_) | Text
t' Text -> Text -> Bool
`closes` Text
tagtype -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
"ul") | Text
tagtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"li" -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
"ol") | Text
tagtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"li" -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
"dl") | Text
tagtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dd" -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
"table") | Text
tagtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"td" -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
"table") | Text
tagtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"th" -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
"table") | Text
tagtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"tr" -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
"td") | Text
tagtype Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockHtmlTags -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
"th") | Text
tagtype Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockHtmlTags -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       (TagClose Text
t') | Text
tagtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"p" Bool -> Bool -> Bool
&& Text
t' Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockHtmlTags
                                            -> () -> TagParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- see #3794
       Tag Text
_ -> TagParser m ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

pBlank :: PandocMonad m => TagParser m ()
pBlank :: TagParser m ()
pBlank = 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
  (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
  Bool -> TagParser m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> TagParser m ()) -> Bool -> TagParser m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
str

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

--
-- Constants
--

eitherBlockOrInline :: Set.Set Text
eitherBlockOrInline :: Set Text
eitherBlockOrInline = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
  [Text
"audio", Text
"applet", Text
"button", Text
"iframe", Text
"embed",
   Text
"del", Text
"ins", Text
"progress", Text
"map", Text
"area", Text
"noscript", Text
"script",
   Text
"object", Text
"svg", Text
"video", Text
"source"]

blockHtmlTags :: Set.Set Text
blockHtmlTags :: Set Text
blockHtmlTags = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
   [Text
"?xml", Text
"!DOCTYPE", Text
"address", Text
"article", Text
"aside",
    Text
"blockquote", Text
"body", Text
"canvas",
    Text
"caption", Text
"center", Text
"col", Text
"colgroup", Text
"dd", Text
"details",
    Text
"dir", Text
"div", Text
"dl", Text
"dt", Text
"fieldset", Text
"figcaption", Text
"figure",
    Text
"footer", Text
"form", Text
"h1", Text
"h2", Text
"h3", Text
"h4",
    Text
"h5", Text
"h6", Text
"head", Text
"header", Text
"hgroup", Text
"hr", Text
"html",
    Text
"isindex", Text
"main", Text
"menu", Text
"meta", Text
"noframes", Text
"nav",
    Text
"ol", Text
"output", Text
"p", Text
"pre",
    Text
"section", Text
"summary", Text
"table", Text
"tbody", Text
"textarea",
    Text
"thead", Text
"tfoot", Text
"ul", Text
"dd",
    Text
"dt", Text
"frameset", Text
"li", Text
"tbody", Text
"td", Text
"tfoot",
    Text
"th", Text
"thead", Text
"tr", Text
"script", Text
"style"]

-- We want to allow raw docbook in markdown documents, so we
-- include docbook block tags here too.
blockDocBookTags :: Set.Set Text
blockDocBookTags :: Set Text
blockDocBookTags = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
   [Text
"calloutlist", Text
"bibliolist", Text
"glosslist", Text
"itemizedlist",
    Text
"orderedlist", Text
"segmentedlist", Text
"simplelist",
    Text
"variablelist", Text
"caution", Text
"important", Text
"note", Text
"tip",
    Text
"warning", Text
"address", Text
"literallayout", Text
"programlisting",
    Text
"programlistingco", Text
"screen", Text
"screenco", Text
"screenshot",
    Text
"synopsis", Text
"example", Text
"informalexample", Text
"figure",
    Text
"informalfigure", Text
"table", Text
"informaltable", Text
"para",
    Text
"simpara", Text
"formalpara", Text
"equation", Text
"informalequation",
    Text
"figure", Text
"screenshot", Text
"mediaobject", Text
"qandaset",
    Text
"procedure", Text
"task", Text
"cmdsynopsis", Text
"funcsynopsis",
    Text
"classsynopsis", Text
"blockquote", Text
"epigraph", Text
"msgset",
    Text
"sidebar", Text
"title"]

epubTags :: Set.Set Text
epubTags :: Set Text
epubTags = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
"case", Text
"switch", Text
"default"]

blockTags :: Set.Set Text
blockTags :: Set Text
blockTags = [Set Text] -> Set Text
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text
blockHtmlTags, Set Text
blockDocBookTags, Set Text
epubTags]

class NamedTag a where
  getTagName :: a -> Maybe Text

instance NamedTag (Tag Text) where
  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

instance NamedTag (Tag String) where
  getTagName :: Tag String -> Maybe Text
getTagName (TagOpen String
t [Attribute String]
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
t)
  getTagName (TagClose String
t)  = Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
t)
  getTagName Tag String
_             = Maybe Text
forall a. Maybe a
Nothing

isInlineTag :: NamedTag (Tag a) => Tag a -> Bool
isInlineTag :: Tag a -> Bool
isInlineTag Tag a
t =
  Tag a -> Bool
forall str. Tag str -> Bool
isCommentTag Tag a
t Bool -> Bool -> Bool
|| case Tag a -> Maybe Text
forall a. NamedTag a => a -> Maybe Text
getTagName Tag a
t of
                           Maybe Text
Nothing  -> Bool
False
                           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 :: NamedTag (Tag a) => Tag a -> Bool
isBlockTag :: Tag a -> Bool
isBlockTag Tag a
t = Bool
isBlockTagName Bool -> Bool -> Bool
|| Tag a -> Bool
forall str. Tag str -> Bool
isTagComment Tag a
t
                 where isBlockTagName :: Bool
isBlockTagName =
                         case Tag a -> Maybe Text
forall a. NamedTag a => a -> Maybe Text
getTagName Tag a
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 a -> Bool
isTextTag :: Tag a -> Bool
isTextTag = (a -> Bool) -> Tag a -> Bool
forall str. (str -> Bool) -> Tag str -> Bool
tagText (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)

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

-- taken from HXT and extended
-- See http://www.w3.org/TR/html5/syntax.html sec 8.1.2.4 optional tags
closes :: Text -> Text -> Bool
Text
_ closes :: Text -> Text -> Bool
`closes` Text
"body" = Bool
False
Text
_ `closes` Text
"html" = Bool
False
Text
"body" `closes` Text
"head" = Bool
True
Text
"a" `closes` Text
"a" = Bool
True
Text
"li" `closes` Text
"li" = Bool
True
Text
"th" `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"th",Text
"td"] = Bool
True
Text
"td" `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"th",Text
"td"] = Bool
True
Text
"tr" `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"th",Text
"td",Text
"tr"] = Bool
True
Text
"dd" `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"dt", Text
"dd"] = Bool
True
Text
"dt" `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"dt",Text
"dd"] = Bool
True
Text
"rt" `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"rb", Text
"rt", Text
"rtc"] = Bool
True
Text
"optgroup" `closes` Text
"optgroup" = Bool
True
Text
"optgroup" `closes` Text
"option" = Bool
True
Text
"option" `closes` Text
"option" = Bool
True
-- https://html.spec.whatwg.org/multipage/syntax.html#optional-tags
Text
x `closes` Text
"p" | Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"address", Text
"article", Text
"aside", Text
"blockquote",
   Text
"dir", Text
"div", Text
"dl", Text
"fieldset", Text
"footer", Text
"form", Text
"h1", Text
"h2", Text
"h3", Text
"h4",
   Text
"h5", Text
"h6", Text
"header", Text
"hr", Text
"main", Text
"menu", Text
"nav", Text
"ol", Text
"p", Text
"pre", Text
"section",
   Text
"table", Text
"ul"] = Bool
True
Text
_ `closes` Text
"meta" = Bool
True
Text
"form" `closes` Text
"form" = Bool
True
Text
"label" `closes` Text
"label" = Bool
True
Text
"map" `closes` Text
"map" = Bool
True
Text
"object" `closes` Text
"object" = Bool
True
Text
_ `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"option",Text
"style",Text
"script",Text
"textarea",Text
"title"] = Bool
True
Text
t `closes` Text
"select" | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"option" = Bool
True
Text
"thead" `closes` Text
"colgroup" = Bool
True
Text
"tfoot" `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"thead",Text
"colgroup"] = Bool
True
Text
"tbody" `closes` Text
t | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"tbody",Text
"tfoot",Text
"thead",Text
"colgroup"] = Bool
True
Text
t `closes` Text
t2 |
   Text
t 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",Text
"dl",Text
"ol",Text
"ul",Text
"table",Text
"div",Text
"main",Text
"p"] Bool -> Bool -> Bool
&&
   Text
t2 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",Text
"p" ] = Bool
True -- not "div" or "main"
Text
t1 `closes` Text
t2 |
   Text
t1 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockTags Bool -> Bool -> Bool
&&
   Text
t2 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
blockTags Bool -> Bool -> Bool
&&
   Text
t2 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
eitherBlockOrInline = Bool
True
Text
_ `closes` Text
_ = Bool
False

--- 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
forall a. [Tag a] -> 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 a] -> Bool
hasTagWarning :: [Tag a] -> Bool
hasTagWarning (TagWarning a
_:[Tag a]
_) = Bool
True
hasTagWarning [Tag a]
_                = 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

mkAttr :: [(Text, Text)] -> Attr
mkAttr :: [Attribute Text] -> Attr
mkAttr [Attribute Text]
attr = (Text
attribsId, [Text]
attribsClasses, [Attribute Text]
attribsKV)
  where attribsId :: Text
attribsId = 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
        attribsClasses :: [Text]
attribsClasses = Text -> [Text]
T.words (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
"class" [Attribute Text]
attr) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
epubTypes
        attribsKV :: [Attribute Text]
attribsKV = (Attribute Text -> Bool) -> [Attribute Text] -> [Attribute Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"class" Bool -> Bool -> Bool
&& Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"id") [Attribute Text]
attr
        epubTypes :: [Text]
epubTypes = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ 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
"epub:type" [Attribute Text]
attr

toAttr :: [(Text, Text)] -> Attr
toAttr :: [Attribute Text] -> Attr
toAttr = [Attribute Text] -> Attr
mkAttr ([Attribute Text] -> Attr)
-> ([Attribute Text] -> [Attribute Text])
-> [Attribute Text]
-> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute Text] -> [Attribute Text]
toStringAttr

-- Strip namespace prefixes
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 (Text -> Text
stripPrefix' Text
s) ((Attribute Text -> Attribute Text)
-> [Attribute Text] -> [Attribute Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> Attribute Text -> Attribute Text
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> Text
stripPrefix') [Attribute Text]
as)
stripPrefix (TagClose Text
s) = Text -> Tag Text
forall str. str -> Tag str
TagClose (Text -> Text
stripPrefix' Text
s)
stripPrefix Tag Text
x = Tag Text
x

stripPrefix' :: Text -> Text
stripPrefix' :: Text -> Text
stripPrefix' Text
s =
  if Text -> Bool
T.null Text
t then Text
s else Int -> Text -> Text
T.drop Int
1 Text
t
  where (Text
_, Text
t) = (Char -> Bool) -> Text -> Attribute Text
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Text
s

isSpace :: Char -> Bool
isSpace :: Char -> Bool
isSpace Char
' '  = Bool
True
isSpace Char
'\t' = Bool
True
isSpace Char
'\n' = Bool
True
isSpace Char
'\r' = Bool
True
isSpace Char
_    = Bool
False

-- 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


-- Instances

instance HasMacros HTMLState where
  extractMacros :: HTMLState -> Map Text Macro
extractMacros        = HTMLState -> Map Text Macro
macros
  updateMacros :: (Map Text Macro -> Map Text Macro) -> HTMLState -> HTMLState
updateMacros Map Text Macro -> Map Text Macro
f HTMLState
st    = HTMLState
st{ macros :: Map Text Macro
macros = Map Text Macro -> Map Text Macro
f (Map Text Macro -> Map Text Macro)
-> Map Text Macro -> Map Text Macro
forall a b. (a -> b) -> a -> b
$ HTMLState -> Map Text Macro
macros HTMLState
st }

instance HasIdentifierList HTMLState where
  extractIdentifierList :: HTMLState -> Set Text
extractIdentifierList = HTMLState -> Set Text
identifiers
  updateIdentifierList :: (Set Text -> Set Text) -> HTMLState -> HTMLState
updateIdentifierList Set Text -> Set Text
f HTMLState
s = HTMLState
s{ identifiers :: Set Text
identifiers = Set Text -> Set Text
f (HTMLState -> Set Text
identifiers HTMLState
s) }

instance HasLogMessages HTMLState where
  addLogMessage :: LogMessage -> HTMLState -> HTMLState
addLogMessage LogMessage
m HTMLState
s = HTMLState
s{ logMessages :: [LogMessage]
logMessages = LogMessage
m LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
: HTMLState -> [LogMessage]
logMessages HTMLState
s }
  getLogMessages :: HTMLState -> [LogMessage]
getLogMessages = [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage])
-> (HTMLState -> [LogMessage]) -> HTMLState -> [LogMessage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLState -> [LogMessage]
logMessages

-- This signature should be more general
-- MonadReader HTMLLocal m => HasQuoteContext st m
instance PandocMonad m => HasQuoteContext HTMLState (ReaderT HTMLLocal m) where
  getQuoteContext :: ParsecT s HTMLState (ReaderT HTMLLocal m) QuoteContext
getQuoteContext = (HTMLLocal -> QuoteContext)
-> ParsecT s HTMLState (ReaderT HTMLLocal m) QuoteContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HTMLLocal -> QuoteContext
quoteContext
  withQuoteContext :: QuoteContext
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
withQuoteContext QuoteContext
q = (HTMLLocal -> HTMLLocal)
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
-> ParsecT s HTMLState (ReaderT HTMLLocal m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\HTMLLocal
s -> HTMLLocal
s{quoteContext :: QuoteContext
quoteContext = QuoteContext
q})

instance HasReaderOptions HTMLState where
    extractReaderOptions :: HTMLState -> ReaderOptions
extractReaderOptions = ParserState -> ReaderOptions
forall st. HasReaderOptions st => st -> ReaderOptions
extractReaderOptions (ParserState -> ReaderOptions)
-> (HTMLState -> ParserState) -> HTMLState -> ReaderOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLState -> ParserState
parserState

instance HasMeta HTMLState where
  setMeta :: Text -> b -> HTMLState -> HTMLState
setMeta Text
s b
b HTMLState
st = HTMLState
st {parserState :: ParserState
parserState = Text -> b -> ParserState -> ParserState
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
s b
b (ParserState -> ParserState) -> ParserState -> ParserState
forall a b. (a -> b) -> a -> b
$ HTMLState -> ParserState
parserState HTMLState
st}
  deleteMeta :: Text -> HTMLState -> HTMLState
deleteMeta Text
s HTMLState
st = HTMLState
st {parserState :: ParserState
parserState = Text -> ParserState -> ParserState
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
s (ParserState -> ParserState) -> ParserState -> ParserState
forall a b. (a -> b) -> a -> b
$ HTMLState -> ParserState
parserState HTMLState
st}

instance Default HTMLLocal where
  def :: HTMLLocal
def = QuoteContext -> Bool -> Bool -> HTMLLocal
HTMLLocal QuoteContext
NoQuote Bool
False Bool
False

instance HasLastStrPosition HTMLState where
  setLastStrPos :: Maybe SourcePos -> HTMLState -> HTMLState
setLastStrPos Maybe SourcePos
s HTMLState
st = HTMLState
st {parserState :: ParserState
parserState = Maybe SourcePos -> ParserState -> ParserState
forall st. HasLastStrPosition st => Maybe SourcePos -> st -> st
setLastStrPos Maybe SourcePos
s (HTMLState -> ParserState
parserState HTMLState
st)}
  getLastStrPos :: HTMLState -> Maybe SourcePos
getLastStrPos = ParserState -> Maybe SourcePos
forall st. HasLastStrPosition st => st -> Maybe SourcePos
getLastStrPos (ParserState -> Maybe SourcePos)
-> (HTMLState -> ParserState) -> HTMLState -> Maybe SourcePos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLState -> ParserState
parserState

-- For now we need a special version here; the one in Shared has String type
renderTags' :: [Tag Text] -> Text
renderTags' :: [Tag Text] -> Text
renderTags' = RenderOptions Text -> [Tag Text] -> Text
forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions
               RenderOptions Text
forall str. StringLike str => RenderOptions str
renderOptions{ optMinimize :: Text -> Bool
optMinimize = [Text] -> Text -> Bool
forall (t :: * -> *). Foldable t => t Text -> Text -> Bool
matchTags [Text
"hr", Text
"br", Text
"img",
                                                       Text
"meta", Text
"link"]
                            , optRawTag :: Text -> Bool
optRawTag   = [Text] -> Text -> Bool
forall (t :: * -> *). Foldable t => t Text -> Text -> Bool
matchTags [Text
"script", Text
"style"] }
              where matchTags :: t Text -> Text -> Bool
matchTags t Text
tags = (Text -> t Text -> Bool) -> t Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> t Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t Text
tags (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower


-- EPUB Specific
--
--
sectioningContent :: [Text]
sectioningContent :: [Text]
sectioningContent = [Text
"article", Text
"aside", Text
"nav", Text
"section"]


groupingContent :: [Text]
groupingContent :: [Text]
groupingContent = [Text
"p", Text
"hr", Text
"pre", Text
"blockquote", Text
"ol"
                  , Text
"ul", Text
"li", Text
"dl", Text
"dt", Text
"dt", Text
"dd"
                  , Text
"figure", Text
"figcaption", Text
"div", Text
"main"]

matchTagClose :: Text -> (Tag Text -> Bool)
matchTagClose :: Text -> Tag Text -> Bool
matchTagClose Text
t = (Tag Text -> Tag Text -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== Text -> Tag Text
forall str. str -> Tag str
TagClose Text
t)

matchTagOpen :: Text -> [(Text, Text)] -> (Tag Text -> Bool)
matchTagOpen :: Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
t [Attribute Text]
as = (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
t [Attribute Text]
as)

{-

types :: [(String, ([String], Int))]
types =  -- Document divisions
   map (\s -> (s, (["section", "body"], 0)))
    ["volume", "part", "chapter", "division"]
  <> -- Document section and components
  [
    ("abstract",  ([], 0))]
-}