mirror of
https://github.com/jgm/pandoc.git
synced 2026-08-26 18:26:36 +00:00
Parser: Changed types to use type alias Parser, not Parsec.
This commit is contained in:
John MacFarlane
+138
-97
@@ -155,13 +155,13 @@ type Parser t s = Parsec t s
|
||||
a >>~ b = a >>= \x -> b >> return x
|
||||
|
||||
-- | Parse any line of text
|
||||
anyLine :: Parsec [Char] st [Char]
|
||||
anyLine :: Parser [Char] st [Char]
|
||||
anyLine = manyTill anyChar newline
|
||||
|
||||
-- | Like @manyTill@, but reads at least one item.
|
||||
many1Till :: Parsec [tok] st a
|
||||
-> Parsec [tok] st end
|
||||
-> Parsec [tok] st [a]
|
||||
many1Till :: Parser [tok] st a
|
||||
-> Parser [tok] st end
|
||||
-> Parser [tok] st [a]
|
||||
many1Till p end = do
|
||||
first <- p
|
||||
rest <- manyTill p end
|
||||
@@ -170,7 +170,7 @@ many1Till p end = do
|
||||
-- | A more general form of @notFollowedBy@. This one allows any
|
||||
-- type of parser to be specified, and succeeds only if that parser fails.
|
||||
-- It does not consume any input.
|
||||
notFollowedBy' :: Show b => Parsec [a] st b -> Parsec [a] st ()
|
||||
notFollowedBy' :: Show b => Parser [a] st b -> Parser [a] st ()
|
||||
notFollowedBy' p = try $ join $ do a <- try p
|
||||
return (unexpected (show a))
|
||||
<|>
|
||||
@@ -178,7 +178,7 @@ notFollowedBy' p = try $ join $ do a <- try p
|
||||
-- (This version due to Andrew Pimlott on the Haskell mailing list.)
|
||||
|
||||
-- | Parses one of a list of strings (tried in order).
|
||||
oneOfStrings :: [String] -> Parsec [Char] st String
|
||||
oneOfStrings :: [String] -> Parser [Char] st String
|
||||
oneOfStrings [] = fail "no strings"
|
||||
oneOfStrings strs = do
|
||||
c <- anyChar
|
||||
@@ -189,35 +189,35 @@ oneOfStrings strs = do
|
||||
| otherwise -> (c:) `fmap` oneOfStrings strs'
|
||||
|
||||
-- | Parses a space or tab.
|
||||
spaceChar :: Parsec [Char] st Char
|
||||
spaceChar :: Parser [Char] st Char
|
||||
spaceChar = satisfy $ \c -> c == ' ' || c == '\t'
|
||||
|
||||
-- | Parses a nonspace, nonnewline character.
|
||||
nonspaceChar :: Parsec [Char] st Char
|
||||
nonspaceChar :: Parser [Char] st Char
|
||||
nonspaceChar = satisfy $ \x -> x /= '\t' && x /= '\n' && x /= ' ' && x /= '\r'
|
||||
|
||||
-- | Skips zero or more spaces or tabs.
|
||||
skipSpaces :: Parsec [Char] st ()
|
||||
skipSpaces :: Parser [Char] st ()
|
||||
skipSpaces = skipMany spaceChar
|
||||
|
||||
-- | Skips zero or more spaces or tabs, then reads a newline.
|
||||
blankline :: Parsec [Char] st Char
|
||||
blankline :: Parser [Char] st Char
|
||||
blankline = try $ skipSpaces >> newline
|
||||
|
||||
-- | Parses one or more blank lines and returns a string of newlines.
|
||||
blanklines :: Parsec [Char] st [Char]
|
||||
blanklines :: Parser [Char] st [Char]
|
||||
blanklines = many1 blankline
|
||||
|
||||
-- | Parses material enclosed between start and end parsers.
|
||||
enclosed :: Parsec [Char] st t -- ^ start parser
|
||||
-> Parsec [Char] st end -- ^ end parser
|
||||
-> Parsec [Char] st a -- ^ content parser (to be used repeatedly)
|
||||
-> Parsec [Char] st [a]
|
||||
enclosed :: Parser [Char] st t -- ^ start parser
|
||||
-> Parser [Char] st end -- ^ end parser
|
||||
-> Parser [Char] st a -- ^ content parser (to be used repeatedly)
|
||||
-> Parser [Char] st [a]
|
||||
enclosed start end parser = try $
|
||||
start >> notFollowedBy space >> many1Till parser end
|
||||
|
||||
-- | Parse string, case insensitive.
|
||||
stringAnyCase :: [Char] -> Parsec [Char] st String
|
||||
stringAnyCase :: [Char] -> Parser [Char] st String
|
||||
stringAnyCase [] = string ""
|
||||
stringAnyCase (x:xs) = do
|
||||
firstChar <- char (toUpper x) <|> char (toLower x)
|
||||
@@ -225,7 +225,7 @@ stringAnyCase (x:xs) = do
|
||||
return (firstChar:rest)
|
||||
|
||||
-- | Parse contents of 'str' using 'parser' and return result.
|
||||
parseFromString :: Parsec [tok] st a -> [tok] -> Parsec [tok] st a
|
||||
parseFromString :: Parser [tok] st a -> [tok] -> Parser [tok] st a
|
||||
parseFromString parser str = do
|
||||
oldPos <- getPosition
|
||||
oldInput <- getInput
|
||||
@@ -236,7 +236,7 @@ parseFromString parser str = do
|
||||
return result
|
||||
|
||||
-- | Parse raw line block up to and including blank lines.
|
||||
lineClump :: Parsec [Char] st String
|
||||
lineClump :: Parser [Char] st String
|
||||
lineClump = blanklines
|
||||
<|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines)
|
||||
|
||||
@@ -245,8 +245,8 @@ lineClump = blanklines
|
||||
-- pairs of open and close, which must be different. For example,
|
||||
-- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"
|
||||
-- and return "hello (there)".
|
||||
charsInBalanced :: Char -> Char -> Parsec [Char] st Char
|
||||
-> Parsec [Char] st String
|
||||
charsInBalanced :: Char -> Char -> Parser [Char] st Char
|
||||
-> Parser [Char] st String
|
||||
charsInBalanced open close parser = try $ do
|
||||
char open
|
||||
let isDelim c = c == open || c == close
|
||||
@@ -271,7 +271,7 @@ uppercaseRomanDigits = map toUpper lowercaseRomanDigits
|
||||
|
||||
-- | Parses a roman numeral (uppercase or lowercase), returns number.
|
||||
romanNumeral :: Bool -- ^ Uppercase if true
|
||||
-> Parsec [Char] st Int
|
||||
-> Parser [Char] st Int
|
||||
romanNumeral upperCase = do
|
||||
let romanDigits = if upperCase
|
||||
then uppercaseRomanDigits
|
||||
@@ -301,14 +301,14 @@ romanNumeral upperCase = do
|
||||
|
||||
-- Parsers for email addresses and URIs
|
||||
|
||||
emailChar :: Parsec [Char] st Char
|
||||
emailChar :: Parser [Char] st Char
|
||||
emailChar = alphaNum <|>
|
||||
satisfy (\c -> c == '-' || c == '+' || c == '_' || c == '.')
|
||||
|
||||
domainChar :: Parsec [Char] st Char
|
||||
domainChar :: Parser [Char] st Char
|
||||
domainChar = alphaNum <|> char '-'
|
||||
|
||||
domain :: Parsec [Char] st [Char]
|
||||
domain :: Parser [Char] st [Char]
|
||||
domain = do
|
||||
first <- many1 domainChar
|
||||
dom <- many1 $ try (char '.' >> many1 domainChar )
|
||||
@@ -316,7 +316,7 @@ domain = do
|
||||
|
||||
-- | Parses an email address; returns original and corresponding
|
||||
-- escaped mailto: URI.
|
||||
emailAddress :: Parsec [Char] st (String, String)
|
||||
emailAddress :: Parser [Char] st (String, String)
|
||||
emailAddress = try $ do
|
||||
firstLetter <- alphaNum
|
||||
restAddr <- many emailChar
|
||||
@@ -327,7 +327,7 @@ emailAddress = try $ do
|
||||
return (full, escapeURI $ "mailto:" ++ full)
|
||||
|
||||
-- | Parses a URI. Returns pair of original and URI-escaped version.
|
||||
uri :: Parsec [Char] st (String, String)
|
||||
uri :: Parser [Char] st (String, String)
|
||||
uri = try $ do
|
||||
let protocols = [ "http:", "https:", "ftp:", "file:", "mailto:",
|
||||
"news:", "telnet:" ]
|
||||
@@ -361,8 +361,8 @@ uri = try $ do
|
||||
-- displacement (the difference between the source column at the end
|
||||
-- and the source column at the beginning). Vertical displacement
|
||||
-- (source row) is ignored.
|
||||
withHorizDisplacement :: Parsec [Char] st a -- ^ Parser to apply
|
||||
-> Parsec [Char] st (a, Int) -- ^ (result, displacement)
|
||||
withHorizDisplacement :: Parser [Char] st a -- ^ Parser to apply
|
||||
-> Parser [Char] st (a, Int) -- ^ (result, displacement)
|
||||
withHorizDisplacement parser = do
|
||||
pos1 <- getPosition
|
||||
result <- parser
|
||||
@@ -371,7 +371,7 @@ withHorizDisplacement parser = do
|
||||
|
||||
-- | Applies a parser and returns the raw string that was parsed,
|
||||
-- along with the value produced by the parser.
|
||||
withRaw :: Parsec [Char] st a -> Parsec [Char] st (a, [Char])
|
||||
withRaw :: Parser [Char] st a -> Parser [Char] st (a, [Char])
|
||||
withRaw parser = do
|
||||
pos1 <- getPosition
|
||||
inp <- getInput
|
||||
@@ -388,20 +388,20 @@ withRaw parser = do
|
||||
|
||||
-- | Parses a character and returns 'Null' (so that the parser can move on
|
||||
-- if it gets stuck).
|
||||
nullBlock :: Parsec [Char] st Block
|
||||
nullBlock :: Parser [Char] st Block
|
||||
nullBlock = anyChar >> return Null
|
||||
|
||||
-- | Fail unless we're in literate haskell mode.
|
||||
failUnlessLHS :: Parsec [tok] ParserState ()
|
||||
failUnlessLHS :: Parser [tok] ParserState ()
|
||||
failUnlessLHS = getOption readerLiterateHaskell >>= guard
|
||||
|
||||
-- | Parses backslash, then applies character parser.
|
||||
escaped :: Parsec [Char] st Char -- ^ Parser for character to escape
|
||||
-> Parsec [Char] st Char
|
||||
escaped :: Parser [Char] st Char -- ^ Parser for character to escape
|
||||
-> Parser [Char] st Char
|
||||
escaped parser = try $ char '\\' >> parser
|
||||
|
||||
-- | Parse character entity.
|
||||
characterReference :: Parsec [Char] st Char
|
||||
characterReference :: Parser [Char] st Char
|
||||
characterReference = try $ do
|
||||
char '&'
|
||||
ent <- many1Till nonspaceChar (char ';')
|
||||
@@ -410,19 +410,19 @@ characterReference = try $ do
|
||||
Nothing -> fail "entity not found"
|
||||
|
||||
-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
|
||||
upperRoman :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
upperRoman :: Parser [Char] st (ListNumberStyle, Int)
|
||||
upperRoman = do
|
||||
num <- romanNumeral True
|
||||
return (UpperRoman, num)
|
||||
|
||||
-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
|
||||
lowerRoman :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
lowerRoman :: Parser [Char] st (ListNumberStyle, Int)
|
||||
lowerRoman = do
|
||||
num <- romanNumeral False
|
||||
return (LowerRoman, num)
|
||||
|
||||
-- | Parses a decimal numeral and returns (Decimal, number).
|
||||
decimal :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
decimal :: Parser [Char] st (ListNumberStyle, Int)
|
||||
decimal = do
|
||||
num <- many1 digit
|
||||
return (Decimal, read num)
|
||||
@@ -431,7 +431,7 @@ decimal = do
|
||||
-- returns (DefaultStyle, [next example number]). The next
|
||||
-- example number is incremented in parser state, and the label
|
||||
-- (if present) is added to the label table.
|
||||
exampleNum :: Parsec [Char] ParserState (ListNumberStyle, Int)
|
||||
exampleNum :: Parser [Char] ParserState (ListNumberStyle, Int)
|
||||
exampleNum = do
|
||||
char '@'
|
||||
lab <- many (alphaNum <|> satisfy (\c -> c == '_' || c == '-'))
|
||||
@@ -445,38 +445,38 @@ exampleNum = do
|
||||
return (Example, num)
|
||||
|
||||
-- | Parses a '#' returns (DefaultStyle, 1).
|
||||
defaultNum :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
defaultNum :: Parser [Char] st (ListNumberStyle, Int)
|
||||
defaultNum = do
|
||||
char '#'
|
||||
return (DefaultStyle, 1)
|
||||
|
||||
-- | Parses a lowercase letter and returns (LowerAlpha, number).
|
||||
lowerAlpha :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
lowerAlpha :: Parser [Char] st (ListNumberStyle, Int)
|
||||
lowerAlpha = do
|
||||
ch <- oneOf ['a'..'z']
|
||||
return (LowerAlpha, ord ch - ord 'a' + 1)
|
||||
|
||||
-- | Parses an uppercase letter and returns (UpperAlpha, number).
|
||||
upperAlpha :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
upperAlpha :: Parser [Char] st (ListNumberStyle, Int)
|
||||
upperAlpha = do
|
||||
ch <- oneOf ['A'..'Z']
|
||||
return (UpperAlpha, ord ch - ord 'A' + 1)
|
||||
|
||||
-- | Parses a roman numeral i or I
|
||||
romanOne :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
romanOne :: Parser [Char] st (ListNumberStyle, Int)
|
||||
romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
|
||||
(char 'I' >> return (UpperRoman, 1))
|
||||
|
||||
-- | Parses an ordered list marker and returns list attributes.
|
||||
anyOrderedListMarker :: Parsec [Char] ParserState ListAttributes
|
||||
anyOrderedListMarker :: Parser [Char] ParserState ListAttributes
|
||||
anyOrderedListMarker = choice $
|
||||
[delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
|
||||
numParser <- [decimal, exampleNum, defaultNum, romanOne,
|
||||
lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
|
||||
|
||||
-- | Parses a list number (num) followed by a period, returns list attributes.
|
||||
inPeriod :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
-> Parsec [Char] st ListAttributes
|
||||
inPeriod :: Parser [Char] st (ListNumberStyle, Int)
|
||||
-> Parser [Char] st ListAttributes
|
||||
inPeriod num = try $ do
|
||||
(style, start) <- num
|
||||
char '.'
|
||||
@@ -486,16 +486,16 @@ inPeriod num = try $ do
|
||||
return (start, style, delim)
|
||||
|
||||
-- | Parses a list number (num) followed by a paren, returns list attributes.
|
||||
inOneParen :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
-> Parsec [Char] st ListAttributes
|
||||
inOneParen :: Parser [Char] st (ListNumberStyle, Int)
|
||||
-> Parser [Char] st ListAttributes
|
||||
inOneParen num = try $ do
|
||||
(style, start) <- num
|
||||
char ')'
|
||||
return (start, style, OneParen)
|
||||
|
||||
-- | Parses a list number (num) enclosed in parens, returns list attributes.
|
||||
inTwoParens :: Parsec [Char] st (ListNumberStyle, Int)
|
||||
-> Parsec [Char] st ListAttributes
|
||||
inTwoParens :: Parser [Char] st (ListNumberStyle, Int)
|
||||
-> Parser [Char] st ListAttributes
|
||||
inTwoParens num = try $ do
|
||||
char '('
|
||||
(style, start) <- num
|
||||
@@ -506,7 +506,7 @@ inTwoParens num = try $ do
|
||||
-- returns number.
|
||||
orderedListMarker :: ListNumberStyle
|
||||
-> ListNumberDelim
|
||||
-> Parsec [Char] ParserState Int
|
||||
-> Parser [Char] ParserState Int
|
||||
orderedListMarker style delim = do
|
||||
let num = defaultNum <|> -- # can continue any kind of list
|
||||
case style of
|
||||
@@ -526,18 +526,18 @@ orderedListMarker style delim = do
|
||||
return start
|
||||
|
||||
-- | Parses a character reference and returns a Str element.
|
||||
charRef :: Parsec [Char] st Inline
|
||||
charRef :: Parser [Char] st Inline
|
||||
charRef = do
|
||||
c <- characterReference
|
||||
return $ Str [c]
|
||||
|
||||
-- | Parse a table using 'headerParser', 'rowParser',
|
||||
-- 'lineParser', and 'footerParser'.
|
||||
tableWith :: Parsec [Char] ParserState ([[Block]], [Alignment], [Int])
|
||||
-> ([Int] -> Parsec [Char] ParserState [[Block]])
|
||||
-> Parsec [Char] ParserState sep
|
||||
-> Parsec [Char] ParserState end
|
||||
-> Parsec [Char] ParserState Block
|
||||
tableWith :: Parser [Char] ParserState ([[Block]], [Alignment], [Int])
|
||||
-> ([Int] -> Parser [Char] ParserState [[Block]])
|
||||
-> Parser [Char] ParserState sep
|
||||
-> Parser [Char] ParserState end
|
||||
-> Parser [Char] ParserState Block
|
||||
tableWith headerParser rowParser lineParser footerParser = try $ do
|
||||
(heads, aligns, indices) <- headerParser
|
||||
lines' <- rowParser indices `sepEndBy1` lineParser
|
||||
@@ -579,9 +579,9 @@ widthsFromIndices numColumns' indices =
|
||||
-- (which may be grid), then the rows,
|
||||
-- which may be grid, separated by blank lines, and
|
||||
-- ending with a footer (dashed line followed by blank line).
|
||||
gridTableWith :: Parsec [Char] ParserState Block -- ^ Block parser
|
||||
gridTableWith :: Parser [Char] ParserState Block -- ^ Block parser
|
||||
-> Bool -- ^ Headerless table
|
||||
-> Parsec [Char] ParserState Block
|
||||
-> Parser [Char] ParserState Block
|
||||
gridTableWith block headless =
|
||||
tableWith (gridTableHeader headless block) (gridTableRow block) (gridTableSep '-') gridTableFooter
|
||||
|
||||
@@ -589,13 +589,13 @@ gridTableSplitLine :: [Int] -> String -> [String]
|
||||
gridTableSplitLine indices line = map removeFinalBar $ tail $
|
||||
splitStringByIndices (init indices) $ removeTrailingSpace line
|
||||
|
||||
gridPart :: Char -> Parsec [Char] st (Int, Int)
|
||||
gridPart :: Char -> Parser [Char] st (Int, Int)
|
||||
gridPart ch = do
|
||||
dashes <- many1 (char ch)
|
||||
char '+'
|
||||
return (length dashes, length dashes + 1)
|
||||
|
||||
gridDashedLines :: Char -> Parsec [Char] st [(Int,Int)]
|
||||
gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]
|
||||
gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline
|
||||
|
||||
removeFinalBar :: String -> String
|
||||
@@ -603,13 +603,13 @@ removeFinalBar =
|
||||
reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse
|
||||
|
||||
-- | Separator between rows of grid table.
|
||||
gridTableSep :: Char -> Parsec [Char] ParserState Char
|
||||
gridTableSep :: Char -> Parser [Char] ParserState Char
|
||||
gridTableSep ch = try $ gridDashedLines ch >> return '\n'
|
||||
|
||||
-- | Parse header for a grid table.
|
||||
gridTableHeader :: Bool -- ^ Headerless table
|
||||
-> Parsec [Char] ParserState Block
|
||||
-> Parsec [Char] ParserState ([[Block]], [Alignment], [Int])
|
||||
-> Parser [Char] ParserState Block
|
||||
-> Parser [Char] ParserState ([[Block]], [Alignment], [Int])
|
||||
gridTableHeader headless block = try $ do
|
||||
optional blanklines
|
||||
dashes <- gridDashedLines '-'
|
||||
@@ -633,16 +633,16 @@ gridTableHeader headless block = try $ do
|
||||
map removeLeadingTrailingSpace rawHeads
|
||||
return (heads, aligns, indices)
|
||||
|
||||
gridTableRawLine :: [Int] -> Parsec [Char] ParserState [String]
|
||||
gridTableRawLine :: [Int] -> Parser [Char] ParserState [String]
|
||||
gridTableRawLine indices = do
|
||||
char '|'
|
||||
line <- many1Till anyChar newline
|
||||
return (gridTableSplitLine indices line)
|
||||
|
||||
-- | Parse row of grid table.
|
||||
gridTableRow :: Parsec [Char] ParserState Block
|
||||
gridTableRow :: Parser [Char] ParserState Block
|
||||
-> [Int]
|
||||
-> Parsec [Char] ParserState [[Block]]
|
||||
-> Parser [Char] ParserState [[Block]]
|
||||
gridTableRow block indices = do
|
||||
colLines <- many1 (gridTableRawLine indices)
|
||||
let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
|
||||
@@ -661,13 +661,13 @@ compactifyCell :: [Block] -> [Block]
|
||||
compactifyCell bs = head $ compactify [bs]
|
||||
|
||||
-- | Parse footer for a grid table.
|
||||
gridTableFooter :: Parsec [Char] ParserState [Char]
|
||||
gridTableFooter :: Parser [Char] ParserState [Char]
|
||||
gridTableFooter = blanklines
|
||||
|
||||
---
|
||||
|
||||
-- | Parse a string with a given parser and state.
|
||||
readWith :: Parsec [t] ParserState a -- ^ parser
|
||||
readWith :: Parser [t] ParserState a -- ^ parser
|
||||
-> ParserState -- ^ initial state
|
||||
-> [t] -- ^ input
|
||||
-> a
|
||||
@@ -677,7 +677,7 @@ readWith parser state input =
|
||||
Right result -> result
|
||||
|
||||
-- | Parse a string with @parser@ (for testing).
|
||||
testStringWith :: (Show a) => Parsec [Char] ParserState a
|
||||
testStringWith :: (Show a) => Parser [Char] ParserState a
|
||||
-> String
|
||||
-> IO ()
|
||||
testStringWith parser str = UTF8.putStrLn $ show $
|
||||
@@ -781,25 +781,25 @@ lookupKeySrc table key = case M.lookup key table of
|
||||
Just src -> Just src
|
||||
|
||||
-- | Fail unless we're in "smart typography" mode.
|
||||
failUnlessSmart :: Parsec [tok] ParserState ()
|
||||
failUnlessSmart :: Parser [tok] ParserState ()
|
||||
failUnlessSmart = getOption readerSmart >>= guard
|
||||
|
||||
smartPunctuation :: Parsec [Char] ParserState Inline
|
||||
-> Parsec [Char] ParserState Inline
|
||||
smartPunctuation :: Parser [Char] ParserState Inline
|
||||
-> Parser [Char] ParserState Inline
|
||||
smartPunctuation inlineParser = do
|
||||
failUnlessSmart
|
||||
choice [ quoted inlineParser, apostrophe, dash, ellipses ]
|
||||
|
||||
apostrophe :: Parsec [Char] ParserState Inline
|
||||
apostrophe :: Parser [Char] ParserState Inline
|
||||
apostrophe = (char '\'' <|> char '\8217') >> return (Str "\x2019")
|
||||
|
||||
quoted :: Parsec [Char] ParserState Inline
|
||||
-> Parsec [Char] ParserState Inline
|
||||
quoted :: Parser [Char] ParserState Inline
|
||||
-> Parser [Char] ParserState Inline
|
||||
quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
|
||||
|
||||
withQuoteContext :: QuoteContext
|
||||
-> (Parsec [Char] ParserState Inline)
|
||||
-> Parsec [Char] ParserState Inline
|
||||
-> (Parser [Char] ParserState Inline)
|
||||
-> Parser [Char] ParserState Inline
|
||||
withQuoteContext context parser = do
|
||||
oldState <- getState
|
||||
let oldQuoteContext = stateQuoteContext oldState
|
||||
@@ -809,39 +809,39 @@ withQuoteContext context parser = do
|
||||
setState newState { stateQuoteContext = oldQuoteContext }
|
||||
return result
|
||||
|
||||
singleQuoted :: Parsec [Char] ParserState Inline
|
||||
-> Parsec [Char] ParserState Inline
|
||||
singleQuoted :: Parser [Char] ParserState Inline
|
||||
-> Parser [Char] ParserState Inline
|
||||
singleQuoted inlineParser = try $ do
|
||||
singleQuoteStart
|
||||
withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>=
|
||||
return . Quoted SingleQuote . normalizeSpaces
|
||||
|
||||
doubleQuoted :: Parsec [Char] ParserState Inline
|
||||
-> Parsec [Char] ParserState Inline
|
||||
doubleQuoted :: Parser [Char] ParserState Inline
|
||||
-> Parser [Char] ParserState Inline
|
||||
doubleQuoted inlineParser = try $ do
|
||||
doubleQuoteStart
|
||||
withQuoteContext InDoubleQuote $ do
|
||||
contents <- manyTill inlineParser doubleQuoteEnd
|
||||
return . Quoted DoubleQuote . normalizeSpaces $ contents
|
||||
|
||||
failIfInQuoteContext :: QuoteContext -> Parsec [tok] ParserState ()
|
||||
failIfInQuoteContext :: QuoteContext -> Parser [tok] ParserState ()
|
||||
failIfInQuoteContext context = do
|
||||
st <- getState
|
||||
if stateQuoteContext st == context
|
||||
then fail "already inside quotes"
|
||||
else return ()
|
||||
|
||||
charOrRef :: [Char] -> Parsec [Char] st Char
|
||||
charOrRef :: [Char] -> Parser [Char] st Char
|
||||
charOrRef cs =
|
||||
oneOf cs <|> try (do c <- characterReference
|
||||
guard (c `elem` cs)
|
||||
return c)
|
||||
|
||||
updateLastStrPos :: Parsec [Char] ParserState ()
|
||||
updateLastStrPos :: Parser [Char] ParserState ()
|
||||
updateLastStrPos = getPosition >>= \p ->
|
||||
updateState $ \s -> s{ stateLastStrPos = Just p }
|
||||
|
||||
singleQuoteStart :: Parsec [Char] ParserState ()
|
||||
singleQuoteStart :: Parser [Char] ParserState ()
|
||||
singleQuoteStart = do
|
||||
failIfInQuoteContext InSingleQuote
|
||||
pos <- getPosition
|
||||
@@ -856,28 +856,28 @@ singleQuoteStart = do
|
||||
-- possess/contraction
|
||||
return ()
|
||||
|
||||
singleQuoteEnd :: Parsec [Char] st ()
|
||||
singleQuoteEnd :: Parser [Char] st ()
|
||||
singleQuoteEnd = try $ do
|
||||
charOrRef "'\8217\146"
|
||||
notFollowedBy alphaNum
|
||||
|
||||
doubleQuoteStart :: Parsec [Char] ParserState ()
|
||||
doubleQuoteStart :: Parser [Char] ParserState ()
|
||||
doubleQuoteStart = do
|
||||
failIfInQuoteContext InDoubleQuote
|
||||
try $ do charOrRef "\"\8220\147"
|
||||
notFollowedBy (satisfy (\c -> c == ' ' || c == '\t' || c == '\n'))
|
||||
|
||||
doubleQuoteEnd :: Parsec [Char] st ()
|
||||
doubleQuoteEnd :: Parser [Char] st ()
|
||||
doubleQuoteEnd = do
|
||||
charOrRef "\"\8221\148"
|
||||
return ()
|
||||
|
||||
ellipses :: Parsec [Char] st Inline
|
||||
ellipses :: Parser [Char] st Inline
|
||||
ellipses = do
|
||||
try (charOrRef "\8230\133") <|> try (string "..." >> return '…')
|
||||
return (Str "\8230")
|
||||
|
||||
dash :: Parsec [Char] ParserState Inline
|
||||
dash :: Parser [Char] ParserState Inline
|
||||
dash = do
|
||||
oldDashes <- getOption readerOldDashes
|
||||
if oldDashes
|
||||
@@ -885,28 +885,28 @@ dash = do
|
||||
else Str `fmap` (hyphenDash <|> emDash <|> enDash)
|
||||
|
||||
-- Two hyphens = en-dash, three = em-dash
|
||||
hyphenDash :: Parsec [Char] st String
|
||||
hyphenDash :: Parser [Char] st String
|
||||
hyphenDash = do
|
||||
try $ string "--"
|
||||
option "\8211" (char '-' >> return "\8212")
|
||||
|
||||
emDash :: Parsec [Char] st String
|
||||
emDash :: Parser [Char] st String
|
||||
emDash = do
|
||||
try (charOrRef "\8212\151")
|
||||
return "\8212"
|
||||
|
||||
enDash :: Parsec [Char] st String
|
||||
enDash :: Parser [Char] st String
|
||||
enDash = do
|
||||
try (charOrRef "\8212\151")
|
||||
return "\8211"
|
||||
|
||||
enDashOld :: Parsec [Char] st Inline
|
||||
enDashOld :: Parser [Char] st Inline
|
||||
enDashOld = do
|
||||
try (charOrRef "\8211\150") <|>
|
||||
try (char '-' >> lookAhead (satisfy isDigit) >> return '–')
|
||||
return (Str "\8211")
|
||||
|
||||
emDashOld :: Parsec [Char] st Inline
|
||||
emDashOld :: Parser [Char] st Inline
|
||||
emDashOld = do
|
||||
try (charOrRef "\8212\151") <|> (try $ string "--" >> optional (char '-') >> return '-')
|
||||
return (Str "\8212")
|
||||
@@ -916,7 +916,7 @@ emDashOld = do
|
||||
--
|
||||
|
||||
-- | Parse a \newcommand or \renewcommand macro definition.
|
||||
macro :: Parsec [Char] ParserState Block
|
||||
macro :: Parser [Char] ParserState Block
|
||||
macro = do
|
||||
apply <- getOption readerApplyMacros
|
||||
inp <- getInput
|
||||
@@ -931,7 +931,7 @@ macro = do
|
||||
else return $ RawBlock "latex" def'
|
||||
|
||||
-- | Apply current macros to string.
|
||||
applyMacros' :: String -> Parsec [Char] ParserState String
|
||||
applyMacros' :: String -> Parser [Char] ParserState String
|
||||
applyMacros' target = do
|
||||
apply <- getOption readerApplyMacros
|
||||
if apply
|
||||
@@ -939,3 +939,44 @@ applyMacros' target = do
|
||||
return $ applyMacros macros target
|
||||
else return target
|
||||
|
||||
---- pandoc2 block sep/line end parsers
|
||||
{-
|
||||
|
||||
-- | Push parser onto stack of endline parsers.
|
||||
-- These are applied after a newline within a block.
|
||||
pushEndline :: PMonad m => P t m () -> P t m ()
|
||||
pushEndline p = modifyState $ \st -> st{ sEndline = sEndline st |> p }
|
||||
|
||||
-- | Pop parser off stack of endline parsers.
|
||||
popEndline :: PMonad m => P t m ()
|
||||
popEndline = do
|
||||
st <- getState
|
||||
case viewr (sEndline st) of
|
||||
EmptyR -> logM ERROR "Tried to pop empty pEndline stack"
|
||||
ps :> _ -> setState st{ sEndline = ps }
|
||||
|
||||
-- | Apply a parser in a context with a specified endline parser.
|
||||
withEndline :: PMonad m => P t m a -> P t m b -> P t m b
|
||||
withEndline sep p = pushEndline (() <$ sep) *> p <* popEndline
|
||||
|
||||
-- | Push parser onto stack of block separator parsers.
|
||||
-- These are applied after a newline following a block.
|
||||
pushBlockSep :: PMonad m => P t m () -> P t m ()
|
||||
pushBlockSep p = modifyState $ \st -> st{ sBlockSep = sBlockSep st |> p }
|
||||
|
||||
-- | Pop parser off of stack of block separator parsers.
|
||||
popBlockSep :: PMonad m => P t m ()
|
||||
popBlockSep = do
|
||||
st <- getState
|
||||
case viewr (sBlockSep st) of
|
||||
EmptyR -> logM ERROR "Tried to pop empty pBlockSep stack"
|
||||
ps :> _ -> setState st{ sBlockSep = ps }
|
||||
|
||||
-- | Apply a parser in a context with specified block separator parser.
|
||||
withBlockSep :: PMonad m => P t m a -> P t m b -> P t m b
|
||||
withBlockSep sep p = pushBlockSep (() <$ sep) *> p <* popBlockSep
|
||||
|
||||
-- | Parse a block separator.
|
||||
pBlockSep :: PMonad m => P t m ()
|
||||
pBlockSep = try (getState >>= sequenceA . sBlockSep) >> return ()
|
||||
-}
|
||||
|
||||
Reference in New Issue
Block a user