aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/HTML.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Readers/HTML.hs')
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs213
1 files changed, 115 insertions, 98 deletions
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index abe5f66ce..ef28ff739 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -44,7 +44,7 @@ import Text.Pandoc.Definition
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Builder (Blocks, Inlines, trimInlines, HasMeta(..))
import Text.Pandoc.Shared ( extractSpaces, renderTags', addMetaField
- , escapeURI, safeRead, mapLeft )
+ , escapeURI, safeRead )
import Text.Pandoc.Options (ReaderOptions(readerParseRaw, readerTrace)
, Extension (Ext_epub_html_exts,
Ext_native_divs, Ext_native_spans))
@@ -62,38 +62,46 @@ import Text.Printf (printf)
import Debug.Trace (trace)
import Text.TeXMath (readMathML, writeTeX)
import Data.Default (Default (..), def)
-import Control.Monad.Reader (Reader,ask, asks, local, runReader)
+import Control.Monad.Reader (ask, asks, local, ReaderT, runReaderT, lift)
import Network.URI (URI, parseURIReference, nonStrictRelativeTo)
-import Text.Pandoc.Error
import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps)
import Data.Monoid ((<>))
import Text.Parsec.Error
import qualified Data.Set as Set
+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))
+import Control.Monad.Except (throwError)
+
-- | Convert HTML-formatted string to 'Pandoc' document.
-readHtml :: ReaderOptions -- ^ Reader options
+readHtml :: PandocMonad m
+ => ReaderOptions -- ^ Reader options
-> String -- ^ String to parse (assumes @'\n'@ line endings)
- -> Either PandocError Pandoc
-readHtml opts inp =
- mapLeft (ParseFailure . getError) . flip runReader def $
- runParserT parseDoc
- (HTMLState def{ stateOptions = opts } [] Nothing Set.empty M.empty)
- "source" tags
- where tags = stripPrefixes . canonicalizeTags $
- parseTagsOptions parseOptions{ optTagPosition = True } inp
- parseDoc = do
- blocks <- (fixPlains False) . mconcat <$> manyTill block eof
- meta <- stateMeta . parserState <$> getState
- bs' <- replaceNotes (B.toList blocks)
- return $ Pandoc meta bs'
- getError (errorMessages -> ms) = case ms of
- [] -> ""
- (m:_) -> messageString m
-
-replaceNotes :: [Block] -> TagParser [Block]
+ -> m Pandoc
+readHtml opts inp = do
+ let tags = stripPrefixes . canonicalizeTags $
+ parseTagsOptions parseOptions{ optTagPosition = True } inp
+ parseDoc = do
+ blocks <- (fixPlains False) . mconcat <$> manyTill block eof
+ meta <- stateMeta . parserState <$> getState
+ bs' <- replaceNotes (B.toList blocks)
+ return $ Pandoc meta bs'
+ getError (errorMessages -> ms) = case ms of
+ [] -> ""
+ (m:_) -> messageString m
+ result <- flip runReaderT def $
+ runParserT parseDoc
+ (HTMLState def{ stateOptions = opts } [] Nothing Set.empty M.empty)
+ "source" tags
+ case result of
+ Right doc -> return doc
+ Left err -> throwError $ PandocParseError $ getError err
+
+ where
+
+replaceNotes :: PandocMonad m => [Block] -> TagParser m [Block]
replaceNotes = walkM replaceNotes'
-replaceNotes' :: Inline -> TagParser Inline
+replaceNotes' :: PandocMonad m => Inline -> TagParser m Inline
replaceNotes' (RawInline (Format "noteref") ref) = maybe (Str "") (Note . B.toList) . lookup ref <$> getNotes
where
getNotes = noteTable <$> getState
@@ -113,20 +121,20 @@ data HTMLLocal = HTMLLocal { quoteContext :: QuoteContext
, inPlain :: Bool -- ^ Set if in pPlain
}
-setInChapter :: HTMLParser s a -> HTMLParser s a
+setInChapter :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a
setInChapter = local (\s -> s {inChapter = True})
-setInPlain :: HTMLParser s a -> HTMLParser s a
+setInPlain :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a
setInPlain = local (\s -> s {inPlain = True})
-type HTMLParser s = ParserT s HTMLState (Reader HTMLLocal)
+type HTMLParser m s = ParserT s HTMLState (ReaderT HTMLLocal m)
-type TagParser = HTMLParser [Tag String]
+type TagParser m = HTMLParser m [Tag String]
-pBody :: TagParser Blocks
+pBody :: PandocMonad m => TagParser m Blocks
pBody = pInTags "body" block
-pHead :: TagParser Blocks
+pHead :: PandocMonad m => TagParser m Blocks
pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAnyTag)
where pTitle = pInTags "title" inline >>= setTitle . trimInlines
setTitle t = mempty <$ (updateState $ B.setMeta "title" t)
@@ -149,7 +157,7 @@ pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAnyTag
parseURIReference $ fromAttrib "href" bt }
return mempty
-block :: TagParser Blocks
+block :: PandocMonad m => TagParser m Blocks
block = do
tr <- getOption readerTrace
pos <- getPosition
@@ -176,13 +184,16 @@ block = do
(take 60 $ show $ B.toList res)) (return ())
return res
-namespaces :: [(String, TagParser Inlines)]
+namespaces :: PandocMonad m => [(String, TagParser m Inlines)]
namespaces = [(mathMLNamespace, pMath True)]
mathMLNamespace :: String
mathMLNamespace = "http://www.w3.org/1998/Math/MathML"
-eSwitch :: Monoid a => (Inlines -> a) -> TagParser a -> TagParser a
+eSwitch :: (PandocMonad m, Monoid a)
+ => (Inlines -> a)
+ -> TagParser m a
+ -> TagParser m a
eSwitch constructor parser = try $ do
guardEnabled Ext_epub_html_exts
pSatisfy (~== TagOpen "switch" [])
@@ -195,7 +206,7 @@ eSwitch constructor parser = try $ do
pSatisfy (~== TagClose "switch")
return $ maybe fallback constructor cases
-eCase :: TagParser (Maybe Inlines)
+eCase :: PandocMonad m => TagParser m (Maybe Inlines)
eCase = do
skipMany pBlank
TagOpen _ attr <- lookAhead $ pSatisfy $ (~== TagOpen "case" [])
@@ -203,7 +214,7 @@ eCase = do
Just p -> Just <$> (pInTags "case" (skipMany pBlank *> p <* skipMany pBlank))
Nothing -> Nothing <$ manyTill pAnyTag (pSatisfy (~== TagClose "case"))
-eFootnote :: TagParser ()
+eFootnote :: PandocMonad m => TagParser m ()
eFootnote = try $ do
let notes = ["footnote", "rearnote"]
guardEnabled Ext_epub_html_exts
@@ -213,10 +224,10 @@ eFootnote = try $ do
content <- pInTags tag block
addNote ident content
-addNote :: String -> Blocks -> TagParser ()
+addNote :: PandocMonad m => String -> Blocks -> TagParser m ()
addNote uid cont = updateState (\s -> s {noteTable = (uid, cont) : (noteTable s)})
-eNoteref :: TagParser Inlines
+eNoteref :: PandocMonad m => TagParser m Inlines
eNoteref = try $ do
guardEnabled Ext_epub_html_exts
TagOpen tag attr <- lookAhead $ pAnyTag
@@ -227,17 +238,17 @@ eNoteref = try $ do
return $ B.rawInline "noteref" ident
-- Strip TOC if there is one, better to generate again
-eTOC :: TagParser ()
+eTOC :: PandocMonad m => TagParser m ()
eTOC = try $ do
guardEnabled Ext_epub_html_exts
(TagOpen tag attr) <- lookAhead $ pAnyTag
guard (maybe False (== "toc") (lookup "type" attr))
void (pInTags tag block)
-pList :: TagParser Blocks
+pList :: PandocMonad m => TagParser m Blocks
pList = pBulletList <|> pOrderedList <|> pDefinitionList
-pBulletList :: TagParser Blocks
+pBulletList :: PandocMonad m => TagParser m Blocks
pBulletList = try $ do
pSatisfy (~== TagOpen "ul" [])
let nonItem = pSatisfy (\t ->
@@ -249,7 +260,7 @@ pBulletList = try $ do
items <- manyTill (pListItem nonItem) (pCloses "ul")
return $ B.bulletList $ map (fixPlains True) items
-pListItem :: TagParser a -> TagParser Blocks
+pListItem :: PandocMonad m => TagParser m a -> TagParser m Blocks
pListItem nonItem = do
TagOpen _ attr <- lookAhead $ pSatisfy (~== TagOpen "li" [])
let liDiv = maybe mempty (\x -> B.divWith (x, [], []) mempty) (lookup "id" attr)
@@ -271,7 +282,7 @@ parseTypeAttr "A" = UpperAlpha
parseTypeAttr "1" = Decimal
parseTypeAttr _ = DefaultStyle
-pOrderedList :: TagParser Blocks
+pOrderedList :: PandocMonad m => TagParser m Blocks
pOrderedList = try $ do
TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" [])
let (start, style) = (sta', sty')
@@ -302,13 +313,13 @@ pOrderedList = try $ do
items <- manyTill (pListItem nonItem) (pCloses "ol")
return $ B.orderedListWith (start, style, DefaultDelim) $ map (fixPlains True) items
-pDefinitionList :: TagParser Blocks
+pDefinitionList :: PandocMonad m => TagParser m Blocks
pDefinitionList = try $ do
pSatisfy (~== TagOpen "dl" [])
items <- manyTill pDefListItem (pCloses "dl")
return $ B.definitionList items
-pDefListItem :: TagParser (Inlines, [Blocks])
+pDefListItem :: PandocMonad m => TagParser m (Inlines, [Blocks])
pDefListItem = try $ do
let nonItem = pSatisfy (\t -> not (t ~== TagOpen "dt" []) &&
not (t ~== TagOpen "dd" []) && not (t ~== TagClose "dl"))
@@ -334,7 +345,7 @@ fixPlains inList bs = if any isParaish bs'
plainToPara x = x
bs' = B.toList bs
-pRawTag :: TagParser String
+pRawTag :: PandocMonad m => TagParser m String
pRawTag = do
tag <- pAnyTag
let ignorable x = x `elem` ["html","head","body","!DOCTYPE","?xml"]
@@ -342,7 +353,7 @@ pRawTag = do
then return []
else return $ renderTags' [tag]
-pDiv :: TagParser Blocks
+pDiv :: PandocMonad m => TagParser m Blocks
pDiv = try $ do
guardEnabled Ext_native_divs
let isDivLike "div" = True
@@ -356,7 +367,7 @@ pDiv = try $ do
else classes
return $ B.divWith (ident, classes', kvs) contents
-pRawHtmlBlock :: TagParser Blocks
+pRawHtmlBlock :: PandocMonad m => TagParser m Blocks
pRawHtmlBlock = do
raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pRawTag
parseRaw <- getOption readerParseRaw
@@ -364,21 +375,21 @@ pRawHtmlBlock = do
then return $ B.rawBlock "html" raw
else return mempty
-pHtmlBlock :: String -> TagParser String
+pHtmlBlock :: PandocMonad m => String -> TagParser m String
pHtmlBlock t = try $ do
open <- pSatisfy (~== TagOpen t [])
contents <- manyTill pAnyTag (pSatisfy (~== TagClose t))
return $ renderTags' $ [open] ++ contents ++ [TagClose t]
-- Sets chapter context
-eSection :: TagParser Blocks
+eSection :: PandocMonad m => TagParser m Blocks
eSection = try $ do
let matchChapter as = maybe False (isInfixOf "chapter") (lookup "type" as)
let sectTag = tagOpen (`elem` sectioningContent) matchChapter
TagOpen tag _ <- lookAhead $ pSatisfy sectTag
setInChapter (pInTags tag block)
-headerLevel :: String -> TagParser Int
+headerLevel :: PandocMonad m => String -> TagParser m Int
headerLevel tagtype = do
let level = read (drop 1 tagtype)
(try $ do
@@ -388,7 +399,7 @@ headerLevel tagtype = do
<|>
return level
-eTitlePage :: TagParser ()
+eTitlePage :: PandocMonad m => TagParser m ()
eTitlePage = try $ do
let isTitlePage as = maybe False (isInfixOf "titlepage") (lookup "type" as)
let groupTag = tagOpen (\x -> x `elem` groupingContent || x == "section")
@@ -396,7 +407,7 @@ eTitlePage = try $ do
TagOpen tag _ <- lookAhead $ pSatisfy groupTag
() <$ pInTags tag block
-pHeader :: TagParser Blocks
+pHeader :: PandocMonad m => TagParser m Blocks
pHeader = try $ do
TagOpen tagtype attr <- pSatisfy $
tagOpen (`elem` ["h1","h2","h3","h4","h5","h6"])
@@ -412,12 +423,12 @@ pHeader = try $ do
then mempty -- skip a representation of the title in the body
else B.headerWith attr' level contents
-pHrule :: TagParser Blocks
+pHrule :: PandocMonad m => TagParser m Blocks
pHrule = do
pSelfClosing (=="hr") (const True)
return B.horizontalRule
-pTable :: TagParser Blocks
+pTable :: PandocMonad m => TagParser m Blocks
pTable = try $ do
TagOpen _ _ <- pSatisfy (~== TagOpen "table" [])
skipMany pBlank
@@ -456,7 +467,7 @@ pTable = try $ do
else widths'
return $ B.table caption (zip aligns widths) head' rows
-pCol :: TagParser Double
+pCol :: PandocMonad m => TagParser m Double
pCol = try $ do
TagOpen _ attribs <- pSatisfy (~== TagOpen "col" [])
skipMany pBlank
@@ -472,7 +483,7 @@ pCol = try $ do
fromMaybe 0.0 $ safeRead ('0':'.':init x)
_ -> 0.0
-pColgroup :: TagParser [Double]
+pColgroup :: PandocMonad m => TagParser m [Double]
pColgroup = try $ do
pSatisfy (~== TagOpen "colgroup" [])
skipMany pBlank
@@ -485,31 +496,31 @@ noColOrRowSpans t = isNullOrOne "colspan" && isNullOrOne "rowspan"
"1" -> True
_ -> False
-pCell :: String -> TagParser [Blocks]
+pCell :: PandocMonad m => String -> TagParser m [Blocks]
pCell celltype = try $ do
skipMany pBlank
res <- pInTags' celltype noColOrRowSpans block
skipMany pBlank
return [res]
-pBlockQuote :: TagParser Blocks
+pBlockQuote :: PandocMonad m => TagParser m Blocks
pBlockQuote = do
contents <- pInTags "blockquote" block
return $ B.blockQuote $ fixPlains False contents
-pPlain :: TagParser Blocks
+pPlain :: PandocMonad m => TagParser m Blocks
pPlain = do
contents <- setInPlain $ trimInlines . mconcat <$> many1 inline
if B.isNull contents
then return mempty
else return $ B.plain contents
-pPara :: TagParser Blocks
+pPara :: PandocMonad m => TagParser m Blocks
pPara = do
contents <- trimInlines <$> pInTags "p" inline
return $ B.para contents
-pCodeBlock :: TagParser Blocks
+pCodeBlock :: PandocMonad m => TagParser m Blocks
pCodeBlock = try $ do
TagOpen _ attr <- pSatisfy (~== TagOpen "pre" [])
contents <- manyTill pAnyTag (pCloses "pre" <|> eof)
@@ -529,7 +540,7 @@ tagToString (TagText s) = s
tagToString (TagOpen "br" _) = "\n"
tagToString _ = ""
-inline :: TagParser Inlines
+inline :: PandocMonad m => TagParser m Inlines
inline = choice
[ eNoteref
, eSwitch id inline
@@ -549,30 +560,31 @@ inline = choice
, pRawHtmlInline
]
-pLocation :: TagParser ()
+pLocation :: PandocMonad m => TagParser m ()
pLocation = do
(TagPosition r c) <- pSat isTagPosition
setPosition $ newPos "input" r c
-pSat :: (Tag String -> Bool) -> TagParser (Tag String)
+pSat :: PandocMonad m => (Tag String -> Bool) -> TagParser m (Tag String)
pSat f = do
pos <- getPosition
token show (const pos) (\x -> if f x then Just x else Nothing)
-pSatisfy :: (Tag String -> Bool) -> TagParser (Tag String)
+pSatisfy :: PandocMonad m => (Tag String -> Bool) -> TagParser m (Tag String)
pSatisfy f = try $ optional pLocation >> pSat f
-pAnyTag :: TagParser (Tag String)
+pAnyTag :: PandocMonad m => TagParser m (Tag String)
pAnyTag = pSatisfy (const True)
-pSelfClosing :: (String -> Bool) -> ([Attribute String] -> Bool)
- -> TagParser (Tag String)
+pSelfClosing :: PandocMonad m
+ => (String -> Bool) -> ([Attribute String] -> Bool)
+ -> TagParser m (Tag String)
pSelfClosing f g = do
open <- pSatisfy (tagOpen f g)
optional $ pSatisfy (tagClose f)
return open
-pQ :: TagParser Inlines
+pQ :: PandocMonad m => TagParser m Inlines
pQ = do
context <- asks quoteContext
let quoteType = case context of
@@ -587,19 +599,19 @@ pQ = do
withQuoteContext innerQuoteContext $
pInlinesInTags "q" constructor
-pEmph :: TagParser Inlines
+pEmph :: PandocMonad m => TagParser m Inlines
pEmph = pInlinesInTags "em" B.emph <|> pInlinesInTags "i" B.emph
-pStrong :: TagParser Inlines
+pStrong :: PandocMonad m => TagParser m Inlines
pStrong = pInlinesInTags "strong" B.strong <|> pInlinesInTags "b" B.strong
-pSuperscript :: TagParser Inlines
+pSuperscript :: PandocMonad m => TagParser m Inlines
pSuperscript = pInlinesInTags "sup" B.superscript
-pSubscript :: TagParser Inlines
+pSubscript :: PandocMonad m => TagParser m Inlines
pSubscript = pInlinesInTags "sub" B.subscript
-pStrikeout :: TagParser Inlines
+pStrikeout :: PandocMonad m => TagParser m Inlines
pStrikeout = do
pInlinesInTags "s" B.strikeout <|>
pInlinesInTags "strike" B.strikeout <|>
@@ -608,7 +620,7 @@ pStrikeout = do
contents <- mconcat <$> manyTill inline (pCloses "span")
return $ B.strikeout contents)
-pLineBreak :: TagParser Inlines
+pLineBreak :: PandocMonad m => TagParser m Inlines
pLineBreak = do
pSelfClosing (=="br") (const True)
return B.linebreak
@@ -619,7 +631,7 @@ maybeFromAttrib :: String -> Tag String -> Maybe String
maybeFromAttrib name (TagOpen _ attrs) = lookup name attrs
maybeFromAttrib _ _ = Nothing
-pLink :: TagParser Inlines
+pLink :: PandocMonad m => TagParser m Inlines
pLink = try $ do
tag <- pSatisfy $ tagOpenLit "a" (const True)
let title = fromAttrib "title" tag
@@ -639,7 +651,7 @@ pLink = try $ do
_ -> url'
return $ B.linkWith (uid, cls, []) (escapeURI url) title lab
-pImage :: TagParser Inlines
+pImage :: PandocMonad m => TagParser m Inlines
pImage = do
tag <- pSelfClosing (=="img") (isJust . lookup "src")
mbBaseHref <- baseHref <$> getState
@@ -657,13 +669,13 @@ pImage = do
let kvs = concat $ map getAtt ["width", "height", "sizes", "srcset"]
return $ B.imageWith (uid, cls, kvs) (escapeURI url) title (B.text alt)
-pCode :: TagParser Inlines
+pCode :: PandocMonad m => TagParser m Inlines
pCode = try $ do
(TagOpen open attr) <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)
result <- manyTill pAnyTag (pCloses open)
return $ B.codeWith (mkAttr attr) $ intercalate " " $ lines $ innerText result
-pSpan :: TagParser Inlines
+pSpan :: PandocMonad m => TagParser m Inlines
pSpan = try $ do
guardEnabled Ext_native_spans
TagOpen _ attr <- lookAhead $ pSatisfy $ tagOpen (=="span") (const True)
@@ -674,7 +686,7 @@ pSpan = try $ do
let tag = if isSmallCaps then B.smallcaps else B.spanWith (mkAttr attr)
return $ tag contents
-pRawHtmlInline :: TagParser Inlines
+pRawHtmlInline :: PandocMonad m => TagParser m Inlines
pRawHtmlInline = do
inplain <- asks inPlain
result <- pSatisfy (tagComment (const True))
@@ -689,7 +701,7 @@ pRawHtmlInline = do
mathMLToTeXMath :: String -> Either String String
mathMLToTeXMath s = writeTeX <$> readMathML s
-pMath :: Bool -> TagParser Inlines
+pMath :: PandocMonad m => Bool -> TagParser m Inlines
pMath inCase = try $ do
open@(TagOpen _ attr) <- pSatisfy $ tagOpen (=="math") (const True)
-- we'll assume math tags are MathML unless specially marked
@@ -705,22 +717,25 @@ pMath inCase = try $ do
Just "block" -> B.displayMath x
_ -> B.math x
-pInlinesInTags :: String -> (Inlines -> Inlines)
- -> TagParser Inlines
+pInlinesInTags :: PandocMonad m => String -> (Inlines -> Inlines)
+ -> TagParser m Inlines
pInlinesInTags tagtype f = extractSpaces f <$> pInTags tagtype inline
-pInTags :: (Monoid a) => String -> TagParser a -> TagParser a
+pInTags :: (PandocMonad m, Monoid a) => String -> TagParser m a -> TagParser m a
pInTags tagtype parser = pInTags' tagtype (const True) parser
-pInTags' :: (Monoid a) => String -> (Tag String -> Bool) -> TagParser a
- -> TagParser a
+pInTags' :: (PandocMonad m, Monoid a)
+ => String
+ -> (Tag String -> Bool)
+ -> TagParser m a
+ -> TagParser m a
pInTags' tagtype tagtest parser = try $ do
pSatisfy (\t -> t ~== TagOpen tagtype [] && tagtest t)
mconcat <$> manyTill parser (pCloses tagtype <|> eof)
-- parses p, preceeded by an optional opening tag
-- and followed by an optional closing tags
-pOptInTag :: String -> TagParser a -> TagParser a
+pOptInTag :: PandocMonad m => String -> TagParser m a -> TagParser m a
pOptInTag tagtype p = try $ do
skipMany pBlank
optional $ pSatisfy (~== TagOpen tagtype [])
@@ -731,7 +746,7 @@ pOptInTag tagtype p = try $ do
skipMany pBlank
return x
-pCloses :: String -> TagParser ()
+pCloses :: PandocMonad m => String -> TagParser m ()
pCloses tagtype = try $ do
t <- lookAhead $ pSatisfy $ \tag -> isTagClose tag || isTagOpen tag
case t of
@@ -744,23 +759,25 @@ pCloses tagtype = try $ do
(TagClose "table") | tagtype == "tr" -> return ()
_ -> mzero
-pTagText :: TagParser Inlines
+pTagText :: PandocMonad m => TagParser m Inlines
pTagText = try $ do
(TagText str) <- pSatisfy isTagText
st <- getState
qu <- ask
- case flip runReader qu $ runParserT (many pTagContents) st "text" str of
- Left _ -> fail $ "Could not parse `" ++ str ++ "'"
+ parsed <- lift $ lift $
+ flip runReaderT qu $ runParserT (many pTagContents) st "text" str
+ case parsed of
+ Left _ -> throwError $ PandocParseError $ "Could not parse `" ++ str ++ "'"
Right result -> return $ mconcat result
-pBlank :: TagParser ()
+pBlank :: PandocMonad m => TagParser m ()
pBlank = try $ do
(TagText str) <- pSatisfy isTagText
guard $ all isSpace str
-type InlinesParser = HTMLParser String
+type InlinesParser m = HTMLParser m String
-pTagContents :: InlinesParser Inlines
+pTagContents :: PandocMonad m => InlinesParser m Inlines
pTagContents =
B.displayMath <$> mathDisplay
<|> B.math <$> mathInline
@@ -770,7 +787,7 @@ pTagContents =
<|> pSymbol
<|> pBad
-pStr :: InlinesParser Inlines
+pStr :: PandocMonad m => InlinesParser m Inlines
pStr = do
result <- many1 $ satisfy $ \c ->
not (isSpace c) && not (isSpecial c) && not (isBad c)
@@ -789,13 +806,13 @@ isSpecial '\8220' = True
isSpecial '\8221' = True
isSpecial _ = False
-pSymbol :: InlinesParser Inlines
+pSymbol :: PandocMonad m => InlinesParser m Inlines
pSymbol = satisfy isSpecial >>= return . B.str . (:[])
isBad :: Char -> Bool
isBad c = c >= '\128' && c <= '\159' -- not allowed in HTML
-pBad :: InlinesParser Inlines
+pBad :: PandocMonad m => InlinesParser m Inlines
pBad = do
c <- satisfy isBad
let c' = case c of
@@ -829,7 +846,7 @@ pBad = do
_ -> '?'
return $ B.str [c']
-pSpace :: InlinesParser Inlines
+pSpace :: PandocMonad m => InlinesParser m Inlines
pSpace = many1 (satisfy isSpace) >>= \xs ->
if '\n' `elem` xs
then return B.softbreak
@@ -1070,7 +1087,7 @@ instance HasHeaderMap HTMLState where
-- This signature should be more general
-- MonadReader HTMLLocal m => HasQuoteContext st m
-instance HasQuoteContext st (Reader HTMLLocal) where
+instance PandocMonad m => HasQuoteContext st (ReaderT HTMLLocal m) where
getQuoteContext = asks quoteContext
withQuoteContext q = local (\s -> s{quoteContext = q})
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-02 01:32:32 +0000