{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Readers.HTML ( readHtml
, htmlTag
, htmlInBalanced
, isInlineTag
, isBlockTag
, isTextTag
, isCommentTag
, toAttr
) where
import Control.Applicative ((<|>))
import Control.Monad (guard, mzero, unless, void)
import Control.Monad.Except (throwError, catchError)
import Control.Monad.Reader (ask, asks, lift, local, runReaderT)
import Data.Text.Encoding.Base64 (encodeBase64)
import Data.Char (isAlphaNum, isLetter)
import Data.Default (Default (..), def)
import Data.Foldable (for_)
import Data.List.Split (splitWhen)
import Data.List (foldl')
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Either (partitionEithers)
import Data.Monoid (First (..))
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (nonStrictRelativeTo, parseURIReference)
import Text.HTML.TagSoup
import Text.HTML.TagSoup.Match
import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.CSS (pickStyleAttrProps)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Definition
import Text.Pandoc.Readers.HTML.Parsing
import Text.Pandoc.Readers.HTML.Table (pTable)
import Text.Pandoc.Readers.HTML.TagCategories
import Text.Pandoc.Readers.HTML.Types
import Text.Pandoc.Readers.LaTeX (rawLaTeXInline)
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.Options (
Extension (Ext_epub_html_exts, Ext_empty_paragraphs, Ext_native_divs,
Ext_native_spans, Ext_raw_html, Ext_line_blocks, Ext_raw_tex),
ReaderOptions (readerExtensions, readerStripComments),
extensionEnabled)
import Text.Pandoc.Parsing hiding ((<|>))
import Text.Pandoc.Shared (
addMetaField, extractSpaces, htmlSpanLikeElements, renderTags',
safeRead, tshow, formatCode)
import Text.Pandoc.URI (escapeURI)
import Text.Pandoc.Walk
import Text.TeXMath (readMathML, writeTeX)
import qualified Data.Sequence as Seq
readHtml :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readHtml :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readHtml ReaderOptions
opts a
inp = do
let tags :: [Tag Text]
tags = [Tag Text] -> [Tag Text]
stripPrefixes forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags forall a b. (a -> b) -> a -> b
$
forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions forall str. StringLike str => ParseOptions str
parseOptions{ optTagPosition :: Bool
optTagPosition = Bool
True }
(Sources -> Text
sourcesToText forall a b. (a -> b) -> a -> b
$ forall a. ToSources a => a -> Sources
toSources a
inp)
parseDoc :: ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
parseDoc = do
Blocks
blocks <- Bool -> Blocks -> Blocks
fixPlains Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
Meta
meta <- ParserState -> Meta
stateMeta forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLState -> ParserState
parserState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
[Block]
bs' <- forall (m :: * -> *).
PandocMonad m =>
[Block] -> TagParser m [Block]
replaceNotes (forall a. Many a -> [a]
B.toList Blocks
blocks)
forall (m :: * -> *) st s.
(PandocMonad m, HasLogMessages st) =>
ParsecT s st m ()
reportLogMessages
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs'
getError :: ParseError -> String
getError (ParseError -> [Message]
errorMessages -> [Message]
ms) = case [Message]
ms of
[] -> String
""
(Message
m:[Message]
_) -> Message -> String
messageString Message
m
Either ParseError Pandoc
result <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Pandoc
parseDoc
(ParserState
-> [(Text, Blocks)]
-> Maybe URI
-> Set Text
-> [LogMessage]
-> Map Text Macro
-> ReaderOptions
-> Bool
-> HTMLState
HTMLState forall a. Default a => a
def{ stateOptions :: ReaderOptions
stateOptions = ReaderOptions
opts }
[] forall a. Maybe a
Nothing forall a. Set a
Set.empty [] forall k a. Map k a
M.empty ReaderOptions
opts Bool
False)
String
"source" [Tag Text]
tags
case Either ParseError Pandoc
result of
Right Pandoc
doc -> forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
doc
Left ParseError
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ParseError -> String
getError ParseError
err
stripPrefixes :: [Tag Text] -> [Tag Text]
stripPrefixes :: [Tag Text] -> [Tag Text]
stripPrefixes = forall a b. (a -> b) -> [a] -> [b]
map Tag Text -> Tag Text
stripPrefix
stripPrefix :: Tag Text -> Tag Text
stripPrefix :: Tag Text -> Tag Text
stripPrefix (TagOpen Text
s [Attribute Text]
as) = forall str. str -> [Attribute str] -> Tag str
TagOpen ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/=Char
':') Text
s) [Attribute Text]
as
stripPrefix (TagClose Text
s) = forall str. str -> Tag str
TagClose ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/=Char
':') Text
s)
stripPrefix Tag Text
x = Tag Text
x
replaceNotes :: PandocMonad m => [Block] -> TagParser m [Block]
replaceNotes :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> TagParser m [Block]
replaceNotes [Block]
bs = do
[(Text, Blocks)]
notes <- HTMLState -> [(Text, Blocks)]
noteTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (forall (m :: * -> *).
PandocMonad m =>
[(Text, Blocks)] -> Inline -> TagParser m Inline
replaceNotes' [(Text, Blocks)]
notes) [Block]
bs
replaceNotes' :: PandocMonad m
=> [(Text, Blocks)] -> Inline -> TagParser m Inline
replaceNotes' :: forall (m :: * -> *).
PandocMonad m =>
[(Text, Blocks)] -> Inline -> TagParser m Inline
replaceNotes' [(Text, Blocks)]
noteTbl (RawInline (Format Text
"noteref") Text
ref) =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TagParser m Inline
warnNotFound (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inline
Note forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ref [(Text, Blocks)]
noteTbl
where
warnNotFound :: TagParser m Inline
warnNotFound = do
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ReferenceNotFound Text
ref SourcePos
pos
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> Inline
Note [])
replaceNotes' [(Text, Blocks)]
_ Inline
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
x
setInChapter :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a
setInChapter :: forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInChapter = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\HTMLLocal
s -> HTMLLocal
s {inChapter :: Bool
inChapter = Bool
True})
setInPlain :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a
setInPlain :: forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInPlain = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\HTMLLocal
s -> HTMLLocal
s {inPlain :: Bool
inPlain = Bool
True})
pHtml :: PandocMonad m => TagParser m Blocks
pHtml :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHtml = do
(TagOpen Text
"html" [Attribute Text]
attr) <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"xml:lang" [Attribute Text]
attr) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"lang" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"html" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
pBody :: PandocMonad m => TagParser m Blocks
pBody :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBody = do
(TagOpen Text
"body" [Attribute Text]
attr) <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"xml:lang" [Attribute Text]
attr) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"lang" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"body" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
pHead :: PandocMonad m => TagParser m Blocks
pHead :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHead = forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"head" forall a b. (a -> b) -> a -> b
$ TagParser m Blocks
pTitle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TagParser m Blocks
pMetaTag forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TagParser m Blocks
pBaseTag forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny)
where pTitle :: TagParser m Blocks
pTitle = forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"title" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {m :: * -> *} {u} {b} {s}.
(Monoid a, Monad m, HasMeta u, ToMetaValue b) =>
b -> ParsecT s u m a
setTitle forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines
setTitle :: b -> ParsecT s u m a
setTitle b
t = forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"title" b
t)
pMetaTag :: TagParser m Blocks
pMetaTag = do
Tag Text
mt <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"meta" [])
let name :: Text
name = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"name" Tag Text
mt
if Text -> Bool
T.null Text
name
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
else do
let content :: Text
content = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"content" Tag Text
mt
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
s ->
let ps :: ParserState
ps = HTMLState -> ParserState
parserState HTMLState
s in
HTMLState
s{ parserState :: ParserState
parserState = ParserState
ps{
stateMeta :: Meta
stateMeta = forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
name (Text -> Inlines
B.text Text
content)
(ParserState -> Meta
stateMeta ParserState
ps) } }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
pBaseTag :: TagParser m Blocks
pBaseTag = do
Tag Text
bt <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"base" [])
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
st -> HTMLState
st{ baseHref :: Maybe URI
baseHref =
String -> Maybe URI
parseURIReference forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"href" Tag Text
bt }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
block :: PandocMonad m => TagParser m Blocks
block :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block = ((do
Tag Text
tag <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
isBlockTag)
Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
case Tag Text
tag of
TagOpen Text
name [Attribute Text]
attr ->
let type' :: Text
type' = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr
epubExts :: Bool
epubExts = Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_epub_html_exts Extensions
exts
in
case Text
name of
Text
_ | Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
sectioningContent
, Bool
epubExts
, Text
"chapter" Text -> Text -> Bool
`T.isInfixOf` Text
type'
-> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eSection
Text
_ | Bool
epubExts
, Text
type' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"footnotes", Text
"rearnotes"]
-> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eFootnotes
Text
_ | Bool
epubExts
, Text
type' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"footnote", Text
"rearnote"]
-> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => TagParser m ()
eFootnote
Text
_ | Bool
epubExts
, Text
type' forall a. Eq a => a -> a -> Bool
== Text
"toc"
-> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => TagParser m ()
eTOC
Text
_ | Text
"titlepage" Text -> Text -> Bool
`T.isInfixOf` Text
type'
, Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text
"section" forall a. a -> [a] -> [a]
: [Text]
groupingContent)
-> forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => TagParser m ()
eTitlePage
Text
"p" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPara
Text
"h1" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
Text
"h2" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
Text
"h3" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
Text
"h4" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
Text
"h5" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
Text
"h6" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHeader
Text
"blockquote" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBlockQuote
Text
"pre" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pCodeBlock
Text
"ul" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList
Text
"ol" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pOrderedList
Text
"dl" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDefinitionList
Text
"table" -> forall (m :: * -> *).
PandocMonad m =>
TagParser m Blocks -> TagParser m Blocks
pTable forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
Text
"hr" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHrule
Text
"html" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHtml
Text
"head" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHead
Text
"body" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBody
Text
"div"
| Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_line_blocks Extensions
exts
, Just Text
"line-block" <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr
-> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pLineBlock
| Bool
otherwise
-> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
Text
"section" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
Text
"header" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
Text
"main" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv
Text
"figure" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pFigure
Text
"iframe" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pIframe
Text
"style" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
Text
"textarea" -> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock
Text
"switch"
| Bool
epubExts
-> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch Inlines -> Blocks
B.para forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Tag Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPlain forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Blocks
res ->
Blocks
res forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> m ()
trace (Int -> Text -> Text
T.take Int
60 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ forall a. Many a -> [a]
B.toList Blocks
res)
namespaces :: PandocMonad m => [(Text, TagParser m Inlines)]
namespaces :: forall (m :: * -> *).
PandocMonad m =>
[(Text, TagParser m Inlines)]
namespaces = [(Text
mathMLNamespace, forall (m :: * -> *). PandocMonad m => Bool -> TagParser m Inlines
pMath Bool
True)]
mathMLNamespace :: Text
mathMLNamespace :: Text
mathMLNamespace = Text
"http://www.w3.org/1998/Math/MathML"
eSwitch :: (PandocMonad m, Monoid a)
=> (Inlines -> a)
-> TagParser m a
-> TagParser m a
eSwitch :: forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch Inlines -> a
constructor TagParser m a
parser = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"switch" [])
Maybe Inlines
cases <- forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall a. Maybe a -> First a
First forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). PandocMonad m => TagParser m (Maybe Inlines)
eCase forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank) )
(forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"default" []))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
a
fallback <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"default" (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TagParser m a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"switch")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
fallback Inlines -> a
constructor Maybe Inlines
cases
eCase :: PandocMonad m => TagParser m (Maybe Inlines)
eCase :: forall (m :: * -> *). PandocMonad m => TagParser m (Maybe Inlines)
eCase = do
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank
TagOpen Text
_ [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"case" [])
let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
case forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup forall (m :: * -> *).
PandocMonad m =>
[(Text, TagParser m Inlines)]
namespaces forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"required-namespace" [Attribute Text]
attr of
Just TagParser m Inlines
p -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"case" (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TagParser m Inlines
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank)
Maybe (TagParser m Inlines)
Nothing -> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"case"))
eFootnote :: PandocMonad m => TagParser m ()
= do
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
TagOpen Text
tag [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy
(\case
TagOpen Text
_ [Attribute Text]
attr'
-> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr' of
Just Text
"footnote" -> Bool
True
Just Text
"rearnote" -> Bool
True
Maybe Text
_ -> Bool
False
Tag Text
_ -> Bool
False)
let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
let ident :: Text
ident = forall a. a -> Maybe a -> a
fromMaybe Text
"" (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr)
Blocks
content <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
s ->
HTMLState
s {noteTable :: [(Text, Blocks)]
noteTable = (Text
ident, Blocks
content) forall a. a -> [a] -> [a]
: HTMLState -> [(Text, Blocks)]
noteTable HTMLState
s}
eFootnotes :: PandocMonad m => TagParser m Blocks
= forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
let notes :: [Text]
notes = [Text
"footnotes", Text
"rearnotes"]
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
(TagOpen Text
tag [Attribute Text]
attr') <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
notes)
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr)
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
s -> HTMLState
s{ inFootnotes :: Bool
inFootnotes = Bool
True }
Blocks
result <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \HTMLState
s -> HTMLState
s{ inFootnotes :: Bool
inFootnotes = Bool
False }
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Blocks
result
then forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
result
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith ([Attribute Text] -> Attr
toAttr [Attribute Text]
attr') Blocks
result
eNoteref :: PandocMonad m => TagParser m Inlines
eNoteref :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
eNoteref = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
TagOpen Text
tag [Attribute Text]
attr <-
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\case
TagOpen Text
_ [Attribute Text]
as
-> (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
as forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
as)
forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"noteref"
Tag Text
_ -> Bool
False)
Text
ident <- case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" [Attribute Text]
attr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe (Char, Text)
T.uncons of
Just (Char
'#', Text
rest) -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
rest
Maybe (Char, Text)
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
[Tag Text]
_ <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\case
TagClose Text
t -> Text
t forall a. Eq a => a -> a -> Bool
== Text
tag
Tag Text
_ -> Bool
False))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"noteref" Text
ident
eTOC :: PandocMonad m => TagParser m ()
eTOC :: forall (m :: * -> *). PandocMonad m => TagParser m ()
eTOC = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_epub_html_exts
(TagOpen Text
tag [Attribute Text]
attr) <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"toc"
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)
pBulletList :: PandocMonad m => TagParser m Blocks
pBulletList :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"ul" [])
let nonItem :: TagParser m (Tag Text)
nonItem = forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\Tag Text
t ->
Bool -> Bool
not (forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"li",Text
"ol",Text
"ul",Text
"dl"]) (forall a b. a -> b -> a
const Bool
True) Tag Text
t) Bool -> Bool -> Bool
&&
Bool -> Bool
not (Text -> Tag Text -> Bool
matchTagClose Text
"ul" Tag Text
t))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem
[Blocks]
items <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall (m :: * -> *) a.
PandocMonad m =>
TagParser m a -> TagParser m Blocks
pListItem' TagParser m (Tag Text)
nonItem) (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"ul")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
B.bulletList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Blocks -> Blocks
fixPlains Bool
True) [Blocks]
items
pListItem :: PandocMonad m => TagParser m Blocks
pListItem :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pListItem = do
TagOpen Text
_ [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"li" [])
let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
let addId :: Text -> Blocks -> Blocks
addId Text
ident Blocks
bs = case forall a. Many a -> [a]
B.toList Blocks
bs of
(Plain [Inline]
ils:[Block]
xs) -> forall a. [a] -> Many a
B.fromList ([Inline] -> Block
Plain
[Attr -> [Inline] -> Inline
Span (Text
ident, [], []) [Inline]
ils] forall a. a -> [a] -> [a]
: [Block]
xs)
[Block]
_ -> Attr -> Blocks -> Blocks
B.divWith (Text
ident, [], []) Blocks
bs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Text -> Blocks -> Blocks
addId (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"li" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
pListItem' :: PandocMonad m => TagParser m a -> TagParser m Blocks
pListItem' :: forall (m :: * -> *) a.
PandocMonad m =>
TagParser m a -> TagParser m Blocks
pListItem' TagParser m a
nonItem = (forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pListItem forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBulletList forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pOrderedList)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m a
nonItem
parseListStyleType :: Text -> ListNumberStyle
parseListStyleType :: Text -> ListNumberStyle
parseListStyleType Text
"lower-roman" = ListNumberStyle
LowerRoman
parseListStyleType Text
"upper-roman" = ListNumberStyle
UpperRoman
parseListStyleType Text
"lower-alpha" = ListNumberStyle
LowerAlpha
parseListStyleType Text
"upper-alpha" = ListNumberStyle
UpperAlpha
parseListStyleType Text
"decimal" = ListNumberStyle
Decimal
parseListStyleType Text
_ = ListNumberStyle
DefaultStyle
parseTypeAttr :: Text -> ListNumberStyle
parseTypeAttr :: Text -> ListNumberStyle
parseTypeAttr Text
"i" = ListNumberStyle
LowerRoman
parseTypeAttr Text
"I" = ListNumberStyle
UpperRoman
parseTypeAttr Text
"a" = ListNumberStyle
LowerAlpha
parseTypeAttr Text
"A" = ListNumberStyle
UpperAlpha
parseTypeAttr Text
"1" = ListNumberStyle
Decimal
parseTypeAttr Text
_ = ListNumberStyle
DefaultStyle
pOrderedList :: PandocMonad m => TagParser m Blocks
pOrderedList :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pOrderedList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
TagOpen Text
_ [Attribute Text]
attribs' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"ol" [])
Bool
isNoteList <- HTMLState -> Bool
inFootnotes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let attribs :: [Attribute Text]
attribs = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attribs'
let start :: Int
start = forall a. a -> Maybe a -> a
fromMaybe Int
1 forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start" [Attribute Text]
attribs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
let style :: ListNumberStyle
style = forall a. a -> Maybe a -> a
fromMaybe ListNumberStyle
DefaultStyle
forall a b. (a -> b) -> a -> b
$ (Text -> ListNumberStyle
parseTypeAttr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attribs)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> ListNumberStyle
parseListStyleType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attribs)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> ListNumberStyle
parseListStyleType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [Attribute Text]
attribs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
pickListStyle))
where
pickListStyle :: Text -> Maybe Text
pickListStyle = [Text] -> Text -> Maybe Text
pickStyleAttrProps [Text
"list-style-type", Text
"list-style"]
let nonItem :: TagParser m (Tag Text)
nonItem = forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\Tag Text
t ->
Bool -> Bool
not (forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"li",Text
"ol",Text
"ul",Text
"dl"]) (forall a b. a -> b -> a
const Bool
True) Tag Text
t) Bool -> Bool -> Bool
&&
Bool -> Bool
not (Text -> Tag Text -> Bool
matchTagClose Text
"ol" Tag Text
t))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem
if Bool
isNoteList
then do
[()]
_ <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall (m :: * -> *). PandocMonad m => TagParser m ()
eFootnote forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m ()
pBlank) (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"ol")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
else do
[Blocks]
items <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (forall (m :: * -> *) a.
PandocMonad m =>
TagParser m a -> TagParser m Blocks
pListItem' TagParser m (Tag Text)
nonItem) (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"ol")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Blocks] -> Blocks
B.orderedListWith (Int
start, ListNumberStyle
style, ListNumberDelim
DefaultDelim) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Blocks -> Blocks
fixPlains Bool
True) [Blocks]
items
pDefinitionList :: PandocMonad m => TagParser m Blocks
pDefinitionList :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDefinitionList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dl" [])
[(Inlines, [Blocks])]
items <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *).
PandocMonad m =>
TagParser m (Inlines, [Blocks])
pDefListItem (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"dl")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(Inlines, [Blocks])] -> Blocks
B.definitionList [(Inlines, [Blocks])]
items
pDefListItem :: PandocMonad m => TagParser m (Inlines, [Blocks])
pDefListItem :: forall (m :: * -> *).
PandocMonad m =>
TagParser m (Inlines, [Blocks])
pDefListItem = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
let nonItem :: TagParser m (Tag Text)
nonItem = forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (\Tag Text
t -> Bool -> Bool
not (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dt" [] Tag Text
t) Bool -> Bool -> Bool
&&
Bool -> Bool
not (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"dd" [] Tag Text
t) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Tag Text -> Bool
matchTagClose Text
"dl" Tag Text
t))
[Inlines]
terms <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"dt" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline)
[Blocks]
defs <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"dd" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany TagParser m (Tag Text)
nonItem
let term :: Inlines
term = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Inlines
x Inlines
y -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
x
then Inlines -> Inlines
trimInlines Inlines
y
else Inlines
x forall a. Semigroup a => a -> a -> a
<> Inlines
B.linebreak forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
trimInlines Inlines
y)
forall a. Monoid a => a
mempty [Inlines]
terms
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
term, forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Blocks -> Blocks
fixPlains Bool
True) [Blocks]
defs)
fixPlains :: Bool -> Blocks -> Blocks
fixPlains :: Bool -> Blocks -> Blocks
fixPlains Bool
inList Blocks
bs = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isParaish [Block]
bs'
then forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bs'
else Blocks
bs
where isParaish :: Block -> Bool
isParaish Para{} = Bool
True
isParaish CodeBlock{} = Bool
True
isParaish Header{} = Bool
True
isParaish BlockQuote{} = Bool
True
isParaish BulletList{} = Bool -> Bool
not Bool
inList
isParaish OrderedList{} = Bool -> Bool
not Bool
inList
isParaish DefinitionList{} = Bool -> Bool
not Bool
inList
isParaish Block
_ = Bool
False
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
xs) = [Inline] -> Block
Para [Inline]
xs
plainToPara Block
x = Block
x
bs' :: [Block]
bs' = forall a. Many a -> [a]
B.toList Blocks
bs
pRawTag :: PandocMonad m => TagParser m Text
pRawTag :: forall (m :: * -> *). PandocMonad m => TagParser m Text
pRawTag = do
Tag Text
tag <- forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny
let ignorable :: a -> Bool
ignorable a
x = a
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"html",a
"head",a
"body",a
"!DOCTYPE",a
"?xml"]
if forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen forall {a}. (Eq a, IsString a) => a -> Bool
ignorable (forall a b. a -> b -> a
const Bool
True) Tag Text
tag Bool -> Bool -> Bool
|| forall str. (str -> Bool) -> Tag str -> Bool
tagClose forall {a}. (Eq a, IsString a) => a -> Bool
ignorable Tag Text
tag
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag]
pLineBlock :: PandocMonad m => TagParser m Blocks
pLineBlock :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pLineBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_line_blocks
Tag Text
_ <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"div") (forall a. Eq a => a -> a -> Bool
== [(Text
"class",Text
"line-block")])
Inlines
ils <- Inlines -> Inlines
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str. (str -> Bool) -> Tag str -> Bool
tagClose (forall a. Eq a => a -> a -> Bool
==Text
"div")))
let lns :: [Inlines]
lns = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (forall a. Eq a => a -> a -> Bool
== Inline
LineBreak) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Inline
SoftBreak) forall a b. (a -> b) -> a -> b
$
forall a. Many a -> [a]
B.toList Inlines
ils
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Inlines] -> Blocks
B.lineBlock [Inlines]
lns
isDivLike :: Text -> Bool
isDivLike :: Text -> Bool
isDivLike Text
"div" = Bool
True
isDivLike Text
"section" = Bool
True
isDivLike Text
"header" = Bool
True
isDivLike Text
"main" = Bool
True
isDivLike Text
_ = Bool
False
pDiv :: PandocMonad m => TagParser m Blocks
pDiv :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pDiv = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_native_divs
TagOpen Text
tag [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
isDivLike (forall a b. a -> b -> a
const Bool
True)
let (Text
ident, [Text]
classes, [Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
Blocks
contents <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
let contents' :: Blocks
contents' = case forall a. Many a -> Seq a
B.unMany Blocks
contents of
Header Int
lev (Text
hident,[Text]
hclasses,[Attribute Text]
hkvs) [Inline]
ils Seq.:<| Seq Block
rest
| Text
hident forall a. Eq a => a -> a -> Bool
== Text
ident ->
forall a. Seq a -> Many a
B.Many forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
lev (Text
"",[Text]
hclasses,[Attribute Text]
hkvs) [Inline]
ils forall a. a -> Seq a -> Seq a
Seq.<| Seq Block
rest
Seq Block
_ -> Blocks
contents
let classes' :: [Text]
classes' = if Text
tag forall a. Eq a => a -> a -> Bool
== Text
"section"
then Text
"section"forall a. a -> [a] -> [a]
:[Text]
classes
else [Text]
classes
kvs' :: [Attribute Text]
kvs' = if Text
tag forall a. Eq a => a -> a -> Bool
== Text
"main" Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"role" [Attribute Text]
kvs)
then (Text
"role", Text
"main")forall a. a -> [a] -> [a]
:[Attribute Text]
kvs
else [Attribute Text]
kvs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
ident, [Text]
classes', [Attribute Text]
kvs') Blocks
contents'
pIframe :: PandocMonad m => TagParser m Blocks
pIframe :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pIframe = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardDisabled Extension
Ext_raw_html
Tag Text
tag <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"iframe") (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src"))
forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"iframe" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
Text
url <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl forall a b. (a -> b) -> a -> b
$ forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
tag
if Text -> Bool
T.null Text
url
then forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag, forall str. str -> Tag str
TagClose Text
"iframe"]
else forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
(do (ByteString
bs, Maybe Text
mbMime) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
url
case Maybe Text
mbMime of
Just Text
mt
| Text
"text/html" Text -> Text -> Bool
`T.isPrefixOf` Text
mt -> do
let inp :: Text
inp = ByteString -> Text
UTF8.toText ByteString
bs
ReaderOptions
opts <- HTMLState -> ReaderOptions
readerOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Pandoc Meta
_ [Block]
contents <- forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readHtml ReaderOptions
opts Text
inp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[]) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
B.fromList [Block]
contents
| Text
"image/" Text -> Text -> Bool
`T.isPrefixOf` Text
mt -> do
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[]) forall a b. (a -> b) -> a -> b
$
Inlines -> Blocks
B.plain forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image Text
url Text
"" forall a. Monoid a => a
mempty
Maybe Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"iframe"],[(Text
"src", Text
url)]) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty)
(\PandocError
e -> do
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
url (PandocError -> Text
renderError PandocError
e)
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag, forall str. str -> Tag str
TagClose Text
"iframe"])
pRawHtmlBlock :: PandocMonad m => TagParser m Blocks
pRawHtmlBlock :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pRawHtmlBlock = do
Text
raw <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"script" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"style" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
"textarea"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => TagParser m Text
pRawTag
Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_html Extensions
exts Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
raw)
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
"html" Text
raw
else forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore Text
raw
ignore :: (Monoid a, PandocMonad m) => Text -> TagParser m a
ignore :: forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore Text
raw = do
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
raw) forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
raw SourcePos
pos
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
pHtmlBlock :: PandocMonad m => Text -> TagParser m Text
pHtmlBlock :: forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
pHtmlBlock Text
t = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
Tag Text
open <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
t [])
[Tag Text]
contents <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
t))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' forall a b. (a -> b) -> a -> b
$ [Tag Text
open] forall a. Semigroup a => a -> a -> a
<> [Tag Text]
contents forall a. Semigroup a => a -> a -> a
<> [forall str. str -> Tag str
TagClose Text
t]
eSection :: PandocMonad m => TagParser m Blocks
eSection :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
eSection = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
let matchChapter :: [(a, Text)] -> Bool
matchChapter [(a, Text)]
as = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
T.isInfixOf Text
"chapter")
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"type" [(a, Text)]
as forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"epub:type" [(a, Text)]
as)
let sectTag :: Tag Text -> Bool
sectTag = forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
sectioningContent) forall {a}. (Eq a, IsString a) => [(a, Text)] -> Bool
matchChapter
TagOpen Text
tag [Attribute Text]
_ <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
sectTag
forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInChapter (forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)
headerLevel :: Text -> TagParser m Int
Text
tagtype =
case forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Int -> Text -> Text
T.drop Int
1 Text
tagtype) of
Just Int
level ->
forall (m :: * -> *) a. Monad m => a -> m a
return Int
level
Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not retrieve header level"
eTitlePage :: PandocMonad m => TagParser m ()
eTitlePage :: forall (m :: * -> *). PandocMonad m => TagParser m ()
eTitlePage = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
let isTitlePage :: [(a, Text)] -> Bool
isTitlePage [(a, Text)]
as = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
T.isInfixOf Text
"titlepage")
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"type" [(a, Text)]
as forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"epub:type" [(a, Text)]
as)
let groupTag :: Tag Text -> Bool
groupTag = forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (\Text
x -> Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
groupingContent Bool -> Bool -> Bool
|| Text
x forall a. Eq a => a -> a -> Bool
== Text
"section")
forall {a}. (Eq a, IsString a) => [(a, Text)] -> Bool
isTitlePage
TagOpen Text
tag [Attribute Text]
_ <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
groupTag
() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tag forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
pHeader :: PandocMonad m => TagParser m Blocks
= forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
TagOpen Text
tagtype [Attribute Text]
attr' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"h1",Text
"h2",Text
"h3",Text
"h4",Text
"h5",Text
"h6"])
(forall a b. a -> b -> a
const Bool
True)
let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
Int
level <- forall (m :: * -> *). Text -> TagParser m Int
headerLevel Text
tagtype
Inlines
contents <- Inlines -> Inlines
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
tagtype forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
let ident :: Text
ident = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attr
let classes :: [Text]
classes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr
let keyvals :: [Attribute Text]
keyvals = [(Text
k,Text
v) | (Text
k,Text
v) <- [Attribute Text]
attr, Text
k forall a. Eq a => a -> a -> Bool
/= Text
"class", Text
k forall a. Eq a => a -> a -> Bool
/= Text
"id"]
Attr
attr'' <- forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
HasIdentifierList st) =>
Attr -> Inlines -> ParsecT s st m Attr
registerHeader (Text
ident, [Text]
classes, [Attribute Text]
keyvals) Inlines
contents
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
B.headerWith Attr
attr'' Int
level Inlines
contents
pHrule :: PandocMonad m => TagParser m Blocks
pHrule :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pHrule = do
forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing (forall a. Eq a => a -> a -> Bool
==Text
"hr") (forall a b. a -> b -> a
const Bool
True)
Bool
inNotes <- HTMLState -> Bool
inFootnotes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
inNotes
then forall a. Monoid a => a
mempty
else Blocks
B.horizontalRule
pBlockQuote :: PandocMonad m => TagParser m Blocks
pBlockQuote :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pBlockQuote = do
Blocks
contents <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"blockquote" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
B.blockQuote forall a b. (a -> b) -> a -> b
$ Bool -> Blocks -> Blocks
fixPlains Bool
False Blocks
contents
pPlain :: PandocMonad m => TagParser m Blocks
pPlain :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPlain = do
Inlines
contents <- forall (m :: * -> *) s a.
PandocMonad m =>
HTMLParser m s a -> HTMLParser m s a
setInPlain forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
contents
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain Inlines
contents
pPara :: PandocMonad m => TagParser m Blocks
pPara :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pPara = do
Inlines
contents <- Inlines -> Inlines
trimInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"p" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
(do forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardDisabled Extension
Ext_empty_paragraphs
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
contents)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> Blocks
B.para Inlines
contents)
pFigure :: PandocMonad m => TagParser m Blocks
pFigure :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pFigure = do
TagOpen Text
tag [Attribute Text]
attrList <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"figure" []
let parser :: ParsecT
[Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
parser = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"figcaption" forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => TagParser m Blocks
block)
([Blocks]
captions, [Blocks]
rest) <- forall a b. [Either a b] -> ([a], [b])
partitionEithers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT
[Tag Text] HTMLState (ReaderT HTMLLocal m) (Either Blocks Blocks)
parser (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
tag forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> Blocks -> Blocks
B.figureWith ([Attribute Text] -> Attr
toAttr [Attribute Text]
attrList)
(Blocks -> Caption
B.simpleCaption (forall a. Monoid a => [a] -> a
mconcat [Blocks]
captions))
(forall a. Monoid a => [a] -> a
mconcat [Blocks]
rest)
pCodeBlock :: PandocMonad m => TagParser m Blocks
pCodeBlock :: forall (m :: * -> *). PandocMonad m => TagParser m Blocks
pCodeBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
TagOpen Text
_ [Attribute Text]
attr' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"pre" [])
Attr
attr <- case [Attribute Text]
attr' of
Attribute Text
_:[Attribute Text]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Attribute Text] -> Attr
toAttr [Attribute Text]
attr')
[] -> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Attr
nullAttr forall a b. (a -> b) -> a -> b
$ do
TagOpen Text
_ [Attribute Text]
codeAttr <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"code" [])
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Attribute Text] -> Attr
toAttr
[ (Text
k, Text
v') | (Text
k, Text
v) <- [Attribute Text]
codeAttr
, let v' :: Text
v' = if Text
k forall a. Eq a => a -> a -> Bool
== Text
"class"
then forall a. a -> Maybe a -> a
fromMaybe Text
v (Text -> Text -> Maybe Text
T.stripPrefix Text
"language-" Text
v)
else Text
v ]
[Tag Text]
contents <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"pre" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
let rawText :: Text
rawText = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Tag Text -> Text
tagToText [Tag Text]
contents
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
let result :: Text
result = case Text -> Maybe (Text, Char)
T.unsnoc Text
result' of
Just (Text
result'', Char
'\n') -> Text
result''
Maybe (Text, Char)
_ -> Text
result'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith Attr
attr Text
result
tagToText :: Tag Text -> Text
tagToText :: Tag Text -> Text
tagToText (TagText Text
s) = Text
s
tagToText (TagOpen Text
"br" [Attribute Text]
_) = Text
"\n"
tagToText Tag Text
_ = Text
""
inline :: PandocMonad m => TagParser m Inlines
inline :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline = forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
Tag Text
tag <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
isInlineTag)
Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
case Tag Text
tag of
TagOpen Text
name [Attribute Text]
attr ->
case Text
name of
Text
"a" | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_epub_html_exts Extensions
exts
, Just Text
"noteref" <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"epub:type" [Attribute Text]
attr
, Just (Char
'#',Text
_) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" [Attribute Text]
attr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe (Char, Text)
T.uncons
-> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
eNoteref
| Bool
otherwise -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLink
Text
"switch" -> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Inlines -> a) -> TagParser m a -> TagParser m a
eSwitch forall a. a -> a
id forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
Text
"q" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pQ
Text
"em" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph
Text
"i" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph
Text
"strong" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong
Text
"b" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong
Text
"sup" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSuperscript
Text
"sub" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSubscript
Text
"small" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSmall
Text
"s" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
Text
"strike" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
Text
"del" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout
Text
"u" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline
Text
"ins" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline
Text
"br" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLineBreak
Text
"img" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pImage
Text
"svg" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSvg
Text
"bdo" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pBdo
Text
"tt" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode
Text
"code" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode
Text
"samp" -> forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> TagParser m Inlines
pCodeWithClass Text
"samp" Text
"sample"
Text
"var" -> forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> TagParser m Inlines
pCodeWithClass Text
"var" Text
"variable"
Text
"span" -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpan
Text
"math" -> forall (m :: * -> *). PandocMonad m => Bool -> TagParser m Inlines
pMath Bool
False
Text
"script"
| Just Text
x <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr
, Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` Text
x -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pScriptMath
Text
_ | Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Text
htmlSpanLikeElements -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpanLike
Text
_ -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline
TagText Text
_ -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText
Tag Text
_ -> forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline
pSelfClosing :: PandocMonad m
=> (Text -> Bool) -> ([Attribute Text] -> Bool)
-> TagParser m (Tag Text)
pSelfClosing :: forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing Text -> Bool
f [Attribute Text] -> Bool
g = do
Tag Text
open <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen Text -> Bool
f [Attribute Text] -> Bool
g)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str. (str -> Bool) -> Tag str -> Bool
tagClose Text -> Bool
f)
forall (m :: * -> *) a. Monad m => a -> m a
return Tag Text
open
pQ :: PandocMonad m => TagParser m Inlines
pQ :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pQ = do
TagOpen Text
_ [Attribute Text]
attrs <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
"q" (forall a b. a -> b -> a
const Bool
True)
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"cite" [Attribute Text]
attrs of
Just Text
url -> do
let uid :: Text
uid = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"name" [Attribute Text]
attrs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [Attribute Text]
attrs
let cls :: [Text]
cls = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attrs
Text
url' <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl Text
url
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
uid, [Text]
cls, [(Text
"cite", Text -> Text
escapeURI Text
url')])
Maybe Text
Nothing -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote forall a. a -> a
id
where
makeQuote :: (Inlines -> Inlines)
-> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
makeQuote Inlines -> Inlines
wrapper = do
QuoteContext
ctx <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HTMLLocal -> QuoteContext
quoteContext
let (Inlines -> Inlines
constructor, QuoteContext
innerContext) = case QuoteContext
ctx of
QuoteContext
InDoubleQuote -> (Inlines -> Inlines
B.singleQuoted, QuoteContext
InSingleQuote)
QuoteContext
_ -> (Inlines -> Inlines
B.doubleQuoted, QuoteContext
InDoubleQuote)
Inlines
content <- forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
innerContext
(forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"q"))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Inlines -> Inlines
constructor forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
wrapper) Inlines
content
pEmph :: PandocMonad m => TagParser m Inlines
pEmph :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pEmph = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"em" Inlines -> Inlines
B.emph forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"i" Inlines -> Inlines
B.emph
pStrong :: PandocMonad m => TagParser m Inlines
pStrong :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrong = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"strong" Inlines -> Inlines
B.strong forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"b" Inlines -> Inlines
B.strong
pSuperscript :: PandocMonad m => TagParser m Inlines
pSuperscript :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSuperscript = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"sup" Inlines -> Inlines
B.superscript
pSubscript :: PandocMonad m => TagParser m Inlines
pSubscript :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSubscript = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"sub" Inlines -> Inlines
B.subscript
pSpanLike :: PandocMonad m => TagParser m Inlines
pSpanLike :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpanLike =
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr
(\Text
tagName TagParser m Inlines
acc -> TagParser m Inlines
acc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {m :: * -> *}.
PandocMonad m =>
Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
parseTag Text
tagName)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Set Text
htmlSpanLikeElements
where
parseTag :: Text -> ParsecT [Tag Text] HTMLState (ReaderT HTMLLocal m) Inlines
parseTag Text
tagName = do
TagOpen Text
_ [Attribute Text]
attrs <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
tagName (forall a b. a -> b -> a
const Bool
True)
let (Text
ids, [Text]
cs, [Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attrs
Inlines
content <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
tagName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
ids, Text
tagName forall a. a -> [a] -> [a]
: [Text]
cs, [Attribute Text]
kvs) Inlines
content
pSmall :: PandocMonad m => TagParser m Inlines
pSmall :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSmall = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"small" (Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"small"],[]))
pStrikeout :: PandocMonad m => TagParser m Inlines
pStrikeout :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pStrikeout =
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"s" Inlines -> Inlines
B.strikeout forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"strike" Inlines -> Inlines
B.strikeout forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"del" Inlines -> Inlines
B.strikeout forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"span" [(Text
"class",Text
"strikeout")])
Inlines
contents <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"span")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
B.strikeout Inlines
contents)
pUnderline :: PandocMonad m => TagParser m Inlines
pUnderline :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pUnderline = forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"u" Inlines -> Inlines
B.underline forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
"ins" Inlines -> Inlines
B.underline
pLineBreak :: PandocMonad m => TagParser m Inlines
pLineBreak :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLineBreak = do
forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing (forall a. Eq a => a -> a -> Bool
==Text
"br") (forall a b. a -> b -> a
const Bool
True)
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.linebreak
pLink :: PandocMonad m => TagParser m Inlines
pLink :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pLink = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
tag :: Tag Text
tag@(TagOpen Text
_ [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit Text
"a" (forall a b. a -> b -> a
const Bool
True)
let title :: Text
title = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"title" Tag Text
tag
let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k forall a. Eq a => a -> a -> Bool
/= Text
"title" Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
/= Text
"href") [Attribute Text]
attr'
Inlines
lab <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"a")
HTMLState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
if HTMLState -> Bool
inFootnotes HTMLState
st Bool -> Bool -> Bool
&& Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
"role" Tag Text
tag forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"doc-backlink"
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
else do
case Text -> Tag Text -> Maybe Text
maybeFromAttrib Text
"href" Tag Text
tag of
Maybe Text
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
B.spanWith Attr
attr) Inlines
lab
Just Text
url' -> do
Text
url <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl Text
url'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces
(Attr -> Text -> Text -> Inlines -> Inlines
B.linkWith Attr
attr (Text -> Text
escapeURI Text
url) Text
title) Inlines
lab
pImage :: PandocMonad m => TagParser m Inlines
pImage :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pImage = do
tag :: Tag Text
tag@(TagOpen Text
_ [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Text -> Bool)
-> ([Attribute Text] -> Bool) -> TagParser m (Tag Text)
pSelfClosing (forall a. Eq a => a -> a -> Bool
==Text
"img") (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src")
Text
url <- forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl forall a b. (a -> b) -> a -> b
$ forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
tag
let title :: Text
title = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"title" Tag Text
tag
let alt :: Text
alt = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"alt" Tag Text
tag
let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k forall a. Eq a => a -> a -> Bool
/= Text
"alt" Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
/= Text
"title" Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
/= Text
"src") [Attribute Text]
attr'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith Attr
attr (Text -> Text
escapeURI Text
url) Text
title (Text -> Inlines
B.text Text
alt)
pSvg :: PandocMonad m => TagParser m Inlines
pSvg :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSvg = do
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardDisabled Extension
Ext_raw_html
opent :: Tag Text
opent@(TagOpen Text
_ [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> [Attribute Text] -> Tag Text -> Bool
matchTagOpen Text
"svg" [])
let (Text
ident,[Text]
cls,[Attribute Text]
_) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
[Tag Text]
contents <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"svg") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny)
Tag Text
closet <- forall str. str -> Tag str
TagClose Text
"svg" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
"svg" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
let rawText :: Text
rawText = Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' (Tag Text
opent forall a. a -> [a] -> [a]
: [Tag Text]
contents forall a. [a] -> [a] -> [a]
++ [Tag Text
closet])
let svgData :: Text
svgData = Text
"data:image/svg+xml;base64," forall a. Semigroup a => a -> a -> a
<> Text -> Text
encodeBase64 Text
rawText
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text
ident,[Text]
cls,[]) Text
svgData forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
pCodeWithClass :: PandocMonad m => Text -> Text -> TagParser m Inlines
pCodeWithClass :: forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> TagParser m Inlines
pCodeWithClass Text
name Text
class' = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
TagOpen Text
open [Attribute Text]
attr' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
== Text
name) (forall a b. a -> b -> a
const Bool
True)
let (Text
ids,[Text]
cs,[Attribute Text]
kvs) = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
cs' :: [Text]
cs' = Text
class' forall a. a -> [a] -> [a]
: [Text]
cs
forall (m :: * -> *).
PandocMonad m =>
Text -> Attr -> TagParser m Inlines
code Text
open (Text
ids,[Text]
cs',[Attribute Text]
kvs)
pCode :: PandocMonad m => TagParser m Inlines
pCode :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pCode = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
(TagOpen Text
open [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"code",Text
"tt"]) (forall a b. a -> b -> a
const Bool
True)
let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
forall (m :: * -> *).
PandocMonad m =>
Text -> Attr -> TagParser m Inlines
code Text
open Attr
attr
code :: PandocMonad m => Text -> Attr -> TagParser m Inlines
code :: forall (m :: * -> *).
PandocMonad m =>
Text -> Attr -> TagParser m Inlines
code Text
open Attr
attr = do
Inlines
result <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline (forall (m :: * -> *). PandocMonad m => Text -> TagParser m ()
pCloses Text
open)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
formatCode Attr
attr Inlines
result
pBdo :: PandocMonad m => TagParser m Inlines
pBdo :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pBdo = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
TagOpen Text
_ [Attribute Text]
attr' <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"bdo") (forall a b. a -> b -> a
const Bool
True)
let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
Inlines
contents <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"bdo" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [Attribute Text]
attr of
Just Text
dir -> Attr -> Inlines -> Inlines
B.spanWith (Text
"", [], [(Text
"dir",Text -> Text
T.toLower Text
dir)]) Inlines
contents
Maybe Text
Nothing -> Inlines
contents
pSpan :: PandocMonad m => TagParser m Inlines
pSpan :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pSpan = do
(TagOpen Text
_ [Attribute Text]
attr') <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"span") (forall a b. a -> b -> a
const Bool
True))
Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_native_spans Extensions
exts
then do
Inlines
contents <- forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
let attr :: Attr
attr = [Attribute Text] -> Attr
toAttr [Attribute Text]
attr'
let classes :: [Text]
classes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attr'
let styleAttr :: Text
styleAttr = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [Attribute Text]
attr'
let fontVariant :: Text
fontVariant = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$
[Text] -> Text -> Maybe Text
pickStyleAttrProps [Text
"font-variant"] Text
styleAttr
let isSmallCaps :: Bool
isSmallCaps = Text
fontVariant forall a. Eq a => a -> a -> Bool
== Text
"small-caps" Bool -> Bool -> Bool
||
Text
"smallcaps" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
let tag :: Inlines -> Inlines
tag = if Bool
isSmallCaps then Inlines -> Inlines
B.smallcaps else Attr -> Inlines -> Inlines
B.spanWith Attr
attr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
tag Inlines
contents
else if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_html Extensions
exts
then do
Tag Text
tag <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"span") (forall a b. a -> b -> a
const Bool
True)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"html" forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text
tag]
else forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
"span" forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
pRawHtmlInline :: PandocMonad m => TagParser m Inlines
pRawHtmlInline :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pRawHtmlInline = do
Bool
inplain <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HTMLLocal -> Bool
inPlain
Tag Text
result <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (forall str. (str -> Bool) -> Tag str -> Bool
tagComment (forall a b. a -> b -> a
const Bool
True))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if Bool
inplain
then forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag Text -> Bool
isBlockTag)
else forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy Tag Text -> Bool
isInlineTag
Extensions
exts <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
let raw :: Text
raw = [Tag Text] -> Text
renderTags' [Tag Text
result]
if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_html Extensions
exts
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"html" Text
raw
else forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Text -> TagParser m a
ignore Text
raw
mathMLToTeXMath :: Text -> Either Text Text
mathMLToTeXMath :: Text -> Either Text Text
mathMLToTeXMath Text
s = [Exp] -> Text
writeTeX forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text [Exp]
readMathML Text
s
pScriptMath :: PandocMonad m => TagParser m Inlines
pScriptMath :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pScriptMath = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
TagOpen Text
_ [Attribute Text]
attr' <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"script") (forall a b. a -> b -> a
const Bool
True)
Bool
isdisplay <- case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"type" [Attribute Text]
attr' of
Just Text
x | Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` Text
x
-> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"display" Text -> Text -> Bool
`T.isSuffixOf` Text
x
Maybe Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Text
contents <- forall str. StringLike str => [Tag str] -> str
innerText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"script"))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Bool
isdisplay then Text -> Inlines
B.displayMath else Text -> Inlines
B.math) Text
contents
pMath :: PandocMonad m => Bool -> TagParser m Inlines
pMath :: forall (m :: * -> *). PandocMonad m => Bool -> TagParser m Inlines
pMath Bool
inCase = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
open :: Tag Text
open@(TagOpen Text
_ [Attribute Text]
attr') <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall a b. (a -> b) -> a -> b
$ forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (forall a. Eq a => a -> a -> Bool
==Text
"math") (forall a b. a -> b -> a
const Bool
True)
let attr :: [Attribute Text]
attr = [Attribute Text] -> [Attribute Text]
toStringAttr [Attribute Text]
attr'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
inCase forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Eq a => a -> a -> Bool
== Text
mathMLNamespace) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"xmlns" [Attribute Text]
attr))
[Tag Text]
contents <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *). PandocMonad m => TagParser m (Tag Text)
pAny (forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy (Text -> Tag Text -> Bool
matchTagClose Text
"math"))
case Text -> Either Text Text
mathMLToTeXMath (forall str. StringLike str => [Tag str] -> str
renderTags forall a b. (a -> b) -> a -> b
$
[Tag Text
open] forall a. Semigroup a => a -> a -> a
<> [Tag Text]
contents forall a. Semigroup a => a -> a -> a
<> [forall str. str -> Tag str
TagClose Text
"math"]) of
Left Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"math"],[Attribute Text]
attr) forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.text forall a b. (a -> b) -> a -> b
$
forall str. StringLike str => [Tag str] -> str
innerText [Tag Text]
contents
Right Text
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Right Text
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"display" [Attribute Text]
attr of
Just Text
"block" -> Text -> Inlines
B.displayMath Text
x
Maybe Text
_ -> Text -> Inlines
B.math Text
x
pInlinesInTags :: PandocMonad m => Text -> (Inlines -> Inlines)
-> TagParser m Inlines
pInlinesInTags :: forall (m :: * -> *).
PandocMonad m =>
Text -> (Inlines -> Inlines) -> TagParser m Inlines
pInlinesInTags Text
tagtype Inlines -> Inlines
f = (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
Text -> TagParser m a -> TagParser m a
pInTags Text
tagtype forall (m :: * -> *). PandocMonad m => TagParser m Inlines
inline
pTagText :: PandocMonad m => TagParser m Inlines
pTagText :: forall (m :: * -> *). PandocMonad m => TagParser m Inlines
pTagText = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(TagText Text
str) <- forall (m :: * -> *).
PandocMonad m =>
(Tag Text -> Bool) -> TagParser m (Tag Text)
pSatisfy forall str. Tag str -> Bool
isTagText
HTMLState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
HTMLLocal
qu <- forall r (m :: * -> *). MonadReader r m => m r
ask
Either ParseError [Inlines]
parsed <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HTMLLocal
qu forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents) HTMLState
st String
"text"
([(SourcePos, Text)] -> Sources
Sources [(SourcePos
pos, Text
str)])
case Either ParseError [Inlines]
parsed of
Left ParseError
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError forall a b. (a -> b) -> a -> b
$
Text
"Could not parse `" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"'"
Right [Inlines]
result -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Inlines]
result
type InlinesParser m = HTMLParser m Sources
pTagContents :: PandocMonad m => InlinesParser m Inlines
pTagContents :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents =
Text -> Inlines
B.displayMath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
mathDisplay
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Inlines
B.math forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st s (m :: * -> *).
(HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Text
mathInline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pStr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSpace
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall st (m :: * -> *) s.
(HasReaderOptions st, HasLastStrPosition st, HasQuoteContext st m,
Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s st m Inlines -> ParsecT s st m Inlines
smartPunctuation forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pTagContents
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pRawTeX
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSymbol
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pBad
pRawTeX :: PandocMonad m => InlinesParser m Inlines
pRawTeX :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pRawTeX = do
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\'
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string) [String
"begin", String
"eqref", String
"ref"]
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
Ext_raw_tex
Sources
inp <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
HTMLState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Either ParseError (Attribute Text)
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (forall (m :: * -> *) st a.
Monad m =>
ParsecT Sources st m a -> ParsecT Sources st m (a, Text)
withRaw forall (m :: * -> *) s.
(PandocMonad m, HasMacros s, HasReaderOptions s) =>
ParsecT Sources s m Text
rawLaTeXInline) HTMLState
st String
"chunk" Sources
inp
case Either ParseError (Attribute Text)
res of
Left ParseError
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Right (Text
contents, Text
raw) -> do
String
_ <- forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count (Text -> Int
T.length Text
raw) forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"tex" Text
contents
pStr :: PandocMonad m => InlinesParser m Inlines
pStr :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pStr = do
String
result <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \Char
c ->
Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpecial Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isBad Char
c)
forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParsecT s st m ()
updateLastStrPos
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
result
isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial Char
'"' = Bool
True
isSpecial Char
'\'' = Bool
True
isSpecial Char
'.' = Bool
True
isSpecial Char
'-' = Bool
True
isSpecial Char
'$' = Bool
True
isSpecial Char
'\\' = Bool
True
isSpecial Char
'\8216' = Bool
True
isSpecial Char
'\8217' = Bool
True
isSpecial Char
'\8220' = Bool
True
isSpecial Char
'\8221' = Bool
True
isSpecial Char
_ = Bool
False
pSymbol :: PandocMonad m => InlinesParser m Inlines
pSymbol :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSymbol = Text -> Inlines
B.str forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpecial
isBad :: Char -> Bool
isBad :: Char -> Bool
isBad Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\128' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\159'
pBad :: PandocMonad m => InlinesParser m Inlines
pBad :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pBad = do
Char
c <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isBad
let c' :: Char
c' = case Char
c of
Char
'\128' -> Char
'\8364'
Char
'\130' -> Char
'\8218'
Char
'\131' -> Char
'\402'
Char
'\132' -> Char
'\8222'
Char
'\133' -> Char
'\8230'
Char
'\134' -> Char
'\8224'
Char
'\135' -> Char
'\8225'
Char
'\136' -> Char
'\710'
Char
'\137' -> Char
'\8240'
Char
'\138' -> Char
'\352'
Char
'\139' -> Char
'\8249'
Char
'\140' -> Char
'\338'
Char
'\142' -> Char
'\381'
Char
'\145' -> Char
'\8216'
Char
'\146' -> Char
'\8217'
Char
'\147' -> Char
'\8220'
Char
'\148' -> Char
'\8221'
Char
'\149' -> Char
'\8226'
Char
'\150' -> Char
'\8211'
Char
'\151' -> Char
'\8212'
Char
'\152' -> Char
'\732'
Char
'\153' -> Char
'\8482'
Char
'\154' -> Char
'\353'
Char
'\155' -> Char
'\8250'
Char
'\156' -> Char
'\339'
Char
'\158' -> Char
'\382'
Char
'\159' -> Char
'\376'
Char
_ -> Char
'?'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c'
pSpace :: PandocMonad m => InlinesParser m Inlines
pSpace :: forall (m :: * -> *). PandocMonad m => InlinesParser m Inlines
pSpace = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
xs ->
if Char
'\n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
xs
then forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.softbreak
else forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
B.space
getTagName :: Tag Text -> Maybe Text
getTagName :: Tag Text -> Maybe Text
getTagName (TagOpen Text
t [Attribute Text]
_) = forall a. a -> Maybe a
Just Text
t
getTagName (TagClose Text
t) = forall a. a -> Maybe a
Just Text
t
getTagName Tag Text
_ = forall a. Maybe a
Nothing
isInlineTag :: Tag Text -> Bool
isInlineTag :: Tag Text -> Bool
isInlineTag Tag Text
t = Tag Text -> Bool
isCommentTag Tag Text
t Bool -> Bool -> Bool
|| case Tag Text
t of
TagOpen Text
"script" [Attribute Text]
_ -> Text
"math/tex" Text -> Text -> Bool
`T.isPrefixOf` forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"type" Tag Text
t
TagClose Text
"script" -> Bool
True
TagOpen Text
name [Attribute Text]
_ -> Text -> Bool
isInlineTagName Text
name
TagClose Text
name -> Text -> Bool
isInlineTagName Text
name
Tag Text
_ -> Bool
False
where isInlineTagName :: Text -> Bool
isInlineTagName Text
x =
Text
x forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
blockTags Bool -> Bool -> Bool
||
Int -> Text -> Text
T.take Int
1 Text
x forall a. Eq a => a -> a -> Bool
== Text
"?"
isBlockTag :: Tag Text -> Bool
isBlockTag :: Tag Text -> Bool
isBlockTag Tag Text
t = Bool
isBlockTagName Bool -> Bool -> Bool
|| forall str. Tag str -> Bool
isTagComment Tag Text
t
where isBlockTagName :: Bool
isBlockTagName =
case Tag Text -> Maybe Text
getTagName Tag Text
t of
Just Text
x
| Text
"?" Text -> Text -> Bool
`T.isPrefixOf` Text
x -> Bool
True
| Text
"!" Text -> Text -> Bool
`T.isPrefixOf` Text
x -> Bool
True
| Bool
otherwise -> Text
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockTags
Bool -> Bool -> Bool
|| Text
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
eitherBlockOrInline
Maybe Text
Nothing -> Bool
False
isTextTag :: Tag Text -> Bool
isTextTag :: Tag Text -> Bool
isTextTag = forall str. (str -> Bool) -> Tag str -> Bool
tagText (forall a b. a -> b -> a
const Bool
True)
isCommentTag :: Tag Text -> Bool
= forall str. (str -> Bool) -> Tag str -> Bool
tagComment (forall a b. a -> b -> a
const Bool
True)
htmlInBalanced :: Monad m
=> (Tag Text -> Bool)
-> ParsecT Sources st m Text
htmlInBalanced :: forall (m :: * -> *) st.
Monad m =>
(Tag Text -> Bool) -> ParsecT Sources st m Text
htmlInBalanced Tag Text -> Bool
f = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
Sources
sources <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
let ts :: [Tag Text]
ts = forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags
forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions forall str. StringLike str => ParseOptions str
parseOptions{ optTagWarning :: Bool
optTagWarning = Bool
True,
optTagPosition :: Bool
optTagPosition = Bool
True }
forall a b. (a -> b) -> a -> b
$ Sources -> Text
sourcesToText Sources
sources
case [Tag Text]
ts of
(TagPosition Int
sr Int
sc : t :: Tag Text
t@(TagOpen Text
tn [Attribute Text]
_) : [Tag Text]
rest) -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Tag Text -> Bool
f Tag Text
t
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Bool
hasTagWarning (Tag Text
t forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
1 [Tag Text]
rest)
case Text -> [Tag Text] -> [Tag Text]
htmlInBalanced' Text
tn (Tag Text
tforall a. a -> [a] -> [a]
:[Tag Text]
rest) of
[] -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
[Tag Text]
xs -> case forall a. [a] -> [a]
reverse [Tag Text]
xs of
(TagClose Text
_ : TagPosition Int
er Int
ec : [Tag Text]
_) -> do
let ls :: Int
ls = Int
er forall a. Num a => a -> a -> a
- Int
sr
let cs :: Int
cs = Int
ec forall a. Num a => a -> a -> a
- Int
sc
Text
lscontents <- [Text] -> Text
T.unlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
ls forall (m :: * -> *) st. Monad m => ParsecT Sources st m Text
anyLine
String
cscontents <- forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
cs forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
String
closetag <- do
String
x <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/=Char
'>'))
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>'
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x forall a. Semigroup a => a -> a -> a
<> String
">")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
lscontents forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cscontents forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
closetag
[Tag Text]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
[Tag Text]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
htmlInBalanced' :: Text
-> [Tag Text]
-> [Tag Text]
htmlInBalanced' :: Text -> [Tag Text] -> [Tag Text]
htmlInBalanced' Text
tagname [Tag Text]
ts = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ Int -> [Tag Text] -> Maybe [Tag Text]
go Int
0 [Tag Text]
ts
where go :: Int -> [Tag Text] -> Maybe [Tag Text]
go :: Int -> [Tag Text] -> Maybe [Tag Text]
go Int
n (t :: Tag Text
t@(TagOpen Text
tn' [Attribute Text]
_):[Tag Text]
rest) | Text
tn' forall a. Eq a => a -> a -> Bool
== Text
tagname =
(Tag Text
t forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Tag Text] -> Maybe [Tag Text]
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) [Tag Text]
rest
go Int
1 (t :: Tag Text
t@(TagClose Text
tn'):[Tag Text]
_) | Text
tn' forall a. Eq a => a -> a -> Bool
== Text
tagname =
forall (m :: * -> *) a. Monad m => a -> m a
return [Tag Text
t]
go Int
n (t :: Tag Text
t@(TagClose Text
tn'):[Tag Text]
rest) | Text
tn' forall a. Eq a => a -> a -> Bool
== Text
tagname =
(Tag Text
t forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Tag Text] -> Maybe [Tag Text]
go (Int
n forall a. Num a => a -> a -> a
- Int
1) [Tag Text]
rest
go Int
n (Tag Text
t:[Tag Text]
ts') = (Tag Text
t forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Tag Text] -> Maybe [Tag Text]
go Int
n [Tag Text]
ts'
go Int
_ [] = forall (m :: * -> *) a. MonadPlus m => m a
mzero
hasTagWarning :: [Tag Text] -> Bool
hasTagWarning :: [Tag Text] -> Bool
hasTagWarning (TagWarning Text
_:[Tag Text]
_) = Bool
True
hasTagWarning [Tag Text]
_ = Bool
False
htmlTag :: (HasReaderOptions st, Monad m)
=> (Tag Text -> Bool)
-> ParsecT Sources st m (Tag Text, Text)
htmlTag :: forall st (m :: * -> *).
(HasReaderOptions st, Monad m) =>
(Tag Text -> Bool) -> ParsecT Sources st m (Tag Text, Text)
htmlTag Tag Text -> Bool
f = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<')
SourcePos
startpos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Sources
sources <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
let inp :: Text
inp = Sources -> Text
sourcesToText Sources
sources
let ts :: [Tag Text]
ts = forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions
forall str. StringLike str => ParseOptions str
parseOptions{ optTagWarning :: Bool
optTagWarning = Bool
False
, optTagPosition :: Bool
optTagPosition = Bool
True }
(Text
inp forall a. Semigroup a => a -> a -> a
<> Text
" ")
(Tag Text
next, Int
ln, Int
col) <- case [Tag Text]
ts of
(TagPosition{} : Tag Text
next : TagPosition Int
ln Int
col : [Tag Text]
_)
| Tag Text -> Bool
f Tag Text
next -> forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, Int
ln, Int
col)
[Tag Text]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
let isNameChar :: Char -> Bool
isNameChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
let isName :: Text -> Bool
isName Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
Maybe (Char, Text)
Nothing -> Bool
False
Just (Char
c, Text
cs) -> Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isNameChar Text
cs
let isPI :: Text -> Bool
isPI Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
Just (Char
'?', Text
_) -> Bool
True
Maybe (Char, Text)
_ -> Bool
False
let endpos :: SourcePos
endpos = if Int
ln forall a. Eq a => a -> a -> Bool
== Int
1
then SourcePos -> Int -> SourcePos
setSourceColumn SourcePos
startpos
(SourcePos -> Int
sourceColumn SourcePos
startpos forall a. Num a => a -> a -> a
+ (Int
col forall a. Num a => a -> a -> a
- Int
1))
else SourcePos -> Int -> SourcePos
setSourceColumn (SourcePos -> Int -> SourcePos
setSourceLine SourcePos
startpos
(SourcePos -> Int
sourceLine SourcePos
startpos forall a. Num a => a -> a -> a
+ (Int
ln forall a. Num a => a -> a -> a
- Int
1)))
Int
col
let endAngle :: ParsecT Sources u m ()
endAngle = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$
do forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'>'
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ SourcePos
pos forall a. Ord a => a -> a -> Bool
>= SourcePos
endpos
let handleTag :: Text -> ParsecT Sources u m (Tag Text, Text)
handleTag Text
tagname = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text -> Bool
isName Text
tagname Bool -> Bool -> Bool
|| Text -> Bool
isPI Text
tagname
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
tagname
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text -> Char
T.last Text
tagname forall a. Eq a => a -> a -> Bool
/= Char
':'
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'<'
String
rendered <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar forall {u}. ParsecT Sources u m ()
endAngle
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"<" forall a. [a] -> [a] -> [a]
++ String
rendered forall a. [a] -> [a] -> [a]
++ String
">")
case Tag Text
next of
TagComment Text
s
| Text
"<!--" Text -> Text -> Bool
`T.isPrefixOf` Text
inp -> do
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"<!--"
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count (Text -> Int
T.length Text
s) forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"-->"
Bool
stripComments <- forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Bool
readerStripComments
if Bool
stripComments
then forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, Text
"")
else forall (m :: * -> *) a. Monad m => a -> m a
return (Tag Text
next, Text
"<!--" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"-->")
| Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"bogus comment mode, HTML5 parse error"
TagOpen Text
tagname [Attribute Text]
attr -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text -> Bool
isPI Text
tagname Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
isName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [Attribute Text]
attr
forall {u}. Text -> ParsecT Sources u m (Tag Text, Text)
handleTag Text
tagname
TagClose Text
tagname ->
forall {u}. Text -> ParsecT Sources u m (Tag Text, Text)
handleTag Text
tagname
Tag Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
canonicalizeUrl :: PandocMonad m => Text -> TagParser m Text
canonicalizeUrl :: forall (m :: * -> *). PandocMonad m => Text -> TagParser m Text
canonicalizeUrl Text
url = do
Maybe URI
mbBaseHref <- HTMLState -> Maybe URI
baseHref forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (String -> Maybe URI
parseURIReference (Text -> String
T.unpack Text
url), Maybe URI
mbBaseHref) of
(Just URI
rel, Just URI
bs) -> forall a. Show a => a -> Text
tshow (URI
rel URI -> URI -> URI
`nonStrictRelativeTo` URI
bs)
(Maybe URI, Maybe URI)
_ -> Text
url