Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Use Parser as type synonym for Parsec.

Browse source
This commit is contained in:
John MacFarlane 2012-07-20 15:54:57 -07:00
parent 5085962c28
commit 2c30c48757
10 changed files with 324 additions and 322 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/Text/Pandoc/Biblio.hs
View file

@ -165,7 +165,7 @@ locatorWords inp =
breakup (x : xs) = x : breakup xs
splitup = groupBy (\x y -> x /= '\160' && y /= '\160')
pLocatorWords :: Parsec [Inline] st (String, [Inline])
pLocatorWords :: Parser [Inline] st (String, [Inline])
pLocatorWords = do
l <- pLocator
s <- getInput -- rest is suffix
@ -173,16 +173,16 @@ pLocatorWords = do
then return (init l, Str "," : s)
else return (l, s)
pMatch :: (Inline -> Bool) -> Parsec [Inline] st Inline
pMatch :: (Inline -> Bool) -> Parser [Inline] st Inline
pMatch condition = try $ do
t <- anyToken
guard $ condition t
return t
pSpace :: Parsec [Inline] st Inline
pSpace :: Parser [Inline] st Inline
pSpace = pMatch (\t -> t == Space || t == Str "\160")
pLocator :: Parsec [Inline] st String
pLocator :: Parser [Inline] st String
pLocator = try $ do
optional $ pMatch (== Str ",")
optional pSpace
@ -190,7 +190,7 @@ pLocator = try $ do
gs <- many1 pWordWithDigits
return $ stringify f ++ (' ' : unwords gs)
pWordWithDigits :: Parsec [Inline] st String
pWordWithDigits :: Parser [Inline] st String
pWordWithDigits = try $ do
pSpace
r <- many1 (notFollowedBy pSpace >> anyToken)

4
src/Text/Pandoc/Parsing.hs
View file

@ -75,7 +75,7 @@ module Text.Pandoc.Parsing ( (>>~),
macro,
applyMacros',
-- * Re-exports from Text.Pandoc.Parsec
Parsec,
Parser,
runParser,
parse,
anyToken,
@ -141,6 +141,8 @@ import Text.TeXMath.Macros (applyMacros, Macro, parseMacroDefinitions)
import Text.HTML.TagSoup.Entity ( lookupEntity )
import Data.Default
type Parser t s = Parsec t s
-- | Like >>, but returns the operation on the left.
-- (Suggested by Tillmann Rendel on Haskell-cafe list.)
(>>~) :: (Monad m) => m a -> m b -> m a

16
src/Text/Pandoc/Readers/HTML.hs
View file

@ -66,7 +66,7 @@ readHtml st inp = Pandoc meta blocks
then parseHeader tags
else (Meta [] [] [], tags)
type TagParser = Parsec [Tag String] ParserState
type TagParser = Parser [Tag String] ParserState
-- TODO - fix this - not every header has a title tag
parseHeader :: [Tag String] -> (Meta, [Tag String])
@ -430,11 +430,11 @@ pBlank = try $ do
(TagText str) <- pSatisfy isTagText
guard $ all isSpace str
pTagContents :: Parsec [Char] ParserState Inline
pTagContents :: Parser [Char] ParserState Inline
pTagContents =
pStr <|> pSpace <|> smartPunctuation pTagContents <|> pSymbol <|> pBad
pStr :: Parsec [Char] ParserState Inline
pStr :: Parser [Char] ParserState Inline
pStr = do
result <- many1 $ satisfy $ \c ->
not (isSpace c) && not (isSpecial c) && not (isBad c)
@ -453,13 +453,13 @@ isSpecial '\8220' = True
isSpecial '\8221' = True
isSpecial _ = False
pSymbol :: Parsec [Char] ParserState Inline
pSymbol :: Parser [Char] ParserState Inline
pSymbol = satisfy isSpecial >>= return . Str . (:[])
isBad :: Char -> Bool
isBad c = c >= '\128' && c <= '\159' -- not allowed in HTML
pBad :: Parsec [Char] ParserState Inline
pBad :: Parser [Char] ParserState Inline
pBad = do
c <- satisfy isBad
let c' = case c of
@ -493,7 +493,7 @@ pBad = do
_ -> '?'
return $ Str [c']
pSpace :: Parsec [Char] ParserState Inline
pSpace :: Parser [Char] ParserState Inline
pSpace = many1 (satisfy isSpace) >> return Space
--
@ -591,7 +591,7 @@ _ `closes` _ = False
--- parsers for use in markdown, textile readers
-- | Matches a stretch of HTML in balanced tags.
htmlInBalanced :: (Tag String -> Bool) -> Parsec [Char] ParserState String
htmlInBalanced :: (Tag String -> Bool) -> Parser [Char] ParserState String
htmlInBalanced f = try $ do
(TagOpen t _, tag) <- htmlTag f
guard $ '/' `notElem` tag -- not a self-closing tag
@ -604,7 +604,7 @@ htmlInBalanced f = try $ do
return $ tag ++ concat contents ++ endtag
-- | Matches a tag meeting a certain condition.
htmlTag :: (Tag String -> Bool) -> Parsec [Char] ParserState (Tag String, String)
htmlTag :: (Tag String -> Bool) -> Parser [Char] ParserState (Tag String, String)
htmlTag f = try $ do
lookAhead (char '<')
(next : _) <- getInput >>= return . canonicalizeTags . parseTags

6
src/Text/Pandoc/Readers/LaTeX.hs
View file

@ -63,7 +63,7 @@ parseLaTeX = do
let date' = stateDate st
return $ Pandoc (Meta title' authors' date') $ toList bs
type LP = Parsec [Char] ParserState
type LP = Parser [Char] ParserState
anyControlSeq :: LP String
anyControlSeq = do
@ -712,10 +712,10 @@ verbatimEnv = do
rest <- getInput
return (r,rest)
rawLaTeXBlock :: Parsec [Char] ParserState String
rawLaTeXBlock :: Parser [Char] ParserState String
rawLaTeXBlock = snd <$> withRaw (environment <|> blockCommand)
rawLaTeXInline :: Parsec [Char] ParserState Inline
rawLaTeXInline :: Parser [Char] ParserState Inline
rawLaTeXInline = do
(res, raw) <- withRaw inlineCommand
if res == mempty

268
src/Text/Pandoc/Readers/Markdown.hs
View file

@ -82,14 +82,14 @@ isBlank _ = False
-- auxiliary functions
--
indentSpaces :: Parsec [Char] ParserState [Char]
indentSpaces :: Parser [Char] ParserState [Char]
indentSpaces = try $ do
state <- getState
let tabStop = stateTabStop state
count tabStop (char ' ') <|>
string "\t" <?> "indentation"
nonindentSpaces :: Parsec [Char] ParserState [Char]
nonindentSpaces :: Parser [Char] ParserState [Char]
nonindentSpaces = do
state <- getState
let tabStop = stateTabStop state
@ -98,30 +98,30 @@ nonindentSpaces = do
then return sps
else unexpected "indented line"
skipNonindentSpaces :: Parsec [Char] ParserState ()
skipNonindentSpaces :: Parser [Char] ParserState ()
skipNonindentSpaces = do
state <- getState
atMostSpaces (stateTabStop state - 1)
atMostSpaces :: Int -> Parsec [Char] ParserState ()
atMostSpaces :: Int -> Parser [Char] ParserState ()
atMostSpaces 0 = notFollowedBy (char ' ')
atMostSpaces n = (char ' ' >> atMostSpaces (n-1)) <|> return ()
litChar :: Parsec [Char] ParserState Char
litChar :: Parser [Char] ParserState Char
litChar = escapedChar'
<|> noneOf "\n"
<|> (newline >> notFollowedBy blankline >> return ' ')
-- | Fail unless we're at beginning of a line.
failUnlessBeginningOfLine :: Parsec [tok] st ()
failUnlessBeginningOfLine :: Parser [tok] st ()
failUnlessBeginningOfLine = do
pos <- getPosition
if sourceColumn pos == 1 then return () else fail "not beginning of line"
-- | Parse a sequence of inline elements between square brackets,
-- including inlines between balanced pairs of square brackets.
inlinesInBalancedBrackets :: Parsec [Char] ParserState Inline
-> Parsec [Char] ParserState [Inline]
inlinesInBalancedBrackets :: Parser [Char] ParserState Inline
-> Parser [Char] ParserState [Inline]
inlinesInBalancedBrackets parser = try $ do
char '['
result <- manyTill ( (do lookAhead $ try $ do (Str res) <- parser
@ -136,7 +136,7 @@ inlinesInBalancedBrackets parser = try $ do
-- document structure
--
titleLine :: Parsec [Char] ParserState [Inline]
titleLine :: Parser [Char] ParserState [Inline]
titleLine = try $ do
char '%'
skipSpaces
@ -145,7 +145,7 @@ titleLine = try $ do
newline
return $ normalizeSpaces res
authorsLine :: Parsec [Char] ParserState [[Inline]]
authorsLine :: Parser [Char] ParserState [[Inline]]
authorsLine = try $ do
char '%'
skipSpaces
@ -156,14 +156,14 @@ authorsLine = try $ do
newline
return $ filter (not . null) $ map normalizeSpaces authors
dateLine :: Parsec [Char] ParserState [Inline]
dateLine :: Parser [Char] ParserState [Inline]
dateLine = try $ do
char '%'
skipSpaces
date <- manyTill inline newline
return $ normalizeSpaces date
titleBlock :: Parsec [Char] ParserState ([Inline], [[Inline]], [Inline])
titleBlock :: Parser [Char] ParserState ([Inline], [[Inline]], [Inline])
titleBlock = try $ do
failIfStrict
title <- option [] titleLine
@ -172,7 +172,7 @@ titleBlock = try $ do
optional blanklines
return (title, author, date)
parseMarkdown :: Parsec [Char] ParserState Pandoc
parseMarkdown :: Parser [Char] ParserState Pandoc
parseMarkdown = do
-- markdown allows raw HTML
updateState (\state -> state { stateParseRaw = True })
@ -210,7 +210,7 @@ parseMarkdown = do
-- initial pass for references and notes
--
referenceKey :: Parsec [Char] ParserState [Char]
referenceKey :: Parser [Char] ParserState [Char]
referenceKey = try $ do
startPos <- getPosition
skipNonindentSpaces
@ -237,7 +237,7 @@ referenceKey = try $ do
-- return blanks so line count isn't affected
return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
referenceTitle :: Parsec [Char] ParserState String
referenceTitle :: Parser [Char] ParserState String
referenceTitle = try $ do
skipSpaces >> optional newline >> skipSpaces
tit <- (charsInBalanced '(' ')' litChar >>= return . unwords . words)
@ -246,23 +246,23 @@ referenceTitle = try $ do
notFollowedBy (noneOf ")\n")))
return $ fromEntities tit
noteMarker :: Parsec [Char] ParserState [Char]
noteMarker :: Parser [Char] ParserState [Char]
noteMarker = string "[^" >> many1Till (satisfy $ not . isBlank) (char ']')
rawLine :: Parsec [Char] ParserState [Char]
rawLine :: Parser [Char] ParserState [Char]
rawLine = try $ do
notFollowedBy blankline
notFollowedBy' $ try $ skipNonindentSpaces >> noteMarker
optional indentSpaces
anyLine
rawLines :: Parsec [Char] ParserState [Char]
rawLines :: Parser [Char] ParserState [Char]
rawLines = do
first <- anyLine
rest <- many rawLine
return $ unlines (first:rest)
noteBlock :: Parsec [Char] ParserState [Char]
noteBlock :: Parser [Char] ParserState [Char]
noteBlock = try $ do
startPos <- getPosition
skipNonindentSpaces
@ -286,10 +286,10 @@ noteBlock = try $ do
-- parsing blocks
--
parseBlocks :: Parsec [Char] ParserState [Block]
parseBlocks :: Parser [Char] ParserState [Block]
parseBlocks = manyTill block eof
block :: Parsec [Char] ParserState Block
block :: Parser [Char] ParserState Block
block = do
st <- getState
choice (if stateStrict st
@ -324,10 +324,10 @@ block = do
-- header blocks
--
header :: Parsec [Char] ParserState Block
header :: Parser [Char] ParserState Block
header = setextHeader <|> atxHeader <?> "header"
atxHeader :: Parsec [Char] ParserState Block
atxHeader :: Parser [Char] ParserState Block
atxHeader = try $ do
level <- many1 (char '#') >>= return . length
notFollowedBy (char '.' <|> char ')') -- this would be a list
@ -335,10 +335,10 @@ atxHeader = try $ do
text <- manyTill inline atxClosing >>= return . normalizeSpaces
return $ Header level text
atxClosing :: Parsec [Char] st [Char]
atxClosing :: Parser [Char] st [Char]
atxClosing = try $ skipMany (char '#') >> blanklines
setextHeader :: Parsec [Char] ParserState Block
setextHeader :: Parser [Char] ParserState Block
setextHeader = try $ do
-- This lookahead prevents us from wasting time parsing Inlines
-- unless necessary -- it gives a significant performance boost.
@ -354,7 +354,7 @@ setextHeader = try $ do
-- hrule block
--
hrule :: Parsec [Char] st Block
hrule :: Parser [Char] st Block
hrule = try $ do
skipSpaces
start <- satisfy isHruleChar
@ -368,12 +368,12 @@ hrule = try $ do
-- code blocks
--
indentedLine :: Parsec [Char] ParserState [Char]
indentedLine :: Parser [Char] ParserState [Char]
indentedLine = indentSpaces >> manyTill anyChar newline >>= return . (++ "\n")
blockDelimiter :: (Char -> Bool)
-> Maybe Int
-> Parsec [Char] st (Int, (String, [String], [(String, String)]), Char)
-> Parser [Char] st (Int, (String, [String], [(String, String)]), Char)
blockDelimiter f len = try $ do
c <- lookAhead (satisfy f)
size <- case len of
@ -387,7 +387,7 @@ blockDelimiter f len = try $ do
blankline
return (size, attr, c)
attributes :: Parsec [Char] st ([Char], [[Char]], [([Char], [Char])])
attributes :: Parser [Char] st ([Char], [[Char]], [([Char], [Char])])
attributes = try $ do
char '{'
spnl
@ -399,28 +399,28 @@ attributes = try $ do
| otherwise = firstNonNull xs
return (firstNonNull $ reverse ids, concat classes, concat keyvals)
attribute :: Parsec [Char] st ([Char], [[Char]], [([Char], [Char])])
attribute :: Parser [Char] st ([Char], [[Char]], [([Char], [Char])])
attribute = identifierAttr <|> classAttr <|> keyValAttr
identifier :: Parsec [Char] st [Char]
identifier :: Parser [Char] st [Char]
identifier = do
first <- letter
rest <- many $ alphaNum <|> oneOf "-_:."
return (first:rest)
identifierAttr :: Parsec [Char] st ([Char], [a], [a1])
identifierAttr :: Parser [Char] st ([Char], [a], [a1])
identifierAttr = try $ do
char '#'
result <- identifier
return (result,[],[])
classAttr :: Parsec [Char] st ([Char], [[Char]], [a])
classAttr :: Parser [Char] st ([Char], [[Char]], [a])
classAttr = try $ do
char '.'
result <- identifier
return ("",[result],[])
keyValAttr :: Parsec [Char] st ([Char], [a], [([Char], [Char])])
keyValAttr :: Parser [Char] st ([Char], [a], [([Char], [Char])])
keyValAttr = try $ do
key <- identifier
char '='
@ -429,14 +429,14 @@ keyValAttr = try $ do
<|> many nonspaceChar
return ("",[],[(key,val)])
codeBlockDelimited :: Parsec [Char] st Block
codeBlockDelimited :: Parser [Char] st Block
codeBlockDelimited = try $ do
(size, attr, c) <- blockDelimiter (\c -> c == '~' || c == '`') Nothing
contents <- manyTill anyLine (blockDelimiter (== c) (Just size))
blanklines
return $ CodeBlock attr $ intercalate "\n" contents
codeBlockIndented :: Parsec [Char] ParserState Block
codeBlockIndented :: Parser [Char] ParserState Block
codeBlockIndented = do
contents <- many1 (indentedLine <|>
try (do b <- blanklines
@ -447,7 +447,7 @@ codeBlockIndented = do
return $ CodeBlock ("", stateIndentedCodeClasses st, []) $
stripTrailingNewlines $ concat contents
lhsCodeBlock :: Parsec [Char] ParserState Block
lhsCodeBlock :: Parser [Char] ParserState Block
lhsCodeBlock = do
failUnlessLHS
liftM (CodeBlock ("",["sourceCode","literate","haskell"],[]))
@ -455,7 +455,7 @@ lhsCodeBlock = do
<|> liftM (CodeBlock ("",["sourceCode","haskell"],[]))
lhsCodeBlockInverseBird
lhsCodeBlockLaTeX :: Parsec [Char] ParserState String
lhsCodeBlockLaTeX :: Parser [Char] ParserState String
lhsCodeBlockLaTeX = try $ do
string "\\begin{code}"
manyTill spaceChar newline
@ -463,13 +463,13 @@ lhsCodeBlockLaTeX = try $ do
blanklines
return $ stripTrailingNewlines contents
lhsCodeBlockBird :: Parsec [Char] ParserState String
lhsCodeBlockBird :: Parser [Char] ParserState String
lhsCodeBlockBird = lhsCodeBlockBirdWith '>'
lhsCodeBlockInverseBird :: Parsec [Char] ParserState String
lhsCodeBlockInverseBird :: Parser [Char] ParserState String
lhsCodeBlockInverseBird = lhsCodeBlockBirdWith '<'
lhsCodeBlockBirdWith :: Char -> Parsec [Char] ParserState String
lhsCodeBlockBirdWith :: Char -> Parser [Char] ParserState String
lhsCodeBlockBirdWith c = try $ do
pos <- getPosition
when (sourceColumn pos /= 1) $ fail "Not in first column"
@ -481,7 +481,7 @@ lhsCodeBlockBirdWith c = try $ do
blanklines
return $ intercalate "\n" lns'
birdTrackLine :: Char -> Parsec [Char] st [Char]
birdTrackLine :: Char -> Parser [Char] st [Char]
birdTrackLine c = try $ do
char c
-- allow html tags on left margin:
@ -493,10 +493,10 @@ birdTrackLine c = try $ do
-- block quotes
--
emailBlockQuoteStart :: Parsec [Char] ParserState Char
emailBlockQuoteStart :: Parser [Char] ParserState Char
emailBlockQuoteStart = try $ skipNonindentSpaces >> char '>' >>~ optional (char ' ')
emailBlockQuote :: Parsec [Char] ParserState [[Char]]
emailBlockQuote :: Parser [Char] ParserState [[Char]]
emailBlockQuote = try $ do
emailBlockQuoteStart
raw <- sepBy (many (nonEndline <|>
@ -507,7 +507,7 @@ emailBlockQuote = try $ do
optional blanklines
return raw
blockQuote :: Parsec [Char] ParserState Block
blockQuote :: Parser [Char] ParserState Block
blockQuote = do
raw <- emailBlockQuote
-- parse the extracted block, which may contain various block elements:
@ -518,7 +518,7 @@ blockQuote = do
-- list blocks
--
bulletListStart :: Parsec [Char] ParserState ()
bulletListStart :: Parser [Char] ParserState ()
bulletListStart = try $ do
optional newline -- if preceded by a Plain block in a list context
skipNonindentSpaces
@ -527,7 +527,7 @@ bulletListStart = try $ do
spaceChar
skipSpaces
anyOrderedListStart :: Parsec [Char] ParserState (Int, ListNumberStyle, ListNumberDelim)
anyOrderedListStart :: Parser [Char] ParserState (Int, ListNumberStyle, ListNumberDelim)
anyOrderedListStart = try $ do
optional newline -- if preceded by a Plain block in a list context
skipNonindentSpaces
@ -547,11 +547,11 @@ anyOrderedListStart = try $ do
skipSpaces
return (num, style, delim)
listStart :: Parsec [Char] ParserState ()
listStart :: Parser [Char] ParserState ()
listStart = bulletListStart <|> (anyOrderedListStart >> return ())
-- parse a line of a list item (start = parser for beginning of list item)
listLine :: Parsec [Char] ParserState [Char]
listLine :: Parser [Char] ParserState [Char]
listLine = try $ do
notFollowedBy blankline
notFollowedBy' (do indentSpaces
@ -561,8 +561,8 @@ listLine = try $ do
return $ concat chunks ++ "\n"
-- parse raw text for one list item, excluding start marker and continuations
rawListItem :: Parsec [Char] ParserState a
-> Parsec [Char] ParserState [Char]
rawListItem :: Parser [Char] ParserState a
-> Parser [Char] ParserState [Char]
rawListItem start = try $ do
start
first <- listLine
@ -573,14 +573,14 @@ rawListItem start = try $ do
-- continuation of a list item - indented and separated by blankline
-- or (in compact lists) endline.
-- note: nested lists are parsed as continuations
listContinuation :: Parsec [Char] ParserState [Char]
listContinuation :: Parser [Char] ParserState [Char]
listContinuation = try $ do
lookAhead indentSpaces
result <- many1 listContinuationLine
blanks <- many blankline
return $ concat result ++ blanks
listContinuationLine :: Parsec [Char] ParserState [Char]
listContinuationLine :: Parser [Char] ParserState [Char]
listContinuationLine = try $ do
notFollowedBy blankline
notFollowedBy' listStart
@ -588,8 +588,8 @@ listContinuationLine = try $ do
result <- manyTill anyChar newline
return $ result ++ "\n"
listItem :: Parsec [Char] ParserState a
-> Parsec [Char] ParserState [Block]
listItem :: Parser [Char] ParserState a
-> Parser [Char] ParserState [Block]
listItem start = try $ do
first <- rawListItem start
continuations <- many listContinuation
@ -605,7 +605,7 @@ listItem start = try $ do
updateState (\st -> st {stateParserContext = oldContext})
return contents
orderedList :: Parsec [Char] ParserState Block
orderedList :: Parser [Char] ParserState Block
orderedList = try $ do
(start, style, delim) <- lookAhead anyOrderedListStart
items <- many1 $ listItem $ try $
@ -614,13 +614,13 @@ orderedList = try $ do
orderedListMarker style delim
return $ OrderedList (start, style, delim) $ compactify items
bulletList :: Parsec [Char] ParserState Block
bulletList :: Parser [Char] ParserState Block
bulletList =
many1 (listItem bulletListStart) >>= return . BulletList . compactify
-- definition lists
defListMarker :: Parsec [Char] ParserState ()
defListMarker :: Parser [Char] ParserState ()
defListMarker = do
sps <- nonindentSpaces
char ':' <|> char '~'
@ -632,7 +632,7 @@ defListMarker = do
else mzero
return ()
definitionListItem :: Parsec [Char] ParserState ([Inline], [[Block]])
definitionListItem :: Parser [Char] ParserState ([Inline], [[Block]])
definitionListItem = try $ do
-- first, see if this has any chance of being a definition list:
lookAhead (anyLine >> optional blankline >> defListMarker)
@ -646,7 +646,7 @@ definitionListItem = try $ do
updateState (\st -> st {stateParserContext = oldContext})
return ((normalizeSpaces term), contents)
defRawBlock :: Parsec [Char] ParserState [Char]
defRawBlock :: Parser [Char] ParserState [Char]
defRawBlock = try $ do
defListMarker
firstline <- anyLine
@ -658,7 +658,7 @@ defRawBlock = try $ do
return $ unlines lns ++ trl
return $ firstline ++ "\n" ++ unlines rawlines ++ trailing ++ cont
definitionList :: Parsec [Char] ParserState Block
definitionList :: Parser [Char] ParserState Block
definitionList = do
items <- many1 definitionListItem
-- "compactify" the definition list:
@ -687,7 +687,7 @@ isHtmlOrBlank (Space) = True
isHtmlOrBlank (LineBreak) = True
isHtmlOrBlank _ = False
para :: Parsec [Char] ParserState Block
para :: Parser [Char] ParserState Block
para = try $ do
result <- liftM normalizeSpaces $ many1 inline
guard $ not . all isHtmlOrBlank $ result
@ -698,17 +698,17 @@ para = try $ do
lookAhead (blockQuote <|> header) >> return "")
return $ Para result
plain :: Parsec [Char] ParserState Block
plain :: Parser [Char] ParserState Block
plain = many1 inline >>~ spaces >>= return . Plain . normalizeSpaces
--
-- raw html
--
htmlElement :: Parsec [Char] ParserState [Char]
htmlElement :: Parser [Char] ParserState [Char]
htmlElement = strictHtmlBlock <|> liftM snd (htmlTag isBlockTag)
htmlBlock :: Parsec [Char] ParserState Block
htmlBlock :: Parser [Char] ParserState Block
htmlBlock = try $ do
failUnlessBeginningOfLine
first <- htmlElement
@ -716,12 +716,12 @@ htmlBlock = try $ do
finalNewlines <- many newline
return $ RawBlock "html" $ first ++ finalSpace ++ finalNewlines
strictHtmlBlock :: Parsec [Char] ParserState [Char]
strictHtmlBlock :: Parser [Char] ParserState [Char]
strictHtmlBlock = do
failUnlessBeginningOfLine
htmlInBalanced (not . isInlineTag)
rawVerbatimBlock :: Parsec [Char] ParserState String
rawVerbatimBlock :: Parser [Char] ParserState String
rawVerbatimBlock = try $ do
(TagOpen tag _, open) <- htmlTag (tagOpen (\t ->
t == "pre" || t == "style" || t == "script")
@ -729,7 +729,7 @@ rawVerbatimBlock = try $ do
contents <- manyTill anyChar (htmlTag (~== TagClose tag))
return $ open ++ contents ++ renderTags [TagClose tag]
rawTeXBlock :: Parsec [Char] ParserState Block
rawTeXBlock :: Parser [Char] ParserState Block
rawTeXBlock = do
failIfStrict
result <- liftM (RawBlock "latex") rawLaTeXBlock
@ -737,7 +737,7 @@ rawTeXBlock = do
spaces
return result
rawHtmlBlocks :: Parsec [Char] ParserState Block
rawHtmlBlocks :: Parser [Char] ParserState Block
rawHtmlBlocks = do
htmlBlocks <- many1 $ do blk <- rawVerbatimBlock <|>
liftM snd (htmlTag isBlockTag)
@ -761,7 +761,7 @@ rawHtmlBlocks = do
-- Parse a dashed line with optional trailing spaces; return its length
-- and the length including trailing space.
dashedLine :: Char
-> Parsec [Char] st (Int, Int)
-> Parser [Char] st (Int, Int)
dashedLine ch = do
dashes <- many1 (char ch)
sp <- many spaceChar
@ -770,7 +770,7 @@ dashedLine ch = do
-- Parse a table header with dashed lines of '-' preceded by
-- one (or zero) line of text.
simpleTableHeader :: Bool -- ^ Headerless table
-> Parsec [Char] ParserState ([[Block]], [Alignment], [Int])
-> Parser [Char] ParserState ([[Block]], [Alignment], [Int])
simpleTableHeader headless = try $ do
rawContent <- if headless
then return ""
@ -794,16 +794,16 @@ simpleTableHeader headless = try $ do
return (heads, aligns, indices)
-- Parse a table footer - dashed lines followed by blank line.
tableFooter :: Parsec [Char] ParserState [Char]
tableFooter :: Parser [Char] ParserState [Char]
tableFooter = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> blanklines
-- Parse a table separator - dashed line.
tableSep :: Parsec [Char] ParserState Char
tableSep :: Parser [Char] ParserState Char
tableSep = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> char '\n'
-- Parse a raw line and split it into chunks by indices.
rawTableLine :: [Int]
-> Parsec [Char] ParserState [String]
-> Parser [Char] ParserState [String]
rawTableLine indices = do
notFollowedBy' (blanklines <|> tableFooter)
line <- many1Till anyChar newline
@ -812,12 +812,12 @@ rawTableLine indices = do
-- Parse a table line and return a list of lists of blocks (columns).
tableLine :: [Int]
-> Parsec [Char] ParserState [[Block]]
-> Parser [Char] ParserState [[Block]]
tableLine indices = rawTableLine indices >>= mapM (parseFromString (many plain))
-- Parse a multiline table row and return a list of blocks (columns).
multilineRow :: [Int]
-> Parsec [Char] ParserState [[Block]]
-> Parser [Char] ParserState [[Block]]
multilineRow indices = do
colLines <- many1 (rawTableLine indices)
let cols = map unlines $ transpose colLines
@ -825,7 +825,7 @@ multilineRow indices = do
-- Parses a table caption: inlines beginning with 'Table:'
-- and followed by blank lines.
tableCaption :: Parsec [Char] ParserState [Inline]
tableCaption :: Parser [Char] ParserState [Inline]
tableCaption = try $ do
skipNonindentSpaces
string ":" <|> string "Table:"
@ -835,7 +835,7 @@ tableCaption = try $ do
-- Parse a simple table with '---' header and one line per row.
simpleTable :: Bool -- ^ Headerless table
-> Parsec [Char] ParserState Block
-> Parser [Char] ParserState Block
simpleTable headless = do
Table c a _w h l <- tableWith (simpleTableHeader headless) tableLine
(return ())
@ -849,12 +849,12 @@ simpleTable headless = do
-- which may be multiline, separated by blank lines, and
-- ending with a footer (dashed line followed by blank line).
multilineTable :: Bool -- ^ Headerless table
-> Parsec [Char] ParserState Block
-> Parser [Char] ParserState Block
multilineTable headless =
tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter tableCaption
multilineTableHeader :: Bool -- ^ Headerless table
-> Parsec [Char] ParserState ([[Block]], [Alignment], [Int])
-> Parser [Char] ParserState ([[Block]], [Alignment], [Int])
multilineTableHeader headless = try $ do
if headless
then return '\n'
@ -902,10 +902,10 @@ alignType strLst len =
(False, False) -> AlignDefault
gridTable :: Bool -- ^ Headerless table
-> Parsec [Char] ParserState Block
-> Parser [Char] ParserState Block
gridTable = gridTableWith block tableCaption
table :: Parsec [Char] ParserState Block
table :: Parser [Char] ParserState Block
table = multilineTable False <|> simpleTable True <|>
simpleTable False <|> multilineTable True <|>
gridTable False <|> gridTable True <?> "table"
@ -914,10 +914,10 @@ table = multilineTable False <|> simpleTable True <|>
-- inline
--
inline :: Parsec [Char] ParserState Inline
inline :: Parser [Char] ParserState Inline
inline = choice inlineParsers <?> "inline"
inlineParsers :: [Parsec [Char] ParserState Inline]
inlineParsers :: [Parser [Char] ParserState Inline]
inlineParsers = [ whitespace
, str
, endline
@ -944,7 +944,7 @@ inlineParsers = [ whitespace
, symbol
, ltSign ]
escapedChar' :: Parsec [Char] ParserState Char
escapedChar' :: Parser [Char] ParserState Char
escapedChar' = try $ do
char '\\'
state <- getState
@ -952,7 +952,7 @@ escapedChar' = try $ do
then oneOf "\\`*_{}[]()>#+-.!~"
else satisfy (not . isAlphaNum)
escapedChar :: Parsec [Char] ParserState Inline
escapedChar :: Parser [Char] ParserState Inline
escapedChar = do
result <- escapedChar'
return $ case result of
@ -960,7 +960,7 @@ escapedChar = do
'\n' -> LineBreak -- "\[newline]" is a linebreak
_ -> Str [result]
ltSign :: Parsec [Char] ParserState Inline
ltSign :: Parser [Char] ParserState Inline
ltSign = do
st <- getState
if stateStrict st
@ -968,7 +968,7 @@ ltSign = do
else notFollowedBy' rawHtmlBlocks >> char '<' -- unless it starts html
return $ Str ['<']
exampleRef :: Parsec [Char] ParserState Inline
exampleRef :: Parser [Char] ParserState Inline
exampleRef = try $ do
char '@'
lab <- many1 (alphaNum <|> oneOf "-_")
@ -976,7 +976,7 @@ exampleRef = try $ do
-- later. See the end of parseMarkdown.
return $ Str $ '@' : lab
symbol :: Parsec [Char] ParserState Inline
symbol :: Parser [Char] ParserState Inline
symbol = do
result <- noneOf "<\\\n\t "
<|> try (do lookAhead $ char '\\'
@ -985,7 +985,7 @@ symbol = do
return $ Str [result]
-- parses inline code, between n `s and n `s
code :: Parsec [Char] ParserState Inline
code :: Parser [Char] ParserState Inline
code = try $ do
starts <- many1 (char '`')
skipSpaces
@ -996,26 +996,26 @@ code = try $ do
attr <- option ([],[],[]) (try $ optional whitespace >> attributes)
return $ Code attr $ removeLeadingTrailingSpace $ concat result
mathWord :: Parsec [Char] st [Char]
mathWord :: Parser [Char] st [Char]
mathWord = liftM concat $ many1 mathChunk
mathChunk :: Parsec [Char] st [Char]
mathChunk :: Parser [Char] st [Char]
mathChunk = do char '\\'
c <- anyChar
return ['\\',c]
<|> many1 (satisfy $ \c -> not (isBlank c || c == '\\' || c == '$'))
math :: Parsec [Char] ParserState Inline
math :: Parser [Char] ParserState Inline
math = (mathDisplay >>= applyMacros' >>= return . Math DisplayMath)
<|> (mathInline >>= applyMacros' >>= return . Math InlineMath)
mathDisplay :: Parsec [Char] ParserState String
mathDisplay :: Parser [Char] ParserState String
mathDisplay = try $ do
failIfStrict
string "$$"
many1Till (noneOf "\n" <|> (newline >>~ notFollowedBy' blankline)) (try $ string "$$")
mathInline :: Parsec [Char] ParserState String
mathInline :: Parser [Char] ParserState String
mathInline = try $ do
failIfStrict
char '$'
@ -1027,7 +1027,7 @@ mathInline = try $ do
-- to avoid performance problems, treat 4 or more _ or * or ~ or ^ in a row
-- as a literal rather than attempting to parse for emph/strong/strikeout/super/sub
fours :: Parsec [Char] st Inline
fours :: Parser [Char] st Inline
fours = try $ do
x <- char '*' <|> char '_' <|> char '~' <|> char '^'
count 2 $ satisfy (==x)
@ -1036,9 +1036,9 @@ fours = try $ do
-- | Parses a list of inlines between start and end delimiters.
inlinesBetween :: (Show b)
=> Parsec [Char] ParserState a
-> Parsec [Char] ParserState b
-> Parsec [Char] ParserState [Inline]
=> Parser [Char] ParserState a
-> Parser [Char] ParserState b
-> Parser [Char] ParserState [Inline]
inlinesBetween start end =
normalizeSpaces `liftM` try (start >> many1Till inner end)
where inner = innerSpace <|> (notFollowedBy' whitespace >> inline)
@ -1046,8 +1046,8 @@ inlinesBetween start end =
-- This is used to prevent exponential blowups for things like:
-- a**a*a**a*a**a*a**a*a**a*a**a*a**
nested :: Parsec [Char] ParserState a
-> Parsec [Char] ParserState a
nested :: Parser [Char] ParserState a
-> Parser [Char] ParserState a
nested p = do
nestlevel <- stateMaxNestingLevel `fmap` getState
guard $ nestlevel > 0
@ -1056,7 +1056,7 @@ nested p = do
updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
return res
emph :: Parsec [Char] ParserState Inline
emph :: Parser [Char] ParserState Inline
emph = Emph `fmap` nested
(inlinesBetween starStart starEnd <|> inlinesBetween ulStart ulEnd)
where starStart = char '*' >> lookAhead nonspaceChar
@ -1064,7 +1064,7 @@ emph = Emph `fmap` nested
ulStart = char '_' >> lookAhead nonspaceChar
ulEnd = notFollowedBy' strong >> char '_'
strong :: Parsec [Char] ParserState Inline
strong :: Parser [Char] ParserState Inline
strong = Strong `liftM` nested
(inlinesBetween starStart starEnd <|> inlinesBetween ulStart ulEnd)
where starStart = string "**" >> lookAhead nonspaceChar
@ -1072,32 +1072,32 @@ strong = Strong `liftM` nested
ulStart = string "__" >> lookAhead nonspaceChar
ulEnd = try $ string "__"
strikeout :: Parsec [Char] ParserState Inline
strikeout :: Parser [Char] ParserState Inline
strikeout = Strikeout `liftM`
(failIfStrict >> inlinesBetween strikeStart strikeEnd)
where strikeStart = string "~~" >> lookAhead nonspaceChar
>> notFollowedBy (char '~')
strikeEnd = try $ string "~~"
superscript :: Parsec [Char] ParserState Inline
superscript :: Parser [Char] ParserState Inline
superscript = failIfStrict >> enclosed (char '^') (char '^')
(notFollowedBy spaceChar >> inline) >>= -- may not contain Space
return . Superscript
subscript :: Parsec [Char] ParserState Inline
subscript :: Parser [Char] ParserState Inline
subscript = failIfStrict >> enclosed (char '~') (char '~')
(notFollowedBy spaceChar >> inline) >>= -- may not contain Space
return . Subscript
whitespace :: Parsec [Char] ParserState Inline
whitespace :: Parser [Char] ParserState Inline
whitespace = spaceChar >>
( (spaceChar >> skipMany spaceChar >> option Space (endline >> return LineBreak))
<|> (skipMany spaceChar >> return Space) ) <?> "whitespace"
nonEndline :: Parsec [Char] st Char
nonEndline :: Parser [Char] st Char
nonEndline = satisfy (/='\n')
str :: Parsec [Char] ParserState Inline
str :: Parser [Char] ParserState Inline
str = do
smart <- stateSmart `fmap` getState
a <- alphaNum
@ -1135,7 +1135,7 @@ likelyAbbrev x =
in map snd $ filter (\(y,_) -> y == x) abbrPairs
-- an endline character that can be treated as a space, not a structural break
endline :: Parsec [Char] ParserState Inline
endline :: Parser [Char] ParserState Inline
endline = try $ do
newline
notFollowedBy blankline
@ -1154,20 +1154,20 @@ endline = try $ do
--
-- a reference label for a link
reference :: Parsec [Char] ParserState [Inline]
reference :: Parser [Char] ParserState [Inline]
reference = do notFollowedBy' (string "[^") -- footnote reference
result <- inlinesInBalancedBrackets inline
return $ normalizeSpaces result
-- source for a link, with optional title
source :: Parsec [Char] ParserState (String, [Char])
source :: Parser [Char] ParserState (String, [Char])
source =
(try $ charsInBalanced '(' ')' litChar >>= parseFromString source') <|>
-- the following is needed for cases like: [ref](/url(a).
(enclosed (char '(') (char ')') litChar >>= parseFromString source')
-- auxiliary function for source
source' :: Parsec [Char] ParserState (String, [Char])
source' :: Parser [Char] ParserState (String, [Char])
source' = do
skipSpaces
let nl = char '\n' >>~ notFollowedBy blankline
@ -1185,7 +1185,7 @@ source' = do
eof
return (escapeURI $ removeTrailingSpace src, tit)
linkTitle :: Parsec [Char] ParserState String
linkTitle :: Parser [Char] ParserState String
linkTitle = try $ do
(many1 spaceChar >> option '\n' newline) <|> newline
skipSpaces
@ -1193,7 +1193,7 @@ linkTitle = try $ do
tit <- manyTill litChar (try (char delim >> skipSpaces >> eof))
return $ fromEntities tit
link :: Parsec [Char] ParserState Inline
link :: Parser [Char] ParserState Inline
link = try $ do
lab <- reference
(src, tit) <- source <|> referenceLink lab
@ -1206,7 +1206,7 @@ delinkify = bottomUp $ concatMap go
-- a link like [this][ref] or [this][] or [this]
referenceLink :: [Inline]
-> Parsec [Char] ParserState (String, [Char])
-> Parser [Char] ParserState (String, [Char])
referenceLink lab = do
ref <- option [] (try (optional (char ' ') >>
optional (newline >> skipSpaces) >> reference))
@ -1216,7 +1216,7 @@ referenceLink lab = do
Nothing -> fail "no corresponding key"
Just target -> return target
autoLink :: Parsec [Char] ParserState Inline
autoLink :: Parser [Char] ParserState Inline
autoLink = try $ do
char '<'
(orig, src) <- uri <|> emailAddress
@ -1226,14 +1226,14 @@ autoLink = try $ do
then Link [Str orig] (src, "")
else Link [Code ("",["url"],[]) orig] (src, "")
image :: Parsec [Char] ParserState Inline
image :: Parser [Char] ParserState Inline
image = try $ do
char '!'
lab <- reference
(src, tit) <- source <|> referenceLink lab
return $ Image lab (src,tit)
note :: Parsec [Char] ParserState Inline
note :: Parser [Char] ParserState Inline
note = try $ do
failIfStrict
ref <- noteMarker
@ -1250,21 +1250,21 @@ note = try $ do
updateState $ \st -> st{ stateNotes = notes }
return $ Note contents
inlineNote :: Parsec [Char] ParserState Inline
inlineNote :: Parser [Char] ParserState Inline
inlineNote = try $ do
failIfStrict
char '^'
contents <- inlinesInBalancedBrackets inline
return $ Note [Para contents]
rawLaTeXInline' :: Parsec [Char] ParserState Inline
rawLaTeXInline' :: Parser [Char] ParserState Inline
rawLaTeXInline' = try $ do
failIfStrict
lookAhead $ char '\\' >> notFollowedBy' (string "start") -- context env
RawInline _ s <- rawLaTeXInline
return $ RawInline "tex" s -- "tex" because it might be context or latex
rawConTeXtEnvironment :: Parsec [Char] st String
rawConTeXtEnvironment :: Parser [Char] st String
rawConTeXtEnvironment = try $ do
string "\\start"
completion <- inBrackets (letter <|> digit <|> spaceChar)
@ -1273,14 +1273,14 @@ rawConTeXtEnvironment = try $ do
(try $ string "\\stop" >> string completion)
return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion
inBrackets :: (Parsec [Char] st Char) -> Parsec [Char] st String
inBrackets :: (Parser [Char] st Char) -> Parser [Char] st String
inBrackets parser = do
char '['
contents <- many parser
char ']'
return $ "[" ++ contents ++ "]"
rawHtmlInline :: Parsec [Char] ParserState Inline
rawHtmlInline :: Parser [Char] ParserState Inline
rawHtmlInline = do
st <- getState
(_,result) <- if stateStrict st
@ -1290,20 +1290,20 @@ rawHtmlInline = do
-- Citations
cite :: Parsec [Char] ParserState Inline
cite :: Parser [Char] ParserState Inline
cite = do
failIfStrict
citations <- textualCite <|> normalCite
return $ Cite citations []
spnl :: Parsec [Char] st ()
spnl :: Parser [Char] st ()
spnl = try $ do
skipSpaces
optional newline
skipSpaces
notFollowedBy (char '\n')
textualCite :: Parsec [Char] ParserState [Citation]
textualCite :: Parser [Char] ParserState [Citation]
textualCite = try $ do
(_, key) <- citeKey
let first = Citation{ citationId = key
@ -1318,7 +1318,7 @@ textualCite = try $ do
then option [first] $ bareloc first
else return $ first : rest
bareloc :: Citation -> Parsec [Char] ParserState [Citation]
bareloc :: Citation -> Parser [Char] ParserState [Citation]
bareloc c = try $ do
spnl
char '['
@ -1328,7 +1328,7 @@ bareloc c = try $ do
char ']'
return $ c{ citationSuffix = suff } : rest
normalCite :: Parsec [Char] ParserState [Citation]
normalCite :: Parser [Char] ParserState [Citation]
normalCite = try $ do
char '['
spnl
@ -1337,7 +1337,7 @@ normalCite = try $ do
char ']'
return citations
citeKey :: Parsec [Char] ParserState (Bool, String)
citeKey :: Parser [Char] ParserState (Bool, String)
citeKey = try $ do
suppress_author <- option False (char '-' >> return True)
char '@'
@ -1349,7 +1349,7 @@ citeKey = try $ do
guard $ key `elem` stateCitations st
return (suppress_author, key)
suffix :: Parsec [Char] ParserState [Inline]
suffix :: Parser [Char] ParserState [Inline]
suffix = try $ do
hasSpace <- option False (notFollowedBy nonspaceChar >> return True)
spnl
@ -1358,14 +1358,14 @@ suffix = try $ do
then Space : rest
else rest
prefix :: Parsec [Char] ParserState [Inline]
prefix :: Parser [Char] ParserState [Inline]
prefix = liftM normalizeSpaces $
manyTill inline (char ']' <|> liftM (const ']') (lookAhead citeKey))
citeList :: Parsec [Char] ParserState [Citation]
citeList :: Parser [Char] ParserState [Citation]
citeList = sepBy1 citation (try $ char ';' >> spnl)
citation :: Parsec [Char] ParserState Citation
citation :: Parser [Char] ParserState Citation
citation = try $ do
pref <- prefix
(suppress_author, key) <- citeKey

184
src/Text/Pandoc/Readers/RST.hs
View file

@ -88,7 +88,7 @@ titleTransform ((Header 1 head1):rest) |
(promoteHeaders 1 rest, head1)
titleTransform blocks = (blocks, [])
parseRST :: Parsec [Char] ParserState Pandoc
parseRST :: Parser [Char] ParserState Pandoc
parseRST = do
optional blanklines -- skip blank lines at beginning of file
startPos <- getPosition
@ -117,10 +117,10 @@ parseRST = do
-- parsing blocks
--
parseBlocks :: Parsec [Char] ParserState [Block]
parseBlocks :: Parser [Char] ParserState [Block]
parseBlocks = manyTill block eof
block :: Parsec [Char] ParserState Block
block :: Parser [Char] ParserState Block
block = choice [ codeBlock
, rawBlock
, blockQuote
@ -145,7 +145,7 @@ block = choice [ codeBlock
-- field list
--
rawFieldListItem :: String -> Parsec [Char] ParserState (String, String)
rawFieldListItem :: String -> Parser [Char] ParserState (String, String)
rawFieldListItem indent = try $ do
string indent
char ':'
@ -159,7 +159,7 @@ rawFieldListItem indent = try $ do
return (name, raw)
fieldListItem :: String
-> Parsec [Char] ParserState (Maybe ([Inline], [[Block]]))
-> Parser [Char] ParserState (Maybe ([Inline], [[Block]]))
fieldListItem indent = try $ do
(name, raw) <- rawFieldListItem indent
let term = [Str name]
@ -186,7 +186,7 @@ extractContents [Plain auth] = auth
extractContents [Para auth] = auth
extractContents _ = []
fieldList :: Parsec [Char] ParserState Block
fieldList :: Parser [Char] ParserState Block
fieldList = try $ do
indent <- lookAhead $ many spaceChar
items <- many1 $ fieldListItem indent
@ -198,7 +198,7 @@ fieldList = try $ do
-- line block
--
lineBlockLine :: Parsec [Char] ParserState [Inline]
lineBlockLine :: Parser [Char] ParserState [Inline]
lineBlockLine = try $ do
char '|'
char ' ' <|> lookAhead (char '\n')
@ -209,7 +209,7 @@ lineBlockLine = try $ do
then normalizeSpaces line
else Str white : normalizeSpaces line
lineBlock :: Parsec [Char] ParserState Block
lineBlock :: Parser [Char] ParserState Block
lineBlock = try $ do
lines' <- many1 lineBlockLine
blanklines
@ -219,14 +219,14 @@ lineBlock = try $ do
-- paragraph block
--
para :: Parsec [Char] ParserState Block
para :: Parser [Char] ParserState Block
para = paraBeforeCodeBlock <|> paraNormal <?> "paragraph"
codeBlockStart :: Parsec [Char] st Char
codeBlockStart :: Parser [Char] st Char
codeBlockStart = string "::" >> blankline >> blankline
-- paragraph that ends in a :: starting a code block
paraBeforeCodeBlock :: Parsec [Char] ParserState Block
paraBeforeCodeBlock :: Parser [Char] ParserState Block
paraBeforeCodeBlock = try $ do
result <- many1 (notFollowedBy' codeBlockStart >> inline)
lookAhead (string "::")
@ -235,21 +235,21 @@ paraBeforeCodeBlock = try $ do
else (normalizeSpaces result) ++ [Str ":"]
-- regular paragraph
paraNormal :: Parsec [Char] ParserState Block
paraNormal :: Parser [Char] ParserState Block
paraNormal = try $ do
result <- many1 inline
newline
blanklines
return $ Para $ normalizeSpaces result
plain :: Parsec [Char] ParserState Block
plain :: Parser [Char] ParserState Block
plain = many1 inline >>= return . Plain . normalizeSpaces
--
-- image block
--
imageBlock :: Parsec [Char] ParserState Block
imageBlock :: Parser [Char] ParserState Block
imageBlock = try $ do
string ".. image:: "
src <- manyTill anyChar newline
@ -264,11 +264,11 @@ imageBlock = try $ do
-- header blocks
--
header :: Parsec [Char] ParserState Block
header :: Parser [Char] ParserState Block
header = doubleHeader <|> singleHeader <?> "header"
-- a header with lines on top and bottom
doubleHeader :: Parsec [Char] ParserState Block
doubleHeader :: Parser [Char] ParserState Block
doubleHeader = try $ do
c <- oneOf underlineChars
rest <- many (char c) -- the top line
@ -293,7 +293,7 @@ doubleHeader = try $ do
return $ Header level (normalizeSpaces txt)
-- a header with line on the bottom only
singleHeader :: Parsec [Char] ParserState Block
singleHeader :: Parser [Char] ParserState Block
singleHeader = try $ do
notFollowedBy' whitespace
txt <- many1 (do {notFollowedBy blankline; inline})
@ -316,7 +316,7 @@ singleHeader = try $ do
-- hrule block
--
hrule :: Parsec [Char] st Block
hrule :: Parser [Char] st Block
hrule = try $ do
chr <- oneOf underlineChars
count 3 (char chr)
@ -330,14 +330,14 @@ hrule = try $ do
--
-- read a line indented by a given string
indentedLine :: String -> Parsec [Char] st [Char]
indentedLine :: String -> Parser [Char] st [Char]
indentedLine indents = try $ do
string indents
manyTill anyChar newline
-- one or more indented lines, possibly separated by blank lines.
-- any amount of indentation will work.
indentedBlock :: Parsec [Char] st [Char]
indentedBlock :: Parser [Char] st [Char]
indentedBlock = try $ do
indents <- lookAhead $ many1 spaceChar
lns <- many1 $ try $ do b <- option "" blanklines
@ -346,7 +346,7 @@ indentedBlock = try $ do
optional blanklines
return $ unlines lns
codeBlock :: Parsec [Char] st Block
codeBlock :: Parser [Char] st Block
codeBlock = try $ do
codeBlockStart
result <- indentedBlock
@ -354,7 +354,7 @@ codeBlock = try $ do
-- | The 'code-block' directive (from Sphinx) that allows a language to be
-- specified.
customCodeBlock :: Parsec [Char] st Block
customCodeBlock :: Parser [Char] st Block
customCodeBlock = try $ do
string ".. code-block:: "
language <- manyTill anyChar newline
@ -363,7 +363,7 @@ customCodeBlock = try $ do
return $ CodeBlock ("", ["sourceCode", language], []) $ stripTrailingNewlines result
figureBlock :: Parsec [Char] ParserState Block
figureBlock :: Parser [Char] ParserState Block
figureBlock = try $ do
string ".. figure::"
src <- removeLeadingTrailingSpace `fmap` manyTill anyChar newline
@ -371,24 +371,24 @@ figureBlock = try $ do
caption <- parseFromString extractCaption body
return $ Para [Image caption (src,"")]
extractCaption :: Parsec [Char] ParserState [Inline]
extractCaption :: Parser [Char] ParserState [Inline]
extractCaption = try $ do
manyTill anyLine blanklines
many inline
-- | The 'math' directive (from Sphinx) for display math.
mathBlock :: Parsec [Char] st Block
mathBlock :: Parser [Char] st Block
mathBlock = try $ do
string ".. math::"
mathBlockMultiline <|> mathBlockOneLine
mathBlockOneLine :: Parsec [Char] st Block
mathBlockOneLine :: Parser [Char] st Block
mathBlockOneLine = try $ do
result <- manyTill anyChar newline
blanklines
return $ Para [Math DisplayMath $ removeLeadingTrailingSpace result]
mathBlockMultiline :: Parsec [Char] st Block
mathBlockMultiline :: Parser [Char] st Block
mathBlockMultiline = try $ do
blanklines
result <- indentedBlock
@ -403,7 +403,7 @@ mathBlockMultiline = try $ do
$ filter (not . null) $ splitBy null lns'
return $ Para $ map (Math DisplayMath) eqs
lhsCodeBlock :: Parsec [Char] ParserState Block
lhsCodeBlock :: Parser [Char] ParserState Block
lhsCodeBlock = try $ do
failUnlessLHS
optional codeBlockStart
@ -417,7 +417,7 @@ lhsCodeBlock = try $ do
blanklines
return $ CodeBlock ("", ["sourceCode", "literate", "haskell"], []) $ intercalate "\n" lns'
birdTrackLine :: Parsec [Char] st [Char]
birdTrackLine :: Parser [Char] st [Char]
birdTrackLine = do
char '>'
manyTill anyChar newline
@ -426,7 +426,7 @@ birdTrackLine = do
-- raw html/latex/etc
--
rawBlock :: Parsec [Char] st Block
rawBlock :: Parser [Char] st Block
rawBlock = try $ do
string ".. raw:: "
lang <- many1 (letter <|> digit)
@ -438,7 +438,7 @@ rawBlock = try $ do
-- block quotes
--
blockQuote :: Parsec [Char] ParserState Block
blockQuote :: Parser [Char] ParserState Block
blockQuote = do
raw <- indentedBlock
-- parse the extracted block, which may contain various block elements:
@ -449,10 +449,10 @@ blockQuote = do
-- list blocks
--
list :: Parsec [Char] ParserState Block
list :: Parser [Char] ParserState Block
list = choice [ bulletList, orderedList, definitionList ] <?> "list"
definitionListItem :: Parsec [Char] ParserState ([Inline], [[Block]])
definitionListItem :: Parser [Char] ParserState ([Inline], [[Block]])
definitionListItem = try $ do
-- avoid capturing a directive or comment
notFollowedBy (try $ char '.' >> char '.')
@ -462,11 +462,11 @@ definitionListItem = try $ do
contents <- parseFromString parseBlocks $ raw ++ "\n"
return (normalizeSpaces term, [contents])
definitionList :: Parsec [Char] ParserState Block
definitionList :: Parser [Char] ParserState Block
definitionList = many1 definitionListItem >>= return . DefinitionList
-- parses bullet list start and returns its length (inc. following whitespace)
bulletListStart :: Parsec [Char] st Int
bulletListStart :: Parser [Char] st Int
bulletListStart = try $ do
notFollowedBy' hrule -- because hrules start out just like lists
marker <- oneOf bulletListMarkers
@ -476,14 +476,14 @@ bulletListStart = try $ do
-- parses ordered list start and returns its length (inc following whitespace)
orderedListStart :: ListNumberStyle
-> ListNumberDelim
-> Parsec [Char] ParserState Int
-> Parser [Char] ParserState Int
orderedListStart style delim = try $ do
(_, markerLen) <- withHorizDisplacement (orderedListMarker style delim)
white <- many1 spaceChar
return $ markerLen + length white
-- parse a line of a list item
listLine :: Int -> Parsec [Char] ParserState [Char]
listLine :: Int -> Parser [Char] ParserState [Char]
listLine markerLength = try $ do
notFollowedBy blankline
indentWith markerLength
@ -491,7 +491,7 @@ listLine markerLength = try $ do
return $ line ++ "\n"
-- indent by specified number of spaces (or equiv. tabs)
indentWith :: Int -> Parsec [Char] ParserState [Char]
indentWith :: Int -> Parser [Char] ParserState [Char]
indentWith num = do
state <- getState
let tabStop = stateTabStop state
@ -501,8 +501,8 @@ indentWith num = do
(try (char '\t' >> count (num - tabStop) (char ' '))) ]
-- parse raw text for one list item, excluding start marker and continuations
rawListItem :: Parsec [Char] ParserState Int
-> Parsec [Char] ParserState (Int, [Char])
rawListItem :: Parser [Char] ParserState Int
-> Parser [Char] ParserState (Int, [Char])
rawListItem start = try $ do
markerLength <- start
firstLine <- manyTill anyChar newline
@ -512,14 +512,14 @@ rawListItem start = try $ do
-- continuation of a list item - indented and separated by blankline or
-- (in compact lists) endline.
-- Note: nested lists are parsed as continuations.
listContinuation :: Int -> Parsec [Char] ParserState [Char]
listContinuation :: Int -> Parser [Char] ParserState [Char]
listContinuation markerLength = try $ do
blanks <- many1 blankline
result <- many1 (listLine markerLength)
return $ blanks ++ concat result
listItem :: Parsec [Char] ParserState Int
-> Parsec [Char] ParserState [Block]
listItem :: Parser [Char] ParserState Int
-> Parser [Char] ParserState [Block]
listItem start = try $ do
(markerLength, first) <- rawListItem start
rest <- many (listContinuation markerLength)
@ -536,14 +536,14 @@ listItem start = try $ do
updateState (\st -> st {stateParserContext = oldContext})
return parsed
orderedList :: Parsec [Char] ParserState Block
orderedList :: Parser [Char] ParserState Block
orderedList = try $ do
(start, style, delim) <- lookAhead (anyOrderedListMarker >>~ spaceChar)
items <- many1 (listItem (orderedListStart style delim))
let items' = compactify items
return $ OrderedList (start, style, delim) items'
bulletList :: Parsec [Char] ParserState Block
bulletList :: Parser [Char] ParserState Block
bulletList = many1 (listItem bulletListStart) >>=
return . BulletList . compactify
@ -551,7 +551,7 @@ bulletList = many1 (listItem bulletListStart) >>=
-- default-role block
--
defaultRoleBlock :: Parsec [Char] ParserState Block
defaultRoleBlock :: Parser [Char] ParserState Block
defaultRoleBlock = try $ do
string ".. default-role::"
-- doesn't enforce any restrictions on the role name; embedded spaces shouldn't be allowed, for one
@ -569,7 +569,7 @@ defaultRoleBlock = try $ do
-- unknown directive (e.g. comment)
--
unknownDirective :: Parsec [Char] st Block
unknownDirective :: Parser [Char] st Block
unknownDirective = try $ do
string ".."
notFollowedBy (noneOf " \t\n")
@ -581,7 +581,7 @@ unknownDirective = try $ do
--- note block
---
noteBlock :: Parsec [Char] ParserState [Char]
noteBlock :: Parser [Char] ParserState [Char]
noteBlock = try $ do
startPos <- getPosition
string ".."
@ -600,7 +600,7 @@ noteBlock = try $ do
-- return blanks so line count isn't affected
return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
noteMarker :: Parsec [Char] ParserState [Char]
noteMarker :: Parser [Char] ParserState [Char]
noteMarker = do
char '['
res <- many1 digit
@ -613,13 +613,13 @@ noteMarker = do
-- reference key
--
quotedReferenceName :: Parsec [Char] ParserState [Inline]
quotedReferenceName :: Parser [Char] ParserState [Inline]
quotedReferenceName = try $ do
char '`' >> notFollowedBy (char '`') -- `` means inline code!
label' <- many1Till inline (char '`')
return label'
unquotedReferenceName :: Parsec [Char] ParserState [Inline]
unquotedReferenceName :: Parser [Char] ParserState [Inline]
unquotedReferenceName = try $ do
label' <- many1Till inline (lookAhead $ char ':')
return label'
@ -628,24 +628,24 @@ unquotedReferenceName = try $ do
-- plus isolated (no two adjacent) internal hyphens, underscores,
-- periods, colons and plus signs; no whitespace or other characters
-- are allowed.
simpleReferenceName' :: Parsec [Char] st String
simpleReferenceName' :: Parser [Char] st String
simpleReferenceName' = do
x <- alphaNum
xs <- many $ alphaNum
<|> (try $ oneOf "-_:+." >> lookAhead alphaNum)
return (x:xs)
simpleReferenceName :: Parsec [Char] st [Inline]
simpleReferenceName :: Parser [Char] st [Inline]
simpleReferenceName = do
raw <- simpleReferenceName'
return [Str raw]
referenceName :: Parsec [Char] ParserState [Inline]
referenceName :: Parser [Char] ParserState [Inline]
referenceName = quotedReferenceName <|>
(try $ simpleReferenceName >>~ lookAhead (char ':')) <|>
unquotedReferenceName
referenceKey :: Parsec [Char] ParserState [Char]
referenceKey :: Parser [Char] ParserState [Char]
referenceKey = do
startPos <- getPosition
(key, target) <- choice [imageKey, anonymousKey, regularKey]
@ -657,7 +657,7 @@ referenceKey = do
-- return enough blanks to replace key
return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
targetURI :: Parsec [Char] st [Char]
targetURI :: Parser [Char] st [Char]
targetURI = do
skipSpaces
optional newline
@ -666,7 +666,7 @@ targetURI = do
blanklines
return $ escapeURI $ removeLeadingTrailingSpace $ contents
imageKey :: Parsec [Char] ParserState (Key, Target)
imageKey :: Parser [Char] ParserState (Key, Target)
imageKey = try $ do
string ".. |"
ref <- manyTill inline (char '|')
@ -675,14 +675,14 @@ imageKey = try $ do
src <- targetURI
return (toKey (normalizeSpaces ref), (src, ""))
anonymousKey :: Parsec [Char] st (Key, Target)
anonymousKey :: Parser [Char] st (Key, Target)
anonymousKey = try $ do
oneOfStrings [".. __:", "__"]
src <- targetURI
pos <- getPosition
return (toKey [Str $ "_" ++ printf "%09d" (sourceLine pos)], (src, ""))
regularKey :: Parsec [Char] ParserState (Key, Target)
regularKey :: Parser [Char] ParserState (Key, Target)
regularKey = try $ do
string ".. _"
ref <- referenceName
@ -707,31 +707,31 @@ regularKey = try $ do
-- Grid tables TODO:
-- - column spans
dashedLine :: Char -> Parsec [Char] st (Int, Int)
dashedLine :: Char -> Parser [Char] st (Int, Int)
dashedLine ch = do
dashes <- many1 (char ch)
sp <- many (char ' ')
return (length dashes, length $ dashes ++ sp)
simpleDashedLines :: Char -> Parsec [Char] st [(Int,Int)]
simpleDashedLines :: Char -> Parser [Char] st [(Int,Int)]
simpleDashedLines ch = try $ many1 (dashedLine ch)
-- Parse a table row separator
simpleTableSep :: Char -> Parsec [Char] ParserState Char
simpleTableSep :: Char -> Parser [Char] ParserState Char
simpleTableSep ch = try $ simpleDashedLines ch >> newline
-- Parse a table footer
simpleTableFooter :: Parsec [Char] ParserState [Char]
simpleTableFooter :: Parser [Char] ParserState [Char]
simpleTableFooter = try $ simpleTableSep '=' >> blanklines
-- Parse a raw line and split it into chunks by indices.
simpleTableRawLine :: [Int] -> Parsec [Char] ParserState [String]
simpleTableRawLine :: [Int] -> Parser [Char] ParserState [String]
simpleTableRawLine indices = do
line <- many1Till anyChar newline
return (simpleTableSplitLine indices line)
-- Parse a table row and return a list of blocks (columns).
simpleTableRow :: [Int] -> Parsec [Char] ParserState [[Block]]
simpleTableRow :: [Int] -> Parser [Char] ParserState [[Block]]
simpleTableRow indices = do
notFollowedBy' simpleTableFooter
firstLine <- simpleTableRawLine indices
@ -745,7 +745,7 @@ simpleTableSplitLine indices line =
$ tail $ splitByIndices (init indices) line
simpleTableHeader :: Bool -- ^ Headerless table
-> Parsec [Char] ParserState ([[Block]], [Alignment], [Int])
-> Parser [Char] ParserState ([[Block]], [Alignment], [Int])
simpleTableHeader headless = try $ do
optional blanklines
rawContent <- if headless
@ -765,7 +765,7 @@ simpleTableHeader headless = try $ do
-- Parse a simple table.
simpleTable :: Bool -- ^ Headerless table
-> Parsec [Char] ParserState Block
-> Parser [Char] ParserState Block
simpleTable headless = do
Table c a _w h l <- tableWith (simpleTableHeader headless) simpleTableRow sep simpleTableFooter (return [])
-- Simple tables get 0s for relative column widths (i.e., use default)
@ -774,10 +774,10 @@ simpleTable headless = do
sep = return () -- optional (simpleTableSep '-')
gridTable :: Bool -- ^ Headerless table
-> Parsec [Char] ParserState Block
-> Parser [Char] ParserState Block
gridTable = gridTableWith block (return [])
table :: Parsec [Char] ParserState Block
table :: Parser [Char] ParserState Block
table = gridTable False <|> simpleTable False <|>
gridTable True <|> simpleTable True <?> "table"
@ -786,7 +786,7 @@ table = gridTable False <|> simpleTable False <|>
-- inline
--
inline :: Parsec [Char] ParserState Inline
inline :: Parser [Char] ParserState Inline
inline = choice [ whitespace
, link
, str
@ -804,26 +804,26 @@ inline = choice [ whitespace
, escapedChar
, symbol ] <?> "inline"
hyphens :: Parsec [Char] ParserState Inline
hyphens :: Parser [Char] ParserState Inline
hyphens = do
result <- many1 (char '-')
option Space endline
-- don't want to treat endline after hyphen or dash as a space
return $ Str result
escapedChar :: Parsec [Char] st Inline
escapedChar :: Parser [Char] st Inline
escapedChar = do c <- escaped anyChar
return $ if c == ' ' -- '\ ' is null in RST
then Str ""
else Str [c]
symbol :: Parsec [Char] ParserState Inline
symbol :: Parser [Char] ParserState Inline
symbol = do
result <- oneOf specialChars
return $ Str [result]
-- parses inline code, between codeStart and codeEnd
code :: Parsec [Char] ParserState Inline
code :: Parser [Char] ParserState Inline
code = try $ do
string "``"
result <- manyTill anyChar (try (string "``"))
@ -831,7 +831,7 @@ code = try $ do
$ removeLeadingTrailingSpace $ intercalate " " $ lines result
-- succeeds only if we're not right after a str (ie. in middle of word)
atStart :: Parsec [Char] ParserState a -> Parsec [Char] ParserState a
atStart :: Parser [Char] ParserState a -> Parser [Char] ParserState a
atStart p = do
pos <- getPosition
st <- getState
@ -839,18 +839,18 @@ atStart p = do
guard $ stateLastStrPos st /= Just pos
p
emph :: Parsec [Char] ParserState Inline
emph :: Parser [Char] ParserState Inline
emph = enclosed (atStart $ char '*') (char '*') inline >>=
return . Emph . normalizeSpaces
strong :: Parsec [Char] ParserState Inline
strong :: Parser [Char] ParserState Inline
strong = enclosed (atStart $ string "**") (try $ string "**") inline >>=
return . Strong . normalizeSpaces
-- Parses inline interpreted text which is required to have the given role.
-- This decision is based on the role marker (if present),
-- and the current default interpreted text role.
interpreted :: [Char] -> Parsec [Char] ParserState [Char]
interpreted :: [Char] -> Parser [Char] ParserState [Char]
interpreted role = try $ do
state <- getState
if role == stateRstDefaultRole state
@ -867,19 +867,19 @@ interpreted role = try $ do
result <- enclosed (atStart $ char '`') (char '`') anyChar
return result
superscript :: Parsec [Char] ParserState Inline
superscript :: Parser [Char] ParserState Inline
superscript = interpreted "sup" >>= \x -> return (Superscript [Str x])
subscript :: Parsec [Char] ParserState Inline
subscript :: Parser [Char] ParserState Inline
subscript = interpreted "sub" >>= \x -> return (Subscript [Str x])
math :: Parsec [Char] ParserState Inline
math :: Parser [Char] ParserState Inline
math = interpreted "math" >>= \x -> return (Math InlineMath x)
whitespace :: Parsec [Char] ParserState Inline
whitespace :: Parser [Char] ParserState Inline
whitespace = many1 spaceChar >> return Space <?> "whitespace"
str :: Parsec [Char] ParserState Inline
str :: Parser [Char] ParserState Inline
str = do
let strChar = noneOf ("\t\n " ++ specialChars)
result <- many1 strChar
@ -887,7 +887,7 @@ str = do
return $ Str result
-- an endline character that can be treated as a space, not a structural break
endline :: Parsec [Char] ParserState Inline
endline :: Parser [Char] ParserState Inline
endline = try $ do
newline
notFollowedBy blankline
@ -903,10 +903,10 @@ endline = try $ do
-- links
--
link :: Parsec [Char] ParserState Inline
link :: Parser [Char] ParserState Inline
link = choice [explicitLink, referenceLink, autoLink] <?> "link"
explicitLink :: Parsec [Char] ParserState Inline
explicitLink :: Parser [Char] ParserState Inline
explicitLink = try $ do
char '`'
notFollowedBy (char '`') -- `` marks start of inline code
@ -918,7 +918,7 @@ explicitLink = try $ do
return $ Link (normalizeSpaces label')
(escapeURI $ removeLeadingTrailingSpace src, "")
referenceLink :: Parsec [Char] ParserState Inline
referenceLink :: Parser [Char] ParserState Inline
referenceLink = try $ do
label' <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_'
state <- getState
@ -939,21 +939,21 @@ referenceLink = try $ do
when (isAnonKey key) $ updateState $ \s -> s{ stateKeys = M.delete key keyTable }
return $ Link (normalizeSpaces label') (src, tit)
autoURI :: Parsec [Char] ParserState Inline
autoURI :: Parser [Char] ParserState Inline
autoURI = do
(orig, src) <- uri
return $ Link [Str orig] (src, "")
autoEmail :: Parsec [Char] ParserState Inline
autoEmail :: Parser [Char] ParserState Inline
autoEmail = do
(orig, src) <- emailAddress
return $ Link [Str orig] (src, "")
autoLink :: Parsec [Char] ParserState Inline
autoLink :: Parser [Char] ParserState Inline
autoLink = autoURI <|> autoEmail
-- For now, we assume that all substitution references are for images.
image :: Parsec [Char] ParserState Inline
image :: Parser [Char] ParserState Inline
image = try $ do
char '|'
ref <- manyTill inline (char '|')
@ -964,7 +964,7 @@ image = try $ do
Just target -> return target
return $ Image (normalizeSpaces ref) (src, tit)
note :: Parsec [Char] ParserState Inline
note :: Parser [Char] ParserState Inline
note = try $ do
ref <- noteMarker
char '_'

136
src/Text/Pandoc/Readers/Textile.hs
View file

@ -74,7 +74,7 @@ readTextile state s =
-- | Generate a Pandoc ADT from a textile document
parseTextile :: Parsec [Char] ParserState Pandoc
parseTextile :: Parser [Char] ParserState Pandoc
parseTextile = do
-- textile allows raw HTML and does smart punctuation by default
updateState (\state -> state { stateParseRaw = True, stateSmart = True })
@ -92,10 +92,10 @@ parseTextile = do
blocks <- parseBlocks
return $ Pandoc (Meta [] [] []) blocks -- FIXME
noteMarker :: Parsec [Char] ParserState [Char]
noteMarker :: Parser [Char] ParserState [Char]
noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.')
noteBlock :: Parsec [Char] ParserState [Char]
noteBlock :: Parser [Char] ParserState [Char]
noteBlock = try $ do
startPos <- getPosition
ref <- noteMarker
@ -110,11 +110,11 @@ noteBlock = try $ do
return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
-- | Parse document blocks
parseBlocks :: Parsec [Char] ParserState [Block]
parseBlocks :: Parser [Char] ParserState [Block]
parseBlocks = manyTill block eof
-- | Block parsers list tried in definition order
blockParsers :: [Parsec [Char] ParserState Block]
blockParsers :: [Parser [Char] ParserState Block]
blockParsers = [ codeBlock
, header
, blockQuote
@ -127,20 +127,20 @@ blockParsers = [ codeBlock
, nullBlock ]
-- | Any block in the order of definition of blockParsers
block :: Parsec [Char] ParserState Block
block :: Parser [Char] ParserState Block
block = choice blockParsers <?> "block"
codeBlock :: Parsec [Char] ParserState Block
codeBlock :: Parser [Char] ParserState Block
codeBlock = codeBlockBc <|> codeBlockPre
codeBlockBc :: Parsec [Char] ParserState Block
codeBlockBc :: Parser [Char] ParserState Block
codeBlockBc = try $ do
string "bc. "
contents <- manyTill anyLine blanklines
return $ CodeBlock ("",[],[]) $ unlines contents
-- | Code Blocks in Textile are between <pre> and </pre>
codeBlockPre :: Parsec [Char] ParserState Block
codeBlockPre :: Parser [Char] ParserState Block
codeBlockPre = try $ do
htmlTag (tagOpen (=="pre") null)
result' <- manyTill anyChar (try $ htmlTag (tagClose (=="pre")) >> blockBreak)
@ -155,7 +155,7 @@ codeBlockPre = try $ do
return $ CodeBlock ("",[],[]) result'''
-- | Header of the form "hN. content" with N in 1..6
header :: Parsec [Char] ParserState Block
header :: Parser [Char] ParserState Block
header = try $ do
char 'h'
level <- digitToInt <$> oneOf "123456"
@ -164,14 +164,14 @@ header = try $ do
return $ Header level name
-- | Blockquote of the form "bq. content"
blockQuote :: Parsec [Char] ParserState Block
blockQuote :: Parser [Char] ParserState Block
blockQuote = try $ do
string "bq" >> optional attributes >> char '.' >> whitespace
BlockQuote . singleton <$> para
-- Horizontal rule
hrule :: Parsec [Char] st Block
hrule :: Parser [Char] st Block
hrule = try $ do
skipSpaces
start <- oneOf "-*"
@ -186,39 +186,39 @@ hrule = try $ do
-- | Can be a bullet list or an ordered list. This implementation is
-- strict in the nesting, sublist must start at exactly "parent depth
-- plus one"
anyList :: Parsec [Char] ParserState Block
anyList :: Parser [Char] ParserState Block
anyList = try $ ( (anyListAtDepth 1) <* blanklines )
-- | This allow one type of list to be nested into an other type,
-- provided correct nesting
anyListAtDepth :: Int -> Parsec [Char] ParserState Block
anyListAtDepth :: Int -> Parser [Char] ParserState Block
anyListAtDepth depth = choice [ bulletListAtDepth depth,
orderedListAtDepth depth,
definitionList ]
-- | Bullet List of given depth, depth being the number of leading '*'
bulletListAtDepth :: Int -> Parsec [Char] ParserState Block
bulletListAtDepth :: Int -> Parser [Char] ParserState Block
bulletListAtDepth depth = try $ BulletList <$> many1 (bulletListItemAtDepth depth)
-- | Bullet List Item of given depth, depth being the number of
-- leading '*'
bulletListItemAtDepth :: Int -> Parsec [Char] ParserState [Block]
bulletListItemAtDepth :: Int -> Parser [Char] ParserState [Block]
bulletListItemAtDepth = genericListItemAtDepth '*'
-- | Ordered List of given depth, depth being the number of
-- leading '#'
orderedListAtDepth :: Int -> Parsec [Char] ParserState Block
orderedListAtDepth :: Int -> Parser [Char] ParserState Block
orderedListAtDepth depth = try $ do
items <- many1 (orderedListItemAtDepth depth)
return (OrderedList (1, DefaultStyle, DefaultDelim) items)
-- | Ordered List Item of given depth, depth being the number of
-- leading '#'
orderedListItemAtDepth :: Int -> Parsec [Char] ParserState [Block]
orderedListItemAtDepth :: Int -> Parser [Char] ParserState [Block]
orderedListItemAtDepth = genericListItemAtDepth '#'
-- | Common implementation of list items
genericListItemAtDepth :: Char -> Int -> Parsec [Char] ParserState [Block]
genericListItemAtDepth :: Char -> Int -> Parser [Char] ParserState [Block]
genericListItemAtDepth c depth = try $ do
count depth (char c) >> optional attributes >> whitespace
p <- inlines
@ -226,22 +226,22 @@ genericListItemAtDepth c depth = try $ do
return ((Plain p):sublist)
-- | A definition list is a set of consecutive definition items
definitionList :: Parsec [Char] ParserState Block
definitionList :: Parser [Char] ParserState Block
definitionList = try $ DefinitionList <$> many1 definitionListItem
-- | A definition list item in textile begins with '- ', followed by
-- the term defined, then spaces and ":=". The definition follows, on
-- the same single line, or spaned on multiple line, after a line
-- break.
definitionListItem :: Parsec [Char] ParserState ([Inline], [[Block]])
definitionListItem :: Parser [Char] ParserState ([Inline], [[Block]])
definitionListItem = try $ do
string "- "
term <- many1Till inline (try (whitespace >> string ":="))
def <- inlineDef <|> multilineDef
return (term, def)
where inlineDef :: Parsec [Char] ParserState [[Block]]
where inlineDef :: Parser [Char] ParserState [[Block]]
inlineDef = liftM (\d -> [[Plain d]]) $ try (whitespace >> inlines)
multilineDef :: Parsec [Char] ParserState [[Block]]
multilineDef :: Parser [Char] ParserState [[Block]]
multilineDef = try $ do
optional whitespace >> newline
s <- many1Till anyChar (try (string "=:" >> newline))
@ -251,57 +251,57 @@ definitionListItem = try $ do
-- | This terminates a block such as a paragraph. Because of raw html
-- blocks support, we have to lookAhead for a rawHtmlBlock.
blockBreak :: Parsec [Char] ParserState ()
blockBreak :: Parser [Char] ParserState ()
blockBreak = try (newline >> blanklines >> return ()) <|>
(lookAhead rawHtmlBlock >> return ())
-- raw content
-- | A raw Html Block, optionally followed by blanklines
rawHtmlBlock :: Parsec [Char] ParserState Block
rawHtmlBlock :: Parser [Char] ParserState Block
rawHtmlBlock = try $ do
(_,b) <- htmlTag isBlockTag
optional blanklines
return $ RawBlock "html" b
-- | Raw block of LaTeX content
rawLaTeXBlock' :: Parsec [Char] ParserState Block
rawLaTeXBlock' :: Parser [Char] ParserState Block
rawLaTeXBlock' = do
failIfStrict
RawBlock "latex" <$> (rawLaTeXBlock <* spaces)
-- | In textile, paragraphs are separated by blank lines.
para :: Parsec [Char] ParserState Block
para :: Parser [Char] ParserState Block
para = try $ Para . normalizeSpaces <$> manyTill inline blockBreak
-- Tables
-- | A table cell spans until a pipe |
tableCell :: Parsec [Char] ParserState TableCell
tableCell :: Parser [Char] ParserState TableCell
tableCell = do
c <- many1 (noneOf "|\n")
content <- parseFromString (many1 inline) c
return $ [ Plain $ normalizeSpaces content ]
-- | A table row is made of many table cells
tableRow :: Parsec [Char] ParserState [TableCell]
tableRow :: Parser [Char] ParserState [TableCell]
tableRow = try $ ( char '|' *> (endBy1 tableCell (char '|')) <* newline)
-- | Many table rows
tableRows :: Parsec [Char] ParserState [[TableCell]]
tableRows :: Parser [Char] ParserState [[TableCell]]
tableRows = many1 tableRow
-- | Table headers are made of cells separated by a tag "|_."
tableHeaders :: Parsec [Char] ParserState [TableCell]
tableHeaders :: Parser [Char] ParserState [TableCell]
tableHeaders = let separator = (try $ string "|_.") in
try $ ( separator *> (sepBy1 tableCell separator) <* char '|' <* newline )
-- | A table with an optional header. Current implementation can
-- handle tables with and without header, but will parse cells
-- alignment attributes as content.
table :: Parsec [Char] ParserState Block
table :: Parser [Char] ParserState Block
table = try $ do
headers <- option [] tableHeaders
rows <- tableRows
@ -317,8 +317,8 @@ table = try $ do
-- | Blocks like 'p' and 'table' do not need explicit block tag.
-- However, they can be used to set HTML/CSS attributes when needed.
maybeExplicitBlock :: String -- ^ block tag name
-> Parsec [Char] ParserState Block -- ^ implicit block
-> Parsec [Char] ParserState Block
-> Parser [Char] ParserState Block -- ^ implicit block
-> Parser [Char] ParserState Block
maybeExplicitBlock name blk = try $ do
optional $ try $ string name >> optional attributes >> char '.' >>
((try whitespace) <|> endline)
@ -332,15 +332,15 @@ maybeExplicitBlock name blk = try $ do
-- | Any inline element
inline :: Parsec [Char] ParserState Inline
inline :: Parser [Char] ParserState Inline
inline = choice inlineParsers <?> "inline"
-- | List of consecutive inlines before a newline
inlines :: Parsec [Char] ParserState [Inline]
inlines :: Parser [Char] ParserState [Inline]
inlines = manyTill inline newline
-- | Inline parsers tried in order
inlineParsers :: [Parsec [Char] ParserState Inline]
inlineParsers :: [Parser [Char] ParserState Inline]
inlineParsers = [ autoLink
, str
, whitespace
@ -361,7 +361,7 @@ inlineParsers = [ autoLink
]
-- | Inline markups
inlineMarkup :: Parsec [Char] ParserState Inline
inlineMarkup :: Parser [Char] ParserState Inline
inlineMarkup = choice [ simpleInline (string "??") (Cite [])
, simpleInline (string "**") Strong
, simpleInline (string "__") Emph
@ -374,29 +374,29 @@ inlineMarkup = choice [ simpleInline (string "??") (Cite [])
]
-- | Trademark, registered, copyright
mark :: Parsec [Char] st Inline
mark :: Parser [Char] st Inline
mark = try $ char '(' >> (try tm <|> try reg <|> copy)
reg :: Parsec [Char] st Inline
reg :: Parser [Char] st Inline
reg = do
oneOf "Rr"
char ')'
return $ Str "\174"
tm :: Parsec [Char] st Inline
tm :: Parser [Char] st Inline
tm = do
oneOf "Tt"
oneOf "Mm"
char ')'
return $ Str "\8482"
copy :: Parsec [Char] st Inline
copy :: Parser [Char] st Inline
copy = do
oneOf "Cc"
char ')'
return $ Str "\169"
note :: Parsec [Char] ParserState Inline
note :: Parser [Char] ParserState Inline
note = try $ do
ref <- (char '[' *> many1 digit <* char ']')
notes <- stateNotes <$> getState
@ -420,7 +420,7 @@ wordBoundaries :: [Char]
wordBoundaries = markupChars ++ stringBreakers
-- | Parse a hyphened sequence of words
hyphenedWords :: Parsec [Char] ParserState String
hyphenedWords :: Parser [Char] ParserState String
hyphenedWords = try $ do
hd <- noneOf wordBoundaries
tl <- many ( (noneOf wordBoundaries) <|>
@ -430,7 +430,7 @@ hyphenedWords = try $ do
(\r -> concat [wd, "-", r]) <$> (char '-' *> hyphenedWords)
-- | Any string
str :: Parsec [Char] ParserState Inline
str :: Parser [Char] ParserState Inline
str = do
baseStr <- hyphenedWords
-- RedCloth compliance : if parsed word is uppercase and immediatly
@ -443,34 +443,34 @@ str = do
return $ Str fullStr
-- | Textile allows HTML span infos, we discard them
htmlSpan :: Parsec [Char] ParserState Inline
htmlSpan :: Parser [Char] ParserState Inline
htmlSpan = try $ Str <$> ( char '%' *> attributes *> manyTill anyChar (char '%') )
-- | Some number of space chars
whitespace :: Parsec [Char] ParserState Inline
whitespace :: Parser [Char] ParserState Inline
whitespace = many1 spaceChar >> return Space <?> "whitespace"
-- | In Textile, an isolated endline character is a line break
endline :: Parsec [Char] ParserState Inline
endline :: Parser [Char] ParserState Inline
endline = try $ do
newline >> notFollowedBy blankline
return LineBreak
rawHtmlInline :: Parsec [Char] ParserState Inline
rawHtmlInline :: Parser [Char] ParserState Inline
rawHtmlInline = RawInline "html" . snd <$> htmlTag isInlineTag
-- | Raw LaTeX Inline
rawLaTeXInline' :: Parsec [Char] ParserState Inline
rawLaTeXInline' :: Parser [Char] ParserState Inline
rawLaTeXInline' = try $ do
failIfStrict
rawLaTeXInline
-- | Textile standard link syntax is "label":target. But we
-- can also have ["label":target].
link :: Parsec [Char] ParserState Inline
link :: Parser [Char] ParserState Inline
link = linkB <|> linkNoB
linkNoB :: Parsec [Char] ParserState Inline
linkNoB :: Parser [Char] ParserState Inline
linkNoB = try $ do
name <- surrounded (char '"') inline
char ':'
@ -478,7 +478,7 @@ linkNoB = try $ do
url <- manyTill nonspaceChar (lookAhead $ space <|> try (oneOf stopChars >> (space <|> newline)))
return $ Link name (url, "")
linkB :: Parsec [Char] ParserState Inline
linkB :: Parser [Char] ParserState Inline
linkB = try $ do
char '['
name <- surrounded (char '"') inline
@ -487,13 +487,13 @@ linkB = try $ do
return $ Link name (url, "")
-- | Detect plain links to http or email.
autoLink :: Parsec [Char] ParserState Inline
autoLink :: Parser [Char] ParserState Inline
autoLink = do
(orig, src) <- (try uri <|> try emailAddress)
return $ Link [Str orig] (src, "")
-- | image embedding
image :: Parsec [Char] ParserState Inline
image :: Parser [Char] ParserState Inline
image = try $ do
char '!' >> notFollowedBy space
src <- manyTill anyChar (lookAhead $ oneOf "!(")
@ -501,49 +501,49 @@ image = try $ do
char '!'
return $ Image [Str alt] (src, alt)
escapedInline :: Parsec [Char] ParserState Inline
escapedInline :: Parser [Char] ParserState Inline
escapedInline = escapedEqs <|> escapedTag
escapedEqs :: Parsec [Char] ParserState Inline
escapedEqs :: Parser [Char] ParserState Inline
escapedEqs = Str <$> (try $ string "==" *> manyTill anyChar (try $ string "=="))
-- | literal text escaped btw <notextile> tags
escapedTag :: Parsec [Char] ParserState Inline
escapedTag :: Parser [Char] ParserState Inline
escapedTag = Str <$>
(try $ string "<notextile>" *> manyTill anyChar (try $ string "</notextile>"))
-- | Any special symbol defined in wordBoundaries
symbol :: Parsec [Char] ParserState Inline
symbol :: Parser [Char] ParserState Inline
symbol = Str . singleton <$> oneOf wordBoundaries
-- | Inline code
code :: Parsec [Char] ParserState Inline
code :: Parser [Char] ParserState Inline
code = code1 <|> code2
code1 :: Parsec [Char] ParserState Inline
code1 :: Parser [Char] ParserState Inline
code1 = Code nullAttr <$> surrounded (char '@') anyChar
code2 :: Parsec [Char] ParserState Inline
code2 :: Parser [Char] ParserState Inline
code2 = do
htmlTag (tagOpen (=="tt") null)
Code nullAttr <$> manyTill anyChar (try $ htmlTag $ tagClose (=="tt"))
-- | Html / CSS attributes
attributes :: Parsec [Char] ParserState String
attributes :: Parser [Char] ParserState String
attributes = choice [ enclosed (char '(') (char ')') anyChar,
enclosed (char '{') (char '}') anyChar,
enclosed (char '[') (char ']') anyChar]
-- | Parses material surrounded by a parser.
surrounded :: Parsec [Char] st t -- ^ surrounding parser
-> Parsec [Char] st a -- ^ content parser (to be used repeatedly)
-> Parsec [Char] st [a]
surrounded :: Parser [Char] st t -- ^ surrounding parser
-> Parser [Char] st a -- ^ content parser (to be used repeatedly)
-> Parser [Char] st [a]
surrounded border = enclosed border (try border)
-- | Inlines are most of the time of the same form
simpleInline :: Parsec [Char] ParserState t -- ^ surrounding parser
simpleInline :: Parser [Char] ParserState t -- ^ surrounding parser
-> ([Inline] -> Inline) -- ^ Inline constructor
-> Parsec [Char] ParserState Inline -- ^ content parser (to be used repeatedly)
-> Parser [Char] ParserState Inline -- ^ content parser (to be used repeatedly)
simpleInline border construct = surrounded border (inlineWithAttribute) >>=
return . construct . normalizeSpaces
where inlineWithAttribute = (try $ optional attributes) >> inline

18
src/Text/Pandoc/Templates.hs
View file

@ -98,7 +98,7 @@ getDefaultTemplate user writer = do
data TemplateState = TemplateState Int [(String,String)]
adjustPosition :: String -> Parsec [Char] TemplateState String
adjustPosition :: String -> Parser [Char] TemplateState String
adjustPosition str = do
let lastline = takeWhile (/= '\n') $ reverse str
updateState $ \(TemplateState pos x) ->
@ -132,21 +132,21 @@ renderTemplate vals templ =
reservedWords :: [String]
reservedWords = ["else","endif","for","endfor","sep"]
parseTemplate :: Parsec [Char] TemplateState [String]
parseTemplate :: Parser [Char] TemplateState [String]
parseTemplate =
many $ (plaintext <|> escapedDollar <|> conditional <|> for <|> variable)
>>= adjustPosition
plaintext :: Parsec [Char] TemplateState String
plaintext :: Parser [Char] TemplateState String
plaintext = many1 $ noneOf "$"
escapedDollar :: Parsec [Char] TemplateState String
escapedDollar :: Parser [Char] TemplateState String
escapedDollar = try $ string "$$" >> return "$"
skipEndline :: Parsec [Char] st ()
skipEndline :: Parser [Char] st ()
skipEndline = try $ skipMany (oneOf " \t") >> newline >> return ()
conditional :: Parsec [Char] TemplateState String
conditional :: Parser [Char] TemplateState String
conditional = try $ do
TemplateState pos vars <- getState
string "$if("
@ -170,7 +170,7 @@ conditional = try $ do
then ifContents
else elseContents
for :: Parsec [Char] TemplateState String
for :: Parser [Char] TemplateState String
for = try $ do
TemplateState pos vars <- getState
string "$for("
@ -193,7 +193,7 @@ for = try $ do
setState $ TemplateState pos vars
return $ concat $ intersperse sep contents
ident :: Parsec [Char] TemplateState String
ident :: Parser [Char] TemplateState String
ident = do
first <- letter
rest <- many (alphaNum <|> oneOf "_-")
@ -202,7 +202,7 @@ ident = do
then mzero
else return id'
variable :: Parsec [Char] TemplateState String
variable :: Parser [Char] TemplateState String
variable = try $ do
char '$'
id' <- ident

2
src/Text/Pandoc/Writers/AsciiDoc.hs
View file

@ -92,7 +92,7 @@ escapeString = escapeStringUsing escs
where escs = backslashEscapes "{"
-- | Ordered list start parser for use in Para below.
olMarker :: Parsec [Char] ParserState Char
olMarker :: Parser [Char] ParserState Char
olMarker = do (start, style', delim) <- anyOrderedListMarker
if delim == Period &&
(style' == UpperAlpha || (style' == UpperRoman &&

2
src/Text/Pandoc/Writers/Markdown.hs
View file

@ -187,7 +187,7 @@ attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys]
<> "=\"" <> text v <> "\"") ks
-- | Ordered list start parser for use in Para below.
olMarker :: Parsec [Char] ParserState Char
olMarker :: Parser [Char] ParserState Char
olMarker = do (start, style', delim) <- anyOrderedListMarker
if delim == Period &&
(style' == UpperAlpha || (style' == UpperRoman &&