@@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 Module : Text.Pandoc.Parsing
20 Module : Text.Pandoc.Parsing
21 Copyright : Copyright (C) 2006-2010 John MacFarlane
21 Copyright : Copyright (C) 2006-2010 John MacFarlane
22− License : GNU GPL, version 2 or above
22+ License : GNU GPL, version 2 or above
24 Maintainer : John MacFarlane <jgm@berkeley.edu>
24 Maintainer : John MacFarlane <jgm@berkeley.edu>
25 Stability : alpha
25 Stability : alpha
@@ -27,9 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
28A utility library with parsers used in pandoc readers.
28A utility library with parsers used in pandoc readers.
30−module Text.Pandoc.Parsing ( GeneralParser,
30+module Text.Pandoc.Parsing ( (>>~),
34 many1Till,
32 many1Till,
35 notFollowedBy',
33 notFollowedBy',
@@ -88,68 +86,64 @@ import Text.Pandoc.Shared
88import qualified Data.Map as M
86import qualified Data.Map as M
89import Text.TeXMath.Macros (applyMacros, Macro, parseMacroDefinitions)
87import Text.TeXMath.Macros (applyMacros, Macro, parseMacroDefinitions)
91−type GeneralParser st a = GenParser Char st a
93−type PandocParser a = GeneralParser ParserState a
95-- | Like >>, but returns the operation on the left.
89-- | Like >>, but returns the operation on the left.
96-- (Suggested by Tillmann Rendel on Haskell-cafe list.)
90-- (Suggested by Tillmann Rendel on Haskell-cafe list.)
97(>>~) :: (Monad m) => m a -> m b -> m a
91(>>~) :: (Monad m) => m a -> m b -> m a
98a >>~ b = a >>= \x -> b >> return x
92a >>~ b = a >>= \x -> b >> return x
100-- | Parse any line of text
94-- | Parse any line of text
101−anyLine :: GeneralParser st String
95+anyLine :: GenParser Char st [Char]
102anyLine = manyTill anyChar newline
96anyLine = manyTill anyChar newline
104-- | Like @manyTill@, but reads at least one item.
98-- | Like @manyTill@, but reads at least one item.
105−many1Till :: GeneralParser st a
99+many1Till :: GenParser tok st a
106− -> GeneralParser st end
100+ -> GenParser tok st end
107− -> GeneralParser st [a]
101+ -> GenParser tok st [a]
108many1Till p end = do
102many1Till p end = do
109 first <- p
103 first <- p
110 rest <- manyTill p end
104 rest <- manyTill p end
111 return (first:rest)
105 return (first:rest)
113−-- | A more general form of @notFollowedBy@. This one allows any
107+-- | A more general form of @notFollowedBy@. This one allows any
114-- type of parser to be specified, and succeeds only if that parser fails.
108-- type of parser to be specified, and succeeds only if that parser fails.
115-- It does not consume any input.
109-- It does not consume any input.
116−notFollowedBy' :: Show b => GeneralParser st b -> GeneralParser st ()
110+notFollowedBy' :: Show b => GenParser a st b -> GenParser a st ()
117notFollowedBy' p = try $ join $ do a <- try p
111notFollowedBy' p = try $ join $ do a <- try p
118 return (unexpected (show a))
112 return (unexpected (show a))
120 return (return ())
114 return (return ())
121-- (This version due to Andrew Pimlott on the Haskell mailing list.)
115-- (This version due to Andrew Pimlott on the Haskell mailing list.)
123−-- | Parses one of a list of strings (tried in order).
117+-- | Parses one of a list of strings (tried in order).
124−oneOfStrings :: [String] -> GeneralParser st String
118+oneOfStrings :: [String] -> GenParser Char st String
125oneOfStrings listOfStrings = choice $ map (try . string) listOfStrings
119oneOfStrings listOfStrings = choice $ map (try . string) listOfStrings
127-- | Parses a space or tab.
121-- | Parses a space or tab.
128−spaceChar :: GeneralParser st Char
122+spaceChar :: CharParser st Char
129spaceChar = satisfy $ \c -> c == ' ' || c == '\t'
123spaceChar = satisfy $ \c -> c == ' ' || c == '\t'
131-- | Skips zero or more spaces or tabs.
125-- | Skips zero or more spaces or tabs.
132−skipSpaces :: GeneralParser st ()
126+skipSpaces :: GenParser Char st ()
133skipSpaces = skipMany spaceChar
127skipSpaces = skipMany spaceChar
135-- | Skips zero or more spaces or tabs, then reads a newline.
129-- | Skips zero or more spaces or tabs, then reads a newline.
136−blankline :: GeneralParser st Char
130+blankline :: GenParser Char st Char
137blankline = try $ skipSpaces >> newline
131blankline = try $ skipSpaces >> newline
139-- | Parses one or more blank lines and returns a string of newlines.
133-- | Parses one or more blank lines and returns a string of newlines.
140−blanklines :: GeneralParser st [Char]
134+blanklines :: GenParser Char st [Char]
141blanklines = many1 blankline
135blanklines = many1 blankline
143-- | Parses material enclosed between start and end parsers.
137-- | Parses material enclosed between start and end parsers.
144−enclosed :: GeneralParser st t -- ^ start parser
138+enclosed :: GenParser Char st t -- ^ start parser
145− -> GeneralParser st end -- ^ end parser
139+ -> GenParser Char st end -- ^ end parser
146− -> GeneralParser st a -- ^ content parser (to be used repeatedly)
140+ -> GenParser Char st a -- ^ content parser (to be used repeatedly)
147− -> GeneralParser st [a]
141+ -> GenParser Char st [a]
148−enclosed start end parser = try $
142+enclosed start end parser = try $
149 start >> notFollowedBy space >> many1Till parser end
143 start >> notFollowedBy space >> many1Till parser end
151-- | Parse string, case insensitive.
145-- | Parse string, case insensitive.
152−stringAnyCase :: [Char] -> GeneralParser st String
146+stringAnyCase :: [Char] -> CharParser st String
153stringAnyCase [] = string ""
147stringAnyCase [] = string ""
154stringAnyCase (x:xs) = do
148stringAnyCase (x:xs) = do
155 firstChar <- char (toUpper x) <|> char (toLower x)
149 firstChar <- char (toUpper x) <|> char (toLower x)
@@ -157,7 +151,7 @@ stringAnyCase (x:xs) = do
157 return (firstChar:rest)
151 return (firstChar:rest)
159-- | Parse contents of 'str' using 'parser' and return result.
153-- | Parse contents of 'str' using 'parser' and return result.
160−parseFromString :: GeneralParser st a -> String -> GeneralParser st a
154+parseFromString :: GenParser tok st a -> [tok] -> GenParser tok st a
161parseFromString parser str = do
155parseFromString parser str = do
162 oldPos <- getPosition
156 oldPos <- getPosition
163 oldInput <- getInput
157 oldInput <- getInput
@@ -168,8 +162,8 @@ parseFromString parser str = do
168 return result
162 return result
170-- | Parse raw line block up to and including blank lines.
164-- | Parse raw line block up to and including blank lines.
171−lineClump :: GeneralParser st String
165+lineClump :: GenParser Char st String
172−lineClump = blanklines
166+lineClump = blanklines
173 <|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines)
167 <|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines)
175-- | Parse a string of characters between an open character
169-- | Parse a string of characters between an open character
@@ -178,7 +172,7 @@ lineClump = blanklines
178-- @charsInBalanced '(' ')'@ will parse "(hello (there))"
172-- @charsInBalanced '(' ')'@ will parse "(hello (there))"
179-- and return "hello (there)". Stop if a blank line is
173-- and return "hello (there)". Stop if a blank line is
180-- encountered.
174-- encountered.
181−charsInBalanced :: Char -> Char -> GeneralParser st String
175+charsInBalanced :: Char -> Char -> GenParser Char st String
182charsInBalanced open close = try $ do
176charsInBalanced open close = try $ do
183 char open
177 char open
184 raw <- many $ (many1 (satisfy $ \c ->
178 raw <- many $ (many1 (satisfy $ \c ->
@@ -190,7 +184,7 @@ charsInBalanced open close = try $ do
190 return $ concat raw
184 return $ concat raw
192-- | Like @charsInBalanced@, but allow blank lines in the content.
186-- | Like @charsInBalanced@, but allow blank lines in the content.
193−charsInBalanced' :: Char -> Char -> GeneralParser st String
187+charsInBalanced' :: Char -> Char -> GenParser Char st String
194charsInBalanced' open close = try $ do
188charsInBalanced' open close = try $ do
195 char open
189 char open
196 raw <- many $ (many1 (satisfy $ \c -> c /= open && c /= close))
190 raw <- many $ (many1 (satisfy $ \c -> c /= open && c /= close))
@@ -209,13 +203,13 @@ uppercaseRomanDigits = map toUpper lowercaseRomanDigits
210-- | Parses a roman numeral (uppercase or lowercase), returns number.
204-- | Parses a roman numeral (uppercase or lowercase), returns number.
211romanNumeral :: Bool -- ^ Uppercase if true
205romanNumeral :: Bool -- ^ Uppercase if true
212− -> GeneralParser st Int
206+ -> GenParser Char st Int
213romanNumeral upperCase = do
207romanNumeral upperCase = do
214− let romanDigits = if upperCase
208+ let romanDigits = if upperCase
215− then uppercaseRomanDigits
209+ then uppercaseRomanDigits
216 else lowercaseRomanDigits
210 else lowercaseRomanDigits
217 lookAhead $ oneOf romanDigits
211 lookAhead $ oneOf romanDigits
218− let [one, five, ten, fifty, hundred, fivehundred, thousand] =
212+ let [one, five, ten, fifty, hundred, fivehundred, thousand] =
219 map char romanDigits
213 map char romanDigits
220 thousands <- many thousand >>= (return . (1000 *) . length)
214 thousands <- many thousand >>= (return . (1000 *) . length)
221 ninehundreds <- option 0 $ try $ hundred >> thousand >> return 900
215 ninehundreds <- option 0 $ try $ hundred >> thousand >> return 900
@@ -239,14 +233,14 @@ romanNumeral upperCase = do
240-- Parsers for email addresses and URIs
234-- Parsers for email addresses and URIs
242−emailChar :: GeneralParser st Char
236+emailChar :: GenParser Char st Char
243emailChar = alphaNum <|>
237emailChar = alphaNum <|>
244 satisfy (\c -> c == '-' || c == '+' || c == '_' || c == '.')
238 satisfy (\c -> c == '-' || c == '+' || c == '_' || c == '.')
246−domainChar :: GeneralParser st Char
240+domainChar :: GenParser Char st Char
247domainChar = alphaNum <|> char '-'
241domainChar = alphaNum <|> char '-'
249−domain :: GeneralParser st [Char]
243+domain :: GenParser Char st [Char]
250domain = do
244domain = do
251 first <- many1 domainChar
245 first <- many1 domainChar
252 dom <- many1 $ try (char '.' >> many1 domainChar )
246 dom <- many1 $ try (char '.' >> many1 domainChar )
@@ -254,7 +248,7 @@ domain = do
255-- | Parses an email address; returns original and corresponding
249-- | Parses an email address; returns original and corresponding
256-- escaped mailto: URI.
250-- escaped mailto: URI.
257−emailAddress :: GeneralParser st (String, String)
251+emailAddress :: GenParser Char st (String, String)
258emailAddress = try $ do
252emailAddress = try $ do
259 firstLetter <- alphaNum
253 firstLetter <- alphaNum
260 restAddr <- many emailChar
254 restAddr <- many emailChar
@@ -265,7 +259,7 @@ emailAddress = try $ do
265 return (full, escapeURI $ "mailto:" ++ full)
259 return (full, escapeURI $ "mailto:" ++ full)
267-- | Parses a URI. Returns pair of original and URI-escaped version.
261-- | Parses a URI. Returns pair of original and URI-escaped version.
268−uri :: GeneralParser st (String, String)
262+uri :: GenParser Char st (String, String)
269uri = try $ do
263uri = try $ do
270 let protocols = [ "http:", "https:", "ftp:", "file:", "mailto:",
264 let protocols = [ "http:", "https:", "ftp:", "file:", "mailto:",
271 "news:", "telnet:" ]
265 "news:", "telnet:" ]
@@ -299,8 +293,8 @@ uri = try $ do
299-- displacement (the difference between the source column at the end
293-- displacement (the difference between the source column at the end
300-- and the source column at the beginning). Vertical displacement
294-- and the source column at the beginning). Vertical displacement
301-- (source row) is ignored.
295-- (source row) is ignored.
302−withHorizDisplacement :: GeneralParser st a -- ^ Parser to apply
296+withHorizDisplacement :: GenParser Char st a -- ^ Parser to apply
303− -> GeneralParser st (a, Int) -- ^ (result, displacement)
297+ -> GenParser Char st (a, Int) -- ^ (result, displacement)
304withHorizDisplacement parser = do
298withHorizDisplacement parser = do
305 pos1 <- getPosition
299 pos1 <- getPosition
306 result <- parser
300 result <- parser
@@ -309,43 +303,43 @@ withHorizDisplacement parser = do
310-- | Parses a character and returns 'Null' (so that the parser can move on
304-- | Parses a character and returns 'Null' (so that the parser can move on
311-- if it gets stuck).
305-- if it gets stuck).
312−nullBlock :: GeneralParser st Block
306+nullBlock :: GenParser Char st Block
313nullBlock = anyChar >> return Null
307nullBlock = anyChar >> return Null
315-- | Fail if reader is in strict markdown syntax mode.
309-- | Fail if reader is in strict markdown syntax mode.
316−failIfStrict :: PandocParser ()
310+failIfStrict :: GenParser a ParserState ()
317failIfStrict = do
311failIfStrict = do
318 state <- getState
312 state <- getState
319 if stateStrict state then fail "strict mode" else return ()
313 if stateStrict state then fail "strict mode" else return ()
321-- | Fail unless we're in literate haskell mode.
315-- | Fail unless we're in literate haskell mode.
322−failUnlessLHS :: PandocParser ()
316+failUnlessLHS :: GenParser tok ParserState ()
323failUnlessLHS = do
317failUnlessLHS = do
324 state <- getState
318 state <- getState
325 if stateLiterateHaskell state then return () else fail "Literate haskell feature"
319 if stateLiterateHaskell state then return () else fail "Literate haskell feature"
327-- | Parses backslash, then applies character parser.
321-- | Parses backslash, then applies character parser.
328−escaped :: GeneralParser st Char -- ^ Parser for character to escape
322+escaped :: GenParser Char st Char -- ^ Parser for character to escape
329− -> GeneralParser st Inline
323+ -> GenParser Char st Inline
330escaped parser = try $ do
324escaped parser = try $ do
331 char '\\'
325 char '\\'
332 result <- parser
326 result <- parser
333 return (Str [result])
327 return (Str [result])
335-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
329-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
336−upperRoman :: GeneralParser st (ListNumberStyle, Int)
330+upperRoman :: GenParser Char st (ListNumberStyle, Int)
337upperRoman = do
331upperRoman = do
338 num <- romanNumeral True
332 num <- romanNumeral True
339 return (UpperRoman, num)
333 return (UpperRoman, num)
341-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
335-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
342−lowerRoman :: GeneralParser st (ListNumberStyle, Int)
336+lowerRoman :: GenParser Char st (ListNumberStyle, Int)
343lowerRoman = do
337lowerRoman = do
344 num <- romanNumeral False
338 num <- romanNumeral False
345 return (LowerRoman, num)
339 return (LowerRoman, num)
347-- | Parses a decimal numeral and returns (Decimal, number).
341-- | Parses a decimal numeral and returns (Decimal, number).
348−decimal :: GeneralParser st (ListNumberStyle, Int)
342+decimal :: GenParser Char st (ListNumberStyle, Int)
349decimal = do
343decimal = do
350 num <- many1 digit
344 num <- many1 digit
351 return (Decimal, read num)
345 return (Decimal, read num)
@@ -354,7 +348,7 @@ decimal = do
354-- returns (DefaultStyle, [next example number]). The next
348-- returns (DefaultStyle, [next example number]). The next
355-- example number is incremented in parser state, and the label
349-- example number is incremented in parser state, and the label
356-- (if present) is added to the label table.
350-- (if present) is added to the label table.
357−exampleNum :: PandocParser (ListNumberStyle, Int)
351+exampleNum :: GenParser Char ParserState (ListNumberStyle, Int)
358exampleNum = do
352exampleNum = do
360 lab <- many (alphaNum <|> satisfy (\c -> c == '_' || c == '-'))
354 lab <- many (alphaNum <|> satisfy (\c -> c == '_' || c == '-'))
@@ -368,38 +362,38 @@ exampleNum = do
368 return (Example, num)
362 return (Example, num)
370-- | Parses a '#' returns (DefaultStyle, 1).
364-- | Parses a '#' returns (DefaultStyle, 1).
371−defaultNum :: GeneralParser st (ListNumberStyle, Int)
365+defaultNum :: GenParser Char st (ListNumberStyle, Int)
372defaultNum = do
366defaultNum = do
374 return (DefaultStyle, 1)
368 return (DefaultStyle, 1)
376-- | Parses a lowercase letter and returns (LowerAlpha, number).
370-- | Parses a lowercase letter and returns (LowerAlpha, number).
377−lowerAlpha :: GeneralParser st (ListNumberStyle, Int)
371+lowerAlpha :: GenParser Char st (ListNumberStyle, Int)
378lowerAlpha = do
372lowerAlpha = do
379 ch <- oneOf ['a'..'z']
373 ch <- oneOf ['a'..'z']
380 return (LowerAlpha, ord ch - ord 'a' + 1)
374 return (LowerAlpha, ord ch - ord 'a' + 1)
382-- | Parses an uppercase letter and returns (UpperAlpha, number).
376-- | Parses an uppercase letter and returns (UpperAlpha, number).
383−upperAlpha :: GeneralParser st (ListNumberStyle, Int)
377+upperAlpha :: GenParser Char st (ListNumberStyle, Int)
384upperAlpha = do
378upperAlpha = do
385 ch <- oneOf ['A'..'Z']
379 ch <- oneOf ['A'..'Z']
386 return (UpperAlpha, ord ch - ord 'A' + 1)
380 return (UpperAlpha, ord ch - ord 'A' + 1)
388-- | Parses a roman numeral i or I
382-- | Parses a roman numeral i or I
389−romanOne :: GeneralParser st (ListNumberStyle, Int)
383+romanOne :: GenParser Char st (ListNumberStyle, Int)
390romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
384romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
391 (char 'I' >> return (UpperRoman, 1))
385 (char 'I' >> return (UpperRoman, 1))
393-- | Parses an ordered list marker and returns list attributes.
387-- | Parses an ordered list marker and returns list attributes.
394−anyOrderedListMarker :: PandocParser ListAttributes
388+anyOrderedListMarker :: GenParser Char ParserState ListAttributes
395−anyOrderedListMarker = choice $
389+anyOrderedListMarker = choice $
396 [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
390 [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
397 numParser <- [decimal, exampleNum, defaultNum, romanOne,
391 numParser <- [decimal, exampleNum, defaultNum, romanOne,
398 lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
392 lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
400-- | Parses a list number (num) followed by a period, returns list attributes.
394-- | Parses a list number (num) followed by a period, returns list attributes.
401−inPeriod :: GeneralParser st (ListNumberStyle, Int)
395+inPeriod :: GenParser Char st (ListNumberStyle, Int)
402− -> GeneralParser st ListAttributes
396+ -> GenParser Char st ListAttributes
403inPeriod num = try $ do
397inPeriod num = try $ do
404 (style, start) <- num
398 (style, start) <- num
@@ -407,18 +401,18 @@ inPeriod num = try $ do
407 then DefaultDelim
401 then DefaultDelim
408 else Period
402 else Period
409 return (start, style, delim)
403 return (start, style, delim)
411-- | Parses a list number (num) followed by a paren, returns list attributes.
405-- | Parses a list number (num) followed by a paren, returns list attributes.
412−inOneParen :: GeneralParser st (ListNumberStyle, Int)
406+inOneParen :: GenParser Char st (ListNumberStyle, Int)
413− -> GeneralParser st ListAttributes
407+ -> GenParser Char st ListAttributes
414inOneParen num = try $ do
408inOneParen num = try $ do
415 (style, start) <- num
409 (style, start) <- num
417 return (start, style, OneParen)
411 return (start, style, OneParen)
419-- | Parses a list number (num) enclosed in parens, returns list attributes.
413-- | Parses a list number (num) enclosed in parens, returns list attributes.
420−inTwoParens :: GeneralParser st (ListNumberStyle, Int)
414+inTwoParens :: GenParser Char st (ListNumberStyle, Int)
421− -> GeneralParser st ListAttributes
415+ -> GenParser Char st ListAttributes
422inTwoParens num = try $ do
416inTwoParens num = try $ do
424 (style, start) <- num
418 (style, start) <- num
@@ -427,9 +421,9 @@ inTwoParens num = try $ do
428-- | Parses an ordered list marker with a given style and delimiter,
422-- | Parses an ordered list marker with a given style and delimiter,
429-- returns number.
423-- returns number.
430−orderedListMarker :: ListNumberStyle
424+orderedListMarker :: ListNumberStyle
431− -> ListNumberDelim
425+ -> ListNumberDelim
432− -> PandocParser Int
426+ -> GenParser Char ParserState Int
433orderedListMarker style delim = do
427orderedListMarker style delim = do
434 let num = defaultNum <|> -- # can continue any kind of list
428 let num = defaultNum <|> -- # can continue any kind of list
435 case style of
429 case style of
@@ -449,19 +443,19 @@ orderedListMarker style delim = do
449 return start
443 return start
451-- | Parses a character reference and returns a Str element.
445-- | Parses a character reference and returns a Str element.
452−charRef :: GeneralParser st Inline
446+charRef :: GenParser Char st Inline
453charRef = do
447charRef = do
454 c <- characterReference
448 c <- characterReference
455 return $ Str [c]
449 return $ Str [c]
457-- | Parse a table using 'headerParser', 'rowParser',
451-- | Parse a table using 'headerParser', 'rowParser',
458-- 'lineParser', and 'footerParser'.
452-- 'lineParser', and 'footerParser'.
459−tableWith :: PandocParser ([[Block]], [Alignment], [Int])
453+tableWith :: GenParser Char ParserState ([[Block]], [Alignment], [Int])
460− -> ([Int] -> PandocParser [[Block]])
454+ -> ([Int] -> GenParser Char ParserState [[Block]])
461− -> PandocParser sep
455+ -> GenParser Char ParserState sep
462− -> PandocParser end
456+ -> GenParser Char ParserState end
463− -> PandocParser [Inline]
457+ -> GenParser Char ParserState [Inline]
464− -> PandocParser Block
458+ -> GenParser Char ParserState Block
465tableWith headerParser rowParser lineParser footerParser captionParser = try $ do
459tableWith headerParser rowParser lineParser footerParser captionParser = try $ do
466 caption' <- option [] captionParser
460 caption' <- option [] captionParser
467 (heads, aligns, indices) <- headerParser
461 (heads, aligns, indices) <- headerParser
@@ -479,8 +473,8 @@ tableWith headerParser rowParser lineParser footerParser captionParser = try $ d
479widthsFromIndices :: Int -- Number of columns on terminal
473widthsFromIndices :: Int -- Number of columns on terminal
480 -> [Int] -- Indices
474 -> [Int] -- Indices
481 -> [Double] -- Fractional relative sizes of columns
475 -> [Double] -- Fractional relative sizes of columns
482−widthsFromIndices _ [] = []
476+widthsFromIndices _ [] = []
483−widthsFromIndices numColumns' indices =
477+widthsFromIndices numColumns' indices =
484 let numColumns = max numColumns' (if null indices then 0 else last indices)
478 let numColumns = max numColumns' (if null indices then 0 else last indices)
485 lengths' = zipWith (-) indices (0:indices)
479 lengths' = zipWith (-) indices (0:indices)
486 lengths = reverse $
480 lengths = reverse $
@@ -504,10 +498,10 @@ widthsFromIndices numColumns' indices =
504-- (which may be grid), then the rows,
498-- (which may be grid), then the rows,
505-- which may be grid, separated by blank lines, and
499-- which may be grid, separated by blank lines, and
506-- ending with a footer (dashed line followed by blank line).
500-- ending with a footer (dashed line followed by blank line).
507−gridTableWith :: PandocParser Block -- ^ Block parser
501+gridTableWith :: GenParser Char ParserState Block -- ^ Block parser
508− -> PandocParser [Inline] -- ^ Caption parser
502+ -> GenParser Char ParserState [Inline] -- ^ Caption parser
509 -> Bool -- ^ Headerless table
503 -> Bool -- ^ Headerless table
510− -> PandocParser Block
504+ -> GenParser Char ParserState Block
511gridTableWith block tableCaption headless =
505gridTableWith block tableCaption headless =
512 tableWith (gridTableHeader headless block) (gridTableRow block) (gridTableSep '-') gridTableFooter tableCaption
506 tableWith (gridTableHeader headless block) (gridTableRow block) (gridTableSep '-') gridTableFooter tableCaption
@@ -515,13 +509,13 @@ gridTableSplitLine :: [Int] -> String -> [String]
515gridTableSplitLine indices line = map removeFinalBar $ tail $
509gridTableSplitLine indices line = map removeFinalBar $ tail $
516 splitByIndices (init indices) $ removeTrailingSpace line
510 splitByIndices (init indices) $ removeTrailingSpace line
518−gridPart :: Char -> GeneralParser st (Int, Int)
512+gridPart :: Char -> GenParser Char st (Int, Int)
519gridPart ch = do
513gridPart ch = do
520 dashes <- many1 (char ch)
514 dashes <- many1 (char ch)
522 return (length dashes, length dashes + 1)
516 return (length dashes, length dashes + 1)
524−gridDashedLines :: Char -> GeneralParser st [(Int,Int)]
518+gridDashedLines :: Char -> GenParser Char st [(Int,Int)]
525gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline
519gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline
527removeFinalBar :: String -> String
521removeFinalBar :: String -> String
@@ -529,18 +523,18 @@ removeFinalBar =
529 reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse
523 reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse
531-- | Separator between rows of grid table.
525-- | Separator between rows of grid table.
532−gridTableSep :: Char -> PandocParser Char
526+gridTableSep :: Char -> GenParser Char ParserState Char
533gridTableSep ch = try $ gridDashedLines ch >> return '\n'
527gridTableSep ch = try $ gridDashedLines ch >> return '\n'
535-- | Parse header for a grid table.
529-- | Parse header for a grid table.
536gridTableHeader :: Bool -- ^ Headerless table
530gridTableHeader :: Bool -- ^ Headerless table
537− -> PandocParser Block
531+ -> GenParser Char ParserState Block
538− -> PandocParser ([[Block]], [Alignment], [Int])
532+ -> GenParser Char ParserState ([[Block]], [Alignment], [Int])
539gridTableHeader headless block = try $ do
533gridTableHeader headless block = try $ do
540 optional blanklines
534 optional blanklines
541 dashes <- gridDashedLines '-'
535 dashes <- gridDashedLines '-'
542 rawContent <- if headless
536 rawContent <- if headless
543− then return $ repeat ""
537+ then return $ repeat ""
544 else many1
538 else many1
545 (notFollowedBy (gridTableSep '=') >> char '|' >>
539 (notFollowedBy (gridTableSep '=') >> char '|' >>
546 many1Till anyChar newline)
540 many1Till anyChar newline)
@@ -559,16 +553,16 @@ gridTableHeader headless block = try $ do
559 map removeLeadingTrailingSpace rawHeads
553 map removeLeadingTrailingSpace rawHeads
560 return (heads, aligns, indices)
554 return (heads, aligns, indices)
562−gridTableRawLine :: [Int] -> PandocParser [String]
556+gridTableRawLine :: [Int] -> GenParser Char ParserState [String]
563gridTableRawLine indices = do
557gridTableRawLine indices = do
565 line <- many1Till anyChar newline
559 line <- many1Till anyChar newline
566 return (gridTableSplitLine indices line)
560 return (gridTableSplitLine indices line)
568-- | Parse row of grid table.
562-- | Parse row of grid table.
569−gridTableRow :: PandocParser Block
563+gridTableRow :: GenParser Char ParserState Block
571− -> PandocParser [[Block]]
565+ -> GenParser Char ParserState [[Block]]
572gridTableRow block indices = do
566gridTableRow block indices = do
573 colLines <- many1 (gridTableRawLine indices)
567 colLines <- many1 (gridTableRawLine indices)
574 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
568 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
@@ -587,23 +581,23 @@ compactifyCell :: [Block] -> [Block]
587compactifyCell bs = head $ compactify [bs]
581compactifyCell bs = head $ compactify [bs]
589-- | Parse footer for a grid table.
583-- | Parse footer for a grid table.
590−gridTableFooter :: PandocParser [Char]
584+gridTableFooter :: GenParser Char ParserState [Char]
591gridTableFooter = blanklines
585gridTableFooter = blanklines
595-- | Parse a string with a given parser and state.
589-- | Parse a string with a given parser and state.
596−readWith :: PandocParser a -- ^ parser
590+readWith :: GenParser t ParserState a -- ^ parser
597 -> ParserState -- ^ initial state
591 -> ParserState -- ^ initial state
598− -> String -- ^ input
592+ -> [t] -- ^ input
600−readWith parser state input =
594+readWith parser state input =
601 case runParser parser state "source" input of
595 case runParser parser state "source" input of
602 Left err -> error $ "\nError:\n" ++ show err
596 Left err -> error $ "\nError:\n" ++ show err
603 Right result -> result
597 Right result -> result
605-- | Parse a string with @parser@ (for testing).
599-- | Parse a string with @parser@ (for testing).
606−testStringWith :: (Show a) => PandocParser a
600+testStringWith :: (Show a) => GenParser Char ParserState a
607 -> String
601 -> String
609testStringWith parser str = UTF8.putStrLn $ show $
603testStringWith parser str = UTF8.putStrLn $ show $
@@ -629,7 +623,7 @@ data ParserState = ParserState
629 stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
623 stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
630 stateIndentedCodeClasses :: [String], -- ^ Classes to use for indented code blocks
624 stateIndentedCodeClasses :: [String], -- ^ Classes to use for indented code blocks
631 stateNextExample :: Int, -- ^ Number of next example
625 stateNextExample :: Int, -- ^ Number of next example
632− stateExamples :: M.Map String Int, -- ^ Map from example labels to numbers
626+ stateExamples :: M.Map String Int, -- ^ Map from example labels to numbers
633 stateHasChapters :: Bool, -- ^ True if \chapter encountered
627 stateHasChapters :: Bool, -- ^ True if \chapter encountered
634 stateApplyMacros :: Bool, -- ^ Apply LaTeX macros?
628 stateApplyMacros :: Bool, -- ^ Apply LaTeX macros?
635 stateMacros :: [Macro] -- ^ List of macros defined so far
629 stateMacros :: [Macro] -- ^ List of macros defined so far
@@ -637,7 +631,7 @@ data ParserState = ParserState
637 deriving Show
631 deriving Show
639defaultParserState :: ParserState
633defaultParserState :: ParserState
640−defaultParserState =
634+defaultParserState =
641 ParserState { stateParseRaw = False,
635 ParserState { stateParseRaw = False,
642 stateParserContext = NullState,
636 stateParserContext = NullState,
643 stateQuoteContext = NoQuote,
637 stateQuoteContext = NoQuote,
@@ -661,12 +655,12 @@ defaultParserState =
661 stateApplyMacros = True,
655 stateApplyMacros = True,
662 stateMacros = []}
656 stateMacros = []}
664−data HeaderType
658+data HeaderType
665 = SingleHeader Char -- ^ Single line of characters underneath
659 = SingleHeader Char -- ^ Single line of characters underneath
666 | DoubleHeader Char -- ^ Lines of characters above and below
660 | DoubleHeader Char -- ^ Lines of characters above and below
667 deriving (Eq, Show)
661 deriving (Eq, Show)
669−data ParserContext
663+data ParserContext
670 = ListItemState -- ^ Used when running parser on list item contents
664 = ListItemState -- ^ Used when running parser on list item contents
671 | NullState -- ^ Default state
665 | NullState -- ^ Default state
672 deriving (Eq, Show)
666 deriving (Eq, Show)
@@ -705,25 +699,25 @@ lookupKeySrc table key = case M.lookup key table of
705 Just src -> Just src
699 Just src -> Just src
707-- | Fail unless we're in "smart typography" mode.
701-- | Fail unless we're in "smart typography" mode.
708−failUnlessSmart :: PandocParser ()
702+failUnlessSmart :: GenParser tok ParserState ()
709failUnlessSmart = getState >>= guard . stateSmart
703failUnlessSmart = getState >>= guard . stateSmart
711−smartPunctuation :: PandocParser Inline
705+smartPunctuation :: GenParser Char ParserState Inline
712− -> PandocParser Inline
706+ -> GenParser Char ParserState Inline
713smartPunctuation inlineParser = do
707smartPunctuation inlineParser = do
714 failUnlessSmart
708 failUnlessSmart
715 choice [ quoted inlineParser, apostrophe, dash, ellipses ]
709 choice [ quoted inlineParser, apostrophe, dash, ellipses ]
717−apostrophe :: PandocParser Inline
711+apostrophe :: GenParser Char ParserState Inline
718apostrophe = (char '\'' <|> char '\8217') >> return Apostrophe
712apostrophe = (char '\'' <|> char '\8217') >> return Apostrophe
720−quoted :: PandocParser Inline
714+quoted :: GenParser Char ParserState Inline
721− -> PandocParser Inline
715+ -> GenParser Char ParserState Inline
722quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
716quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
724withQuoteContext :: QuoteContext
718withQuoteContext :: QuoteContext
725− -> (PandocParser Inline)
719+ -> (GenParser Char ParserState Inline)
726− -> PandocParser Inline
720+ -> GenParser Char ParserState Inline
727withQuoteContext context parser = do
721withQuoteContext context parser = do
728 oldState <- getState
722 oldState <- getState
729 let oldQuoteContext = stateQuoteContext oldState
723 let oldQuoteContext = stateQuoteContext oldState
@@ -733,75 +727,75 @@ withQuoteContext context parser = do
733 setState newState { stateQuoteContext = oldQuoteContext }
727 setState newState { stateQuoteContext = oldQuoteContext }
734 return result
728 return result
736−singleQuoted :: PandocParser Inline
730+singleQuoted :: GenParser Char ParserState Inline
737− -> PandocParser Inline
731+ -> GenParser Char ParserState Inline
738singleQuoted inlineParser = try $ do
732singleQuoted inlineParser = try $ do
739 singleQuoteStart
733 singleQuoteStart
740 withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>=
734 withQuoteContext InSingleQuote $ many1Till inlineParser singleQuoteEnd >>=
741 return . Quoted SingleQuote . normalizeSpaces
735 return . Quoted SingleQuote . normalizeSpaces
743−doubleQuoted :: PandocParser Inline
737+doubleQuoted :: GenParser Char ParserState Inline
744− -> PandocParser Inline
738+ -> GenParser Char ParserState Inline
745doubleQuoted inlineParser = try $ do
739doubleQuoted inlineParser = try $ do
746 doubleQuoteStart
740 doubleQuoteStart
747 withQuoteContext InDoubleQuote $ do
741 withQuoteContext InDoubleQuote $ do
748 contents <- manyTill inlineParser doubleQuoteEnd
742 contents <- manyTill inlineParser doubleQuoteEnd
749 return . Quoted DoubleQuote . normalizeSpaces $ contents
743 return . Quoted DoubleQuote . normalizeSpaces $ contents
751−failIfInQuoteContext :: QuoteContext -> PandocParser ()
745+failIfInQuoteContext :: QuoteContext -> GenParser tok ParserState ()
752failIfInQuoteContext context = do
746failIfInQuoteContext context = do
753 st <- getState
747 st <- getState
754 if stateQuoteContext st == context
748 if stateQuoteContext st == context
755 then fail "already inside quotes"
749 then fail "already inside quotes"
756 else return ()
750 else return ()
758−charOrRef :: [Char] -> GeneralParser st Char
752+charOrRef :: [Char] -> GenParser Char st Char
759charOrRef cs =
753charOrRef cs =
760 oneOf cs <|> try (do c <- characterReference
754 oneOf cs <|> try (do c <- characterReference
761 guard (c `elem` cs)
755 guard (c `elem` cs)
762 return c)
756 return c)
764−singleQuoteStart :: PandocParser ()
758+singleQuoteStart :: GenParser Char ParserState ()
765−singleQuoteStart = do
759+singleQuoteStart = do
766 failIfInQuoteContext InSingleQuote
760 failIfInQuoteContext InSingleQuote
767 try $ do charOrRef "'\8216"
761 try $ do charOrRef "'\8216"
768 notFollowedBy (oneOf ")!],.;:-? \t\n")
762 notFollowedBy (oneOf ")!],.;:-? \t\n")
769 notFollowedBy (try (oneOfStrings ["s","t","m","ve","ll","re"] >>
763 notFollowedBy (try (oneOfStrings ["s","t","m","ve","ll","re"] >>
770− satisfy (not . isAlphaNum)))
764+ satisfy (not . isAlphaNum)))
771 -- possess/contraction
765 -- possess/contraction
772 return ()
766 return ()
774−singleQuoteEnd :: GeneralParser st ()
768+singleQuoteEnd :: GenParser Char st ()
775singleQuoteEnd = try $ do
769singleQuoteEnd = try $ do
776 charOrRef "'\8217"
770 charOrRef "'\8217"
777 notFollowedBy alphaNum
771 notFollowedBy alphaNum
779−doubleQuoteStart :: PandocParser ()
773+doubleQuoteStart :: GenParser Char ParserState ()
780doubleQuoteStart = do
774doubleQuoteStart = do
781 failIfInQuoteContext InDoubleQuote
775 failIfInQuoteContext InDoubleQuote
782 try $ do charOrRef "\"\8220"
776 try $ do charOrRef "\"\8220"
783 notFollowedBy (satisfy (\c -> c == ' ' || c == '\t' || c == '\n'))
777 notFollowedBy (satisfy (\c -> c == ' ' || c == '\t' || c == '\n'))
785−doubleQuoteEnd :: GeneralParser st ()
779+doubleQuoteEnd :: GenParser Char st ()
786doubleQuoteEnd = do
780doubleQuoteEnd = do
787 charOrRef "\"\8221"
781 charOrRef "\"\8221"
788 return ()
782 return ()
790−ellipses :: GeneralParser st Inline
784+ellipses :: GenParser Char st Inline
791ellipses = do
785ellipses = do
792 try (charOrRef "…") <|> try (string "..." >> return '…')
786 try (charOrRef "…") <|> try (string "..." >> return '…')
793 return Ellipses
787 return Ellipses
795−dash :: GeneralParser st Inline
789+dash :: GenParser Char st Inline
796dash = enDash <|> emDash
790dash = enDash <|> emDash
798−enDash :: GeneralParser st Inline
792+enDash :: GenParser Char st Inline
799enDash = do
793enDash = do
800 try (charOrRef "–") <|>
794 try (charOrRef "–") <|>
801 try (char '-' >> lookAhead (satisfy isDigit) >> return '–')
795 try (char '-' >> lookAhead (satisfy isDigit) >> return '–')
802 return EnDash
796 return EnDash
804−emDash :: GeneralParser st Inline
798+emDash :: GenParser Char st Inline
805emDash = do
799emDash = do
806 try (charOrRef "—") <|> (try $ string "--" >> optional (char '-') >> return '—')
800 try (charOrRef "—") <|> (try $ string "--" >> optional (char '-') >> return '—')
807 return EmDash
801 return EmDash
@@ -811,7 +805,7 @@ emDash = do
813-- | Parse a \newcommand or \renewcommand macro definition.
807-- | Parse a \newcommand or \renewcommand macro definition.
814−macro :: PandocParser Block
808+macro :: GenParser Char ParserState Block
815macro = do
809macro = do
816 getState >>= guard . stateApplyMacros
810 getState >>= guard . stateApplyMacros
817 inp <- getInput
811 inp <- getInput
@@ -823,10 +817,11 @@ macro = do
823 return Null
817 return Null
825-- | Apply current macros to string.
819-- | Apply current macros to string.
826−applyMacros' :: String -> PandocParser String
820+applyMacros' :: String -> GenParser Char ParserState String
827applyMacros' target = do
821applyMacros' target = do
828 apply <- liftM stateApplyMacros getState
822 apply <- liftM stateApplyMacros getState
830 then do macros <- liftM stateMacros getState
824 then do macros <- liftM stateMacros getState
831 return $ applyMacros macros target
825 return $ applyMacros macros target
832 else return target
826 else return target