Permalink
Browse files

Beginnings of transition to using operational.

All the parsers will wrap a PandocProgram monad.
This will allow execution of instructions, e.g. to get
files or log warning messages.  How these instructions are
executed will depend on what interpreter function is used
to run the monad.  So, for example, we can interpret in the
IO monad and actually write to stderr, or interpret in a pure
monad and log errors using Either.
  • Loading branch information...
1 parent f79ed27 commit f2da55d15daa6874fbbee07d928cebff16c74bd9 John MacFarlane committed Jul 21, 2012
Showing with 148 additions and 102 deletions.
  1. +3 −0 pandoc.cabal
  2. +145 −102 src/Text/Pandoc/Parsing.hs
View
3 pandoc.cabal
@@ -202,6 +202,7 @@ Library
Build-Depends: containers >= 0.1 && < 0.5,
parsec >= 3.1 && < 3.2,
mtl >= 1.1 && < 2.2,
+ operational >= 0.2 && < 0.3,
network >= 2 && < 2.4,
filepath >= 1.1 && < 1.4,
process >= 1 && < 1.2,
@@ -311,6 +312,7 @@ Executable pandoc
Build-Depends: containers >= 0.1 && < 0.5,
parsec >= 3.1 && < 3.2,
mtl >= 1.1 && < 2.2,
+ operational >= 0.2 && < 0.3,
network >= 2 && < 2.4,
filepath >= 1.1 && < 1.4,
process >= 1 && < 1.2,
@@ -379,6 +381,7 @@ Executable test-pandoc
Build-Depends: containers >= 0.1 && < 0.5,
parsec >= 3.1 && < 3.2,
mtl >= 1.1 && < 2.2,
+ operational >= 0.2 && < 0.3,
network >= 2 && < 2.4,
filepath >= 1.1 && < 1.4,
process >= 1 && < 1.2,
View
247 src/Text/Pandoc/Parsing.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GADTs, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -129,33 +130,75 @@ where
import Text.Pandoc.Definition
import Text.Pandoc.Generic
import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
-import Text.Parsec
+import Text.Parsec hiding (runParser, token)
+import Text.Parsec.String ()
import Text.Parsec.Pos (newPos)
import Data.Char ( toLower, toUpper, ord, isAscii, isAlphaNum, isDigit, isPunctuation )
import Data.List ( intercalate, transpose )
import Network.URI ( parseURI, URI (..), isAllowedInURI )
import Control.Monad ( join, liftM, guard, mzero )
+import Control.Monad.Trans ( lift )
import Text.Pandoc.Shared
import qualified Data.Map as M
import Text.TeXMath.Macros (applyMacros, Macro, parseMacroDefinitions)
import Text.HTML.TagSoup.Entity ( lookupEntity )
import Data.Default
+import Control.Monad.Operational
-type Parser t s = Parsec t s
+
+-- TODO for testing
+import Debug.Trace
+
+-- TODO ultimately this will include instructions like
+-- "fetch the contents of this file" and "log this warning"
+data PandocInstruction a where
+ Say :: String -> PandocInstruction ()
+
+-- TODO for testing
+say :: String -> Parser s u ()
+say msg = lift $ singleton $ Say msg
+
+type PandocProgram = Program PandocInstruction
+
+-- TODO ultimately we'll have several different interpreters,
+-- one in IO, but also others that are pure
+interpret :: PandocProgram a -> a
+interpret = eval . view
+ where
+ eval :: ProgramView PandocInstruction a -> a
+ eval (Say x :>>= is) = trace x () `seq` interpret (is ())
+ eval (Return x) = x
+
+type Parser s u = ParsecT s u PandocProgram
+
+-- TODO for testing
+runParser :: Parser [t] u a -> u -> SourceName -> [t] -> Either ParseError a
+runParser p u n s = interpret $ runParserT p u n s
+
+token :: Stream s PandocProgram t
+ => (t -> String) -- ^ Token pretty-printing function.
+ -> (t -> SourcePos) -- ^ Computes the position of a token.
+ -> (t -> Maybe a) -- ^ Matching function for the token to parse.
+ -> Parser s u a
+token showToken tokpos test = tokenPrim showToken nextpos test
+ where
+ nextpos _ tok ts = case interpret (uncons ts) of
+ Nothing -> tokpos tok
+ Just (tok',_) -> tokpos tok'
-- | Like >>, but returns the operation on the left.
-- (Suggested by Tillmann Rendel on Haskell-cafe list.)
(>>~) :: (Monad m) => m a -> m b -> m a
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
@@ -164,55 +207,55 @@ 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))
<|>
return (return ())
-- (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 listOfStrings = choice $ map (try . string) listOfStrings
-- | 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)
rest <- stringAnyCase xs
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
@@ -223,7 +266,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)
@@ -232,8 +275,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
@@ -258,7 +301,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
@@ -288,22 +331,22 @@ 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 )
return $ intercalate "." (first:dom)
-- | 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
@@ -314,7 +357,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:" ]
@@ -348,8 +391,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
@@ -358,7 +401,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
@@ -375,26 +418,26 @@ 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 if reader is in strict markdown syntax mode.
-failIfStrict :: Parsec [a] ParserState ()
+failIfStrict :: Parser [a] ParserState ()
failIfStrict = do
state <- getState
if stateStrict state then fail "strict mode" else return ()
-- | Fail unless we're in literate haskell mode.
-failUnlessLHS :: Parsec [tok] ParserState ()
+failUnlessLHS :: Parser [tok] ParserState ()
failUnlessLHS = getState >>= guard . stateLiterateHaskell
-- | 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 ';')
@@ -403,19 +446,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)
@@ -424,7 +467,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 == '-'))
@@ -438,38 +481,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 '.'
@@ -479,16 +522,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
@@ -499,7 +542,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
@@ -519,19 +562,19 @@ 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 [Inline]
- -> 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 [Inline]
+ -> Parser [Char] ParserState Block
tableWith headerParser rowParser lineParser footerParser captionParser = try $ do
caption' <- option [] captionParser
(heads, aligns, indices) <- headerParser
@@ -574,38 +617,38 @@ 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
- -> Parsec [Char] ParserState [Inline] -- ^ Caption parser
+gridTableWith :: Parser [Char] ParserState Block -- ^ Block parser
+ -> Parser [Char] ParserState [Inline] -- ^ Caption parser
-> Bool -- ^ Headerless table
- -> Parsec [Char] ParserState Block
+ -> Parser [Char] ParserState Block
gridTableWith block tableCaption headless =
tableWith (gridTableHeader headless block) (gridTableRow block) (gridTableSep '-') gridTableFooter tableCaption
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
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 '-'
@@ -629,16 +672,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) $
@@ -657,13 +700,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
@@ -673,7 +716,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 $
@@ -788,25 +831,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 = getState >>= guard . stateSmart
-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
@@ -816,39 +859,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
@@ -863,57 +906,57 @@ 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 <- stateOldDashes `fmap` getState
if oldDashes
then emDashOld <|> enDashOld
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")
@@ -923,7 +966,7 @@ emDashOld = do
--
-- | Parse a \newcommand or \renewcommand macro definition.
-macro :: Parsec [Char] ParserState Block
+macro :: Parser [Char] ParserState Block
macro = do
apply <- stateApplyMacros `fmap` getState
inp <- getInput
@@ -938,7 +981,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 <- liftM stateApplyMacros getState
if apply

0 comments on commit f2da55d

Please sign in to comment.