@@ -5,11 +5,10 @@
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE IncoherentInstances #-}
6{-# LANGUAGE IncoherentInstances #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE ViewPatterns #-}
9{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
11 Module : Text.Pandoc.Parsing
10 Module : Text.Pandoc.Parsing
12− Copyright : Copyright (C) 2006-2020 John MacFarlane
11+ Copyright : Copyright (C) 2006-2021 John MacFarlane
13 License : GNU GPL, version 2 or above
12 License : GNU GPL, version 2 or above
15 Maintainer : John MacFarlane <jgm@berkeley.edu>
14 Maintainer : John MacFarlane <jgm@berkeley.edu>
@@ -19,8 +18,7 @@
19A utility library with parsers used in pandoc readers.
18A utility library with parsers used in pandoc readers.
22−module Text.Pandoc.Parsing ( take1WhileP,
21+module Text.Pandoc.Parsing ( module Text.Pandoc.Sources,
24 countChar,
22 countChar,
@@ -105,14 +103,14 @@ module Text.Pandoc.Parsing ( take1WhileP,
105 singleQuoteEnd,
103 singleQuoteEnd,
106 doubleQuoteStart,
104 doubleQuoteStart,
107 doubleQuoteEnd,
105 doubleQuoteEnd,
109 apostrophe,
106 apostrophe,
116 Future(..),
114 Future(..),
@@ -123,7 +121,6 @@ module Text.Pandoc.Parsing ( take1WhileP,
124 extractIdClass,
122 extractIdClass,
125 insertIncludedFile,
123 insertIncludedFile,
126− insertIncludedFileF,
127 -- * Re-exports from Text.Parsec
124 -- * Re-exports from Text.Parsec
129 runParser,
126 runParser,
@@ -134,22 +131,10 @@ module Text.Pandoc.Parsing ( take1WhileP,
134 getInput,
131 getInput,
135 setInput,
132 setInput,
136 unexpected,
133 unexpected,
141 skipMany,
134 skipMany,
142 skipMany1,
135 skipMany1,
153 lookAhead,
138 lookAhead,
154 notFollowedBy,
139 notFollowedBy,
@@ -174,6 +159,8 @@ module Text.Pandoc.Parsing ( take1WhileP,
174 SourcePos,
159 SourcePos,
175 getPosition,
160 getPosition,
176 setPosition,
161 setPosition,
177 sourceColumn,
164 sourceColumn,
178 sourceLine,
165 sourceLine,
179 setSourceColumn,
166 setSourceColumn,
@@ -189,48 +176,141 @@ module Text.Pandoc.Parsing ( take1WhileP,
191import Control.Monad.Identity
178import Control.Monad.Identity
192import Control.Monad.Reader
188import Control.Monad.Reader
189+ ( asks, runReader, MonadReader(ask), Reader, ReaderT(ReaderT) )
193−import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper,
190+import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper, isAsciiLower,
194− isPunctuation, isSpace, ord, toLower, toUpper)
191+ isSpace, ord, toLower, toUpper)
195−import Data.Default
192+import Data.Default ( Default(..) )
196import Data.Functor (($>))
193import Data.Functor (($>))
197import Data.List (intercalate, transpose)
194import Data.List (intercalate, transpose)
198import qualified Data.Map as M
195import qualified Data.Map as M
199−import Data.Maybe (mapMaybe, fromMaybe)
196+import Data.Maybe (fromMaybe)
200import qualified Data.Set as Set
197import qualified Data.Set as Set
202import Data.Text (Text)
198import Data.Text (Text)
203import qualified Data.Text as T
199import qualified Data.Text as T
204import Text.HTML.TagSoup.Entity (lookupEntity)
200import Text.HTML.TagSoup.Entity (lookupEntity)
205−import Text.Pandoc.Asciify (toAsciiChar)
201+import Text.Pandoc.Asciify (toAsciiText)
206import Text.Pandoc.Builder (Blocks, HasMeta (..), Inlines, trimInlines)
202import Text.Pandoc.Builder (Blocks, HasMeta (..), Inlines, trimInlines)
207import qualified Text.Pandoc.Builder as B
203import qualified Text.Pandoc.Builder as B
208import Text.Pandoc.Class.PandocMonad (PandocMonad, readFileFromDirs, report)
204import Text.Pandoc.Class.PandocMonad (PandocMonad, readFileFromDirs, report)
209import Text.Pandoc.Definition
205import Text.Pandoc.Definition
210+ ColWidth(ColWidthDefault, ColWidth),
211+ TableFoot(TableFoot),
212+ TableBody(TableBody),
214+ TableHead(TableHead),
218+ ListNumberDelim(..),
220+ ListNumberStyle(..) )
210import Text.Pandoc.Logging
221import Text.Pandoc.Logging
222+ ( LogMessage(CouldNotLoadIncludeFile, DuplicateIdentifier) )
211import Text.Pandoc.Options
223import Text.Pandoc.Options
225+ Extension(Ext_old_dashes, Ext_tex_math_dollars,
226+ Ext_tex_math_single_backslash, Ext_tex_math_double_backslash,
227+ Ext_auto_identifiers, Ext_ascii_identifiers, Ext_smart),
228+ ReaderOptions(readerTabStop, readerColumns, readerExtensions) )
212import Text.Pandoc.Readers.LaTeX.Types (Macro)
229import Text.Pandoc.Readers.LaTeX.Types (Macro)
213import Text.Pandoc.Shared
230import Text.Pandoc.Shared
242+import Text.Pandoc.Sources
214import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
243import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
215import Text.Pandoc.XML (fromEntities)
244import Text.Pandoc.XML (fromEntities)
216−import Text.Parsec hiding (token)
245+import Text.Parsec
217−import Text.Parsec.Pos (initialPos, newPos, updatePosString)
298+import Text.Parsec.Pos (initialPos, newPos)
219−import Control.Monad.Except
299+import Control.Monad.Except ( MonadError(throwError) )
220import Text.Pandoc.Error
300import Text.Pandoc.Error
301+ ( PandocError(PandocParseError, PandocParsecError) )
222type Parser t s = Parsec t s
303type Parser t s = Parsec t s
224type ParserT = ParsecT
305type ParserT = ParsecT
226-- | Reader monad wrapping the parser state. This is used to possibly delay
308-- | Reader monad wrapping the parser state. This is used to possibly delay
227-- evaluation until all relevant information has been parsed and made available
309-- evaluation until all relevant information has been parsed and made available
228-- in the parser state.
310-- in the parser state.
229newtype Future s a = Future { runDelayed :: Reader s a }
311newtype Future s a = Future { runDelayed :: Reader s a }
230 deriving (Monad, Applicative, Functor)
312 deriving (Monad, Applicative, Functor)
232−type F = Future ParserState
234runF :: Future s a -> s -> a
314runF :: Future s a -> s -> a
235runF = runReader . runDelayed
315runF = runReader . runDelayed
@@ -253,70 +333,48 @@ instance (Semigroup a, Monoid a) => Monoid (Future s a) where
253 mappend = (<>)
333 mappend = (<>)
255-- | Like @count@, but packs its result
335-- | Like @count@, but packs its result
256−countChar :: (Stream s m Char, Monad m)
336+countChar :: (Stream s m Char, UpdateSourcePos s Char, Monad m)
258 -> ParsecT s st m Char
338 -> ParsecT s st m Char
259 -> ParsecT s st m Text
339 -> ParsecT s st m Text
260countChar n = fmap T.pack . count n
340countChar n = fmap T.pack . count n
262-- | Like @string@, but uses @Text@.
342-- | Like @string@, but uses @Text@.
343+textStr :: (Stream s m Char, UpdateSourcePos s Char)
263−textStr :: Stream s m Char => Text -> ParsecT s u m Text
344+ => Text -> ParsecT s u m Text
264textStr t = string (T.unpack t) $> t
345textStr t = string (T.unpack t) $> t
266−-- | Parse characters while a predicate is true.
347+
267−take1WhileP :: Monad m
269− -> ParserT Text st m Text
271− -- needed to persuade parsec that this won't match an empty string:
275− let (t, rest) = T.span f inp
279− then updatePosString pos $ T.unpack t
280− else incSourceColumn pos (T.length t)
281− return $ T.singleton c <> t
283−-- Parse n characters of input (or the rest of the input if
284−-- there aren't n characters).
285−takeP :: Monad m => Int -> ParserT Text st m Text
288− -- faster than 'count n anyChar'
291− let (xs, rest) = T.splitAt n inp
292− -- needed to persuade parsec that this won't match an empty string:
295− setPosition $ updatePosString pos $ T.unpack xs
298−-- | Parse any line of text
348+-- | Parse any line of text, returning the contents without the
299−anyLine :: Monad m => ParserT Text st m Text
350+anyLine :: Monad m => ParserT Sources st m Text
300anyLine = do
351anyLine = do
301 -- This is much faster than:
352 -- This is much faster than:
302 -- manyTill anyChar newline
353 -- manyTill anyChar newline
303 inp <- getInput
354 inp <- getInput
304− pos <- getPosition
355+ case inp of
357+ Sources ((fp,t):inps) ->
358+ -- we assume that lines don't span different input files
305− case T.break (=='\n') inp of
359+ case T.break (=='\n') t of
306− (this, T.uncons -> Just ('\n', rest)) -> do
360+ (this, rest)
362+ , not (null inps) ->
363+ -- line may span different input files, so do it
364+ -- character by character
365+ T.pack <$> manyTill anyChar newline
366+ | otherwise -> do -- either end of inputs or newline in rest
367+ setInput $ Sources ((fp, rest):inps)
307− -- needed to persuade parsec that this won't match an empty string:
368+ char '\n' -- needed so parsec knows we won't match empty string
308− anyChar
369+ -- and so source pos is updated
310− setPosition $ incSourceLine (setSourceColumn pos 1) 1
311− return this
370+ return this
314-- | Parse any line, include the final newline in the output
372-- | Parse any line, include the final newline in the output
315−anyLineNewline :: Monad m => ParserT Text st m Text
373+anyLineNewline :: Monad m => ParserT Sources st m Text
316anyLineNewline = (<> "\n") <$> anyLine
374anyLineNewline = (<> "\n") <$> anyLine
318-- | Parse indent by specified number of spaces (or equiv. tabs)
376-- | Parse indent by specified number of spaces (or equiv. tabs)
319−indentWith :: Stream s m Char
377+indentWith :: (Stream s m Char, UpdateSourcePos s Char)
320 => HasReaderOptions st
378 => HasReaderOptions st
321 => Int -> ParserT s st m Text
379 => Int -> ParserT s st m Text
322indentWith num = do
380indentWith num = do
@@ -401,11 +459,13 @@ notFollowedBy' p = try $ join $ do a <- try p
401 return (return ())
459 return (return ())
402-- (This version due to Andrew Pimlott on the Haskell mailing list.)
460-- (This version due to Andrew Pimlott on the Haskell mailing list.)
462+oneOfStrings' :: (Stream s m Char, UpdateSourcePos s Char)
404−oneOfStrings' :: Stream s m Char => (Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
463+ => (Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
405oneOfStrings' f = fmap T.pack . oneOfStrings'' f . fmap T.unpack
464oneOfStrings' f = fmap T.pack . oneOfStrings'' f . fmap T.unpack
407-- TODO: This should be re-implemented in a Text-aware way
466-- TODO: This should be re-implemented in a Text-aware way
467+oneOfStrings'' :: (Stream s m Char, UpdateSourcePos s Char)
408−oneOfStrings'' :: Stream s m Char => (Char -> Char -> Bool) -> [String] -> ParserT s st m String
468+ => (Char -> Char -> Bool) -> [String] -> ParserT s st m String
409oneOfStrings'' _ [] = Prelude.fail "no strings"
469oneOfStrings'' _ [] = Prelude.fail "no strings"
410oneOfStrings'' matches strs = try $ do
470oneOfStrings'' matches strs = try $ do
411 c <- anyChar
471 c <- anyChar
@@ -420,14 +480,16 @@ oneOfStrings'' matches strs = try $ do
420-- | Parses one of a list of strings. If the list contains
480-- | Parses one of a list of strings. If the list contains
421-- two strings one of which is a prefix of the other, the longer
481-- two strings one of which is a prefix of the other, the longer
422-- string will be matched if possible.
482-- string will be matched if possible.
483+oneOfStrings :: (Stream s m Char, UpdateSourcePos s Char)
423−oneOfStrings :: Stream s m Char => [Text] -> ParserT s st m Text
484+ => [Text] -> ParserT s st m Text
424oneOfStrings = oneOfStrings' (==)
485oneOfStrings = oneOfStrings' (==)
426-- | Parses one of a list of strings (tried in order), case insensitive.
487-- | Parses one of a list of strings (tried in order), case insensitive.
428-- TODO: This will not be accurate with general Unicode (neither
489-- TODO: This will not be accurate with general Unicode (neither
429-- Text.toLower nor Text.toCaseFold can be implemented with a map)
490-- Text.toLower nor Text.toCaseFold can be implemented with a map)
491+oneOfStringsCI :: (Stream s m Char, UpdateSourcePos s Char)
430−oneOfStringsCI :: Stream s m Char => [Text] -> ParserT s st m Text
492+ => [Text] -> ParserT s st m Text
431oneOfStringsCI = oneOfStrings' ciMatch
493oneOfStringsCI = oneOfStrings' ciMatch
432 where ciMatch x y = toLower' x == toLower' y
494 where ciMatch x y = toLower' x == toLower' y
433 -- this optimizes toLower by checking common ASCII case
495 -- this optimizes toLower by checking common ASCII case
@@ -438,29 +500,41 @@ oneOfStringsCI = oneOfStrings' ciMatch
438 | otherwise = toLower c
500 | otherwise = toLower c
440-- | Parses a space or tab.
502-- | Parses a space or tab.
503+spaceChar :: (Stream s m Char, UpdateSourcePos s Char)
441−spaceChar :: Stream s m Char => ParserT s st m Char
504+ => ParserT s st m Char
442spaceChar = satisfy $ \c -> c == ' ' || c == '\t'
505spaceChar = satisfy $ \c -> c == ' ' || c == '\t'
444-- | Parses a nonspace, nonnewline character.
507-- | Parses a nonspace, nonnewline character.
445−nonspaceChar :: Stream s m Char => ParserT s st m Char
508+nonspaceChar :: (Stream s m Char, UpdateSourcePos s Char)
509+ => ParserT s st m Char
446−nonspaceChar = noneOf ['\t', '\n', ' ', '\r']
510+nonspaceChar = satisfy (not . isSpaceChar)
512+isSpaceChar :: Char -> Bool
513+isSpaceChar ' ' = True
514+isSpaceChar '\t' = True
515+isSpaceChar '\n' = True
516+isSpaceChar '\r' = True
517+isSpaceChar _ = False
448-- | Skips zero or more spaces or tabs.
519-- | Skips zero or more spaces or tabs.
449−skipSpaces :: Stream s m Char => ParserT s st m ()
520+skipSpaces :: (Stream s m Char, UpdateSourcePos s Char)
521+ => ParserT s st m ()
450skipSpaces = skipMany spaceChar
522skipSpaces = skipMany spaceChar
452-- | Skips zero or more spaces or tabs, then reads a newline.
524-- | Skips zero or more spaces or tabs, then reads a newline.
525+blankline :: (Stream s m Char, UpdateSourcePos s Char)
453−blankline :: Stream s m Char => ParserT s st m Char
526+ => ParserT s st m Char
454blankline = try $ skipSpaces >> newline
527blankline = try $ skipSpaces >> newline
456-- | Parses one or more blank lines and returns a string of newlines.
529-- | Parses one or more blank lines and returns a string of newlines.
530+blanklines :: (Stream s m Char, UpdateSourcePos s Char)
457−blanklines :: Stream s m Char => ParserT s st m Text
531+ => ParserT s st m Text
458blanklines = T.pack <$> many1 blankline
532blanklines = T.pack <$> many1 blankline
460-- | Gobble n spaces; if tabs are encountered, expand them
534-- | Gobble n spaces; if tabs are encountered, expand them
461-- and gobble some or all of their spaces, leaving the rest.
535-- and gobble some or all of their spaces, leaving the rest.
462gobbleSpaces :: (HasReaderOptions st, Monad m)
536gobbleSpaces :: (HasReaderOptions st, Monad m)
463− => Int -> ParserT Text st m ()
537+ => Int -> ParserT Sources st m ()
464gobbleSpaces 0 = return ()
538gobbleSpaces 0 = return ()
465gobbleSpaces n
539gobbleSpaces n
466 | n < 0 = error "gobbleSpaces called with negative number"
540 | n < 0 = error "gobbleSpaces called with negative number"
@@ -468,18 +542,26 @@ gobbleSpaces n
468 char ' ' <|> eatOneSpaceOfTab
542 char ' ' <|> eatOneSpaceOfTab
469 gobbleSpaces (n - 1)
543 gobbleSpaces (n - 1)
471−eatOneSpaceOfTab :: (HasReaderOptions st, Monad m) => ParserT Text st m Char
545+eatOneSpaceOfTab :: (HasReaderOptions st, Monad m) => ParserT Sources st m Char
472eatOneSpaceOfTab = do
546eatOneSpaceOfTab = do
473− char '\t'
547+ lookAhead (char '\t')
474 tabstop <- getOption readerTabStop
549 tabstop <- getOption readerTabStop
550+ -- replace the tab on the input stream with spaces
551+ let numSpaces = tabstop - ((sourceColumn pos - 1) `mod` tabstop)
475 inp <- getInput
552 inp <- getInput
476− setInput $ T.replicate (tabstop - 1) " " <> inp
553+ setInput $
477− return ' '
554+ case inp of
555+ Sources [] -> error "eatOneSpaceOfTab - empty Sources list"
556+ Sources ((fp,t):rest) ->
557+ -- drop the tab and add spaces
558+ Sources ((fp, T.replicate numSpaces " " <> T.drop 1 t):rest)
479-- | Gobble up to n spaces; if tabs are encountered, expand them
561-- | Gobble up to n spaces; if tabs are encountered, expand them
480-- and gobble some or all of their spaces, leaving the rest.
562-- and gobble some or all of their spaces, leaving the rest.
481gobbleAtMostSpaces :: (HasReaderOptions st, Monad m)
563gobbleAtMostSpaces :: (HasReaderOptions st, Monad m)
482− => Int -> ParserT Text st m Int
564+ => Int -> ParserT Sources st m Int
483gobbleAtMostSpaces 0 = return 0
565gobbleAtMostSpaces 0 = return 0
484gobbleAtMostSpaces n
566gobbleAtMostSpaces n
485 | n < 0 = error "gobbleAtMostSpaces called with negative number"
567 | n < 0 = error "gobbleAtMostSpaces called with negative number"
@@ -488,7 +570,8 @@ gobbleAtMostSpaces n
488 (+ 1) <$> gobbleAtMostSpaces (n - 1)
570 (+ 1) <$> gobbleAtMostSpaces (n - 1)
490-- | Parses material enclosed between start and end parsers.
572-- | Parses material enclosed between start and end parsers.
573+enclosed :: (Show end, Stream s m Char, UpdateSourcePos s Char)
491−enclosed :: (Show end, Stream s m Char) => ParserT s st m t -- ^ start parser
574+ => ParserT s st m t -- ^ start parser
492 -> ParserT s st m end -- ^ end parser
575 -> ParserT s st m end -- ^ end parser
493 -> ParserT s st m a -- ^ content parser (to be used repeatedly)
576 -> ParserT s st m a -- ^ content parser (to be used repeatedly)
494 -> ParserT s st m [a]
577 -> ParserT s st m [a]
@@ -496,39 +579,41 @@ enclosed start end parser = try $
496 start >> notFollowedBy space >> many1Till parser end
579 start >> notFollowedBy space >> many1Till parser end
498-- | Parse string, case insensitive.
581-- | Parse string, case insensitive.
582+stringAnyCase :: (Stream s m Char, UpdateSourcePos s Char)
499−stringAnyCase :: Stream s m Char => Text -> ParserT s st m Text
583+ => Text -> ParserT s st m Text
500stringAnyCase = fmap T.pack . stringAnyCase' . T.unpack
584stringAnyCase = fmap T.pack . stringAnyCase' . T.unpack
586+stringAnyCase' :: (Stream s m Char, UpdateSourcePos s Char)
502−stringAnyCase' :: Stream s m Char => String -> ParserT s st m String
587+ => String -> ParserT s st m String
503stringAnyCase' [] = string ""
588stringAnyCase' [] = string ""
504stringAnyCase' (x:xs) = do
589stringAnyCase' (x:xs) = do
505 firstChar <- char (toUpper x) <|> char (toLower x)
590 firstChar <- char (toUpper x) <|> char (toLower x)
506 rest <- stringAnyCase' xs
591 rest <- stringAnyCase' xs
507 return (firstChar:rest)
592 return (firstChar:rest)
594+-- TODO rewrite by just adding to Sources stream?
509-- | Parse contents of 'str' using 'parser' and return result.
595-- | Parse contents of 'str' using 'parser' and return result.
510−parseFromString :: (Stream s m Char, IsString s)
596+parseFromString :: Monad m
511− => ParserT s st m r
597+ => ParserT Sources st m r
513− -> ParserT s st m r
599+ -> ParserT Sources st m r
514parseFromString parser str = do
600parseFromString parser str = do
515 oldPos <- getPosition
601 oldPos <- getPosition
516 setPosition $ initialPos "chunk"
602 setPosition $ initialPos "chunk"
517 oldInput <- getInput
603 oldInput <- getInput
518− setInput $ fromString $ T.unpack str
604+ setInput $ toSources str
519 result <- parser
605 result <- parser
522 setInput oldInput
607 setInput oldInput
523 setPosition oldPos
608 setPosition oldPos
524 return result
609 return result
526-- | Like 'parseFromString' but specialized for 'ParserState'.
611-- | Like 'parseFromString' but specialized for 'ParserState'.
527-- This resets 'stateLastStrPos', which is almost always what we want.
612-- This resets 'stateLastStrPos', which is almost always what we want.
528−parseFromString' :: (Stream s m Char, IsString s, HasLastStrPosition u)
613+parseFromString' :: (Monad m, HasLastStrPosition u)
529− => ParserT s u m a
614+ => ParserT Sources u m a
531− -> ParserT s u m a
616+ -> ParserT Sources u m a
532parseFromString' parser str = do
617parseFromString' parser str = do
533 oldLastStrPos <- getLastStrPos <$> getState
618 oldLastStrPos <- getLastStrPos <$> getState
534 updateState $ setLastStrPos Nothing
619 updateState $ setLastStrPos Nothing
@@ -537,7 +622,7 @@ parseFromString' parser str = do
537 return res
622 return res
539-- | Parse raw line block up to and including blank lines.
624-- | Parse raw line block up to and including blank lines.
540−lineClump :: Monad m => ParserT Text st m Text
625+lineClump :: Monad m => ParserT Sources st m Text
541lineClump = blanklines
626lineClump = blanklines
542 <|> (T.unlines <$> many1 (notFollowedBy blankline >> anyLine))
627 <|> (T.unlines <$> many1 (notFollowedBy blankline >> anyLine))
@@ -546,7 +631,7 @@ lineClump = blanklines
546-- pairs of open and close, which must be different. For example,
631-- pairs of open and close, which must be different. For example,
547-- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"
632-- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"
548-- and return "hello (there)".
633-- and return "hello (there)".
549−charsInBalanced :: Stream s m Char => Char -> Char -> ParserT s st m Char
634+charsInBalanced :: (Stream s m Char, UpdateSourcePos s Char) => Char -> Char -> ParserT s st m Char
550 -> ParserT s st m Text
635 -> ParserT s st m Text
551charsInBalanced open close parser = try $ do
636charsInBalanced open close parser = try $ do
552 char open
637 char open
@@ -565,7 +650,7 @@ charsInBalanced open close parser = try $ do
565-- Auxiliary functions for romanNumeral:
650-- Auxiliary functions for romanNumeral:
567-- | Parses a roman numeral (uppercase or lowercase), returns number.
652-- | Parses a roman numeral (uppercase or lowercase), returns number.
568−romanNumeral :: Stream s m Char => Bool -- ^ Uppercase if true
653+romanNumeral :: (Stream s m Char, UpdateSourcePos s Char) => Bool -- ^ Uppercase if true
569 -> ParserT s st m Int
654 -> ParserT s st m Int
570romanNumeral upperCase = do
655romanNumeral upperCase = do
571 let rchar uc = char $ if upperCase then uc else toLower uc
656 let rchar uc = char $ if upperCase then uc else toLower uc
@@ -601,20 +686,19 @@ romanNumeral upperCase = do
602-- | Parses an email address; returns original and corresponding
687-- | Parses an email address; returns original and corresponding
603-- escaped mailto: URI.
688-- escaped mailto: URI.
604−emailAddress :: Stream s m Char => ParserT s st m (Text, Text)
689+emailAddress :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (Text, Text)
605emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)
690emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)
606 where toResult mbox dom = let full = fromEntities $ T.pack $ mbox ++ '@':dom
691 where toResult mbox dom = let full = fromEntities $ T.pack $ mbox ++ '@':dom
607 in (full, escapeURI $ "mailto:" <> full)
692 in (full, escapeURI $ "mailto:" <> full)
608 mailbox = intercalate "." <$> (emailWord `sepBy1'` dot)
693 mailbox = intercalate "." <$> (emailWord `sepBy1'` dot)
609 domain = intercalate "." <$> (subdomain `sepBy1'` dot)
694 domain = intercalate "." <$> (subdomain `sepBy1'` dot)
610 dot = char '.'
695 dot = char '.'
611− subdomain = many1 $ alphaNum <|> innerPunct
696+ subdomain = many1 $ alphaNum <|> innerPunct (=='-')
612 -- this excludes some valid email addresses, since an
697 -- this excludes some valid email addresses, since an
613 -- email could contain e.g. '__', but gives better results
698 -- email could contain e.g. '__', but gives better results
614 -- for our purposes, when combined with markdown parsing:
699 -- for our purposes, when combined with markdown parsing:
615− innerPunct = try (satisfy (\c -> isEmailPunct c || c == '@')
700+ innerPunct f = try (satisfy f
616− <* notFollowedBy space
701+ <* notFollowedBy (satisfy (not . isAlphaNum)))
617− <* notFollowedBy (satisfy isPunctuation))
618 -- technically an email address could begin with a symbol,
702 -- technically an email address could begin with a symbol,
619 -- but allowing this creates too many problems.
703 -- but allowing this creates too many problems.
620 -- See e.g. https://github.com/jgm/pandoc/issues/2940
704 -- See e.g. https://github.com/jgm/pandoc/issues/2940
@@ -625,16 +709,16 @@ emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)
625 isEmailPunct c = T.any (== c) "!\"#$%&'*+-/=?^_{|}~;"
709 isEmailPunct c = T.any (== c) "!\"#$%&'*+-/=?^_{|}~;"
628−uriScheme :: Stream s m Char => ParserT s st m Text
712+uriScheme :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Text
629uriScheme = oneOfStringsCI (Set.toList schemes)
713uriScheme = oneOfStringsCI (Set.toList schemes)
631-- | Parses a URI. Returns pair of original and URI-escaped version.
715-- | Parses a URI. Returns pair of original and URI-escaped version.
632−uri :: Stream s m Char => ParserT s st m (Text, Text)
716+uri :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (Text, Text)
633uri = try $ do
717uri = try $ do
634 scheme <- uriScheme
718 scheme <- uriScheme
636 -- Avoid parsing e.g. "**Notes:**" as a raw URI:
720 -- Avoid parsing e.g. "**Notes:**" as a raw URI:
637− notFollowedBy (oneOf "*_]")
721+ notFollowedBy $ satisfy (\c -> c == '*' || c == '_' || c == ']')
638 -- We allow sentence punctuation except at the end, since
722 -- We allow sentence punctuation except at the end, since
639 -- we don't want the trailing '.' in 'http://google.com.' We want to allow
723 -- we don't want the trailing '.' in 'http://google.com.' We want to allow
640 -- http://en.wikipedia.org/wiki/State_of_emergency_(disambiguation)
724 -- http://en.wikipedia.org/wiki/State_of_emergency_(disambiguation)
@@ -648,7 +732,20 @@ uri = try $ do
648 let uri' = scheme <> ":" <> fromEntities str'
732 let uri' = scheme <> ":" <> fromEntities str'
649 return (uri', escapeURI uri')
733 return (uri', escapeURI uri')
651− wordChar = alphaNum <|> oneOf "#$%+/@\\_-&="
735+ isWordChar '#' = True
736+ isWordChar '$' = True
737+ isWordChar '%' = True
738+ isWordChar '+' = True
739+ isWordChar '/' = True
740+ isWordChar '@' = True
741+ isWordChar '\\' = True
742+ isWordChar '_' = True
743+ isWordChar '-' = True
744+ isWordChar '&' = True
745+ isWordChar '=' = True
746+ isWordChar c = isAlphaNum c
748+ wordChar = satisfy isWordChar
652 percentEscaped = try $ (:) <$> char '%' <*> many1 hexDigit
749 percentEscaped = try $ (:) <$> char '%' <*> many1 hexDigit
653 entity = try $ pure <$> characterReference
750 entity = try $ pure <$> characterReference
654 punct = try $ many1 (char ',') <|> fmap pure (satisfy (\c -> not (isSpace c) && c /= '<' && c /= '>'))
751 punct = try $ many1 (char ',') <|> fmap pure (satisfy (\c -> not (isSpace c) && c /= '<' && c /= '>'))
@@ -659,11 +756,13 @@ uri = try $ do
659 uriChunkBetween l r = try $ do chunk <- between (char l) (char r) uriChunk
756 uriChunkBetween l r = try $ do chunk <- between (char l) (char r) uriChunk
660 return (T.pack $ [l] ++ chunk ++ [r])
757 return (T.pack $ [l] ++ chunk ++ [r])
662−mathInlineWith :: Stream s m Char => Text -> Text -> ParserT s st m Text
759+mathInlineWith :: (Stream s m Char, UpdateSourcePos s Char) => Text -> Text -> ParserT s st m Text
663mathInlineWith op cl = try $ do
760mathInlineWith op cl = try $ do
664 textStr op
761 textStr op
665 when (op == "$") $ notFollowedBy space
762 when (op == "$") $ notFollowedBy space
666− words' <- many1Till (countChar 1 (noneOf " \t\n\\")
763+ words' <- many1Till (
765+ satisfy (\c -> not (isSpaceChar c || c == '\\')))
667 <|> (char '\\' >>
766 <|> (char '\\' >>
668 -- This next clause is needed because \text{..} can
767 -- This next clause is needed because \text{..} can
669 -- contain $, \(\), etc.
768 -- contain $, \(\), etc.
@@ -671,17 +770,17 @@ mathInlineWith op cl = try $ do
671 (("\\text" <>) <$> inBalancedBraces 0 ""))
770 (("\\text" <>) <$> inBalancedBraces 0 ""))
672 <|> (\c -> T.pack ['\\',c]) <$> anyChar))
771 <|> (\c -> T.pack ['\\',c]) <$> anyChar))
673 <|> do (blankline <* notFollowedBy' blankline) <|>
772 <|> do (blankline <* notFollowedBy' blankline) <|>
674− (oneOf " \t" <* skipMany (oneOf " \t"))
773+ (spaceChar <* skipMany spaceChar)
675 notFollowedBy (char '$')
774 notFollowedBy (char '$')
676 return " "
775 return " "
677 ) (try $ textStr cl)
776 ) (try $ textStr cl)
678 notFollowedBy digit -- to prevent capture of $5
777 notFollowedBy digit -- to prevent capture of $5
679 return $ trimMath $ T.concat words'
778 return $ trimMath $ T.concat words'
681− inBalancedBraces :: Stream s m Char => Int -> Text -> ParserT s st m Text
780+ inBalancedBraces :: (Stream s m Char, UpdateSourcePos s Char) => Int -> Text -> ParserT s st m Text
682 inBalancedBraces n = fmap T.pack . inBalancedBraces' n . T.unpack
781 inBalancedBraces n = fmap T.pack . inBalancedBraces' n . T.unpack
684− inBalancedBraces' :: Stream s m Char => Int -> String -> ParserT s st m String
783+ inBalancedBraces' :: (Stream s m Char, UpdateSourcePos s Char) => Int -> String -> ParserT s st m String
685 inBalancedBraces' 0 "" = do
784 inBalancedBraces' 0 "" = do
686 c <- anyChar
785 c <- anyChar
687 if c == '{'
786 if c == '{'
@@ -698,12 +797,13 @@ mathInlineWith op cl = try $ do
698 '{' -> inBalancedBraces' (numOpen + 1) (c:xs)
797 '{' -> inBalancedBraces' (numOpen + 1) (c:xs)
699 _ -> inBalancedBraces' numOpen (c:xs)
798 _ -> inBalancedBraces' numOpen (c:xs)
701−mathDisplayWith :: Stream s m Char => Text -> Text -> ParserT s st m Text
800+mathDisplayWith :: (Stream s m Char, UpdateSourcePos s Char) => Text -> Text -> ParserT s st m Text
702mathDisplayWith op cl = try $ fmap T.pack $ do
801mathDisplayWith op cl = try $ fmap T.pack $ do
703 textStr op
802 textStr op
704− many1Till (noneOf "\n" <|> (newline <* notFollowedBy' blankline)) (try $ textStr cl)
803+ many1Till (satisfy (/= '\n') <|> (newline <* notFollowedBy' blankline))
706−mathDisplay :: (HasReaderOptions st, Stream s m Char)
806+mathDisplay :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
707 => ParserT s st m Text
807 => ParserT s st m Text
708mathDisplay =
808mathDisplay =
709 (guardEnabled Ext_tex_math_dollars >> mathDisplayWith "$$" "$$")
809 (guardEnabled Ext_tex_math_dollars >> mathDisplayWith "$$" "$$")
@@ -712,7 +812,7 @@ mathDisplay =
712 <|> (guardEnabled Ext_tex_math_double_backslash >>
812 <|> (guardEnabled Ext_tex_math_double_backslash >>
713 mathDisplayWith "\\\\[" "\\\\]")
813 mathDisplayWith "\\\\[" "\\\\]")
715−mathInline :: (HasReaderOptions st , Stream s m Char)
815+mathInline :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
716 => ParserT s st m Text
816 => ParserT s st m Text
717mathInline =
817mathInline =
718 (guardEnabled Ext_tex_math_dollars >> mathInlineWith "$" "$")
818 (guardEnabled Ext_tex_math_dollars >> mathInlineWith "$" "$")
@@ -725,7 +825,7 @@ mathInline =
725-- displacement (the difference between the source column at the end
825-- displacement (the difference between the source column at the end
726-- and the source column at the beginning). Vertical displacement
826-- and the source column at the beginning). Vertical displacement
727-- (source row) is ignored.
827-- (source row) is ignored.
728−withHorizDisplacement :: Stream s m Char
828+withHorizDisplacement :: (Stream s m Char, UpdateSourcePos s Char)
729 => ParserT s st m a -- ^ Parser to apply
829 => ParserT s st m a -- ^ Parser to apply
730 -> ParserT s st m (a, Int) -- ^ (result, displacement)
830 -> ParserT s st m (a, Int) -- ^ (result, displacement)
731withHorizDisplacement parser = do
831withHorizDisplacement parser = do
@@ -737,30 +837,37 @@ withHorizDisplacement parser = do
737-- | Applies a parser and returns the raw string that was parsed,
837-- | Applies a parser and returns the raw string that was parsed,
738-- along with the value produced by the parser.
838-- along with the value produced by the parser.
739withRaw :: Monad m
839withRaw :: Monad m
740− => ParsecT Text st m a
840+ => ParsecT Sources st m a
741− -> ParsecT Text st m (a, Text)
841+ -> ParsecT Sources st m (a, Text)
742withRaw parser = do
842withRaw parser = do
744− inp <- getInput
843+ inps1 <- getInput
745 result <- parser
844 result <- parser
746− pos2 <- getPosition
845+ inps2 <- getInput
747− let (l1,c1) = (sourceLine pos1, sourceColumn pos1)
846+ -- 'raw' is the difference between inps1 and inps2
748− let (l2,c2) = (sourceLine pos2, sourceColumn pos2)
847+ return (result, sourcesDifference inps1 inps2)
749− let inplines = take ((l2 - l1) + 1) $ T.lines inp
848+
750− let raw = case inplines of
849+sourcesDifference :: Sources -> Sources -> Text
850+sourcesDifference (Sources is1) (Sources is2) = go is1 is2
853+ case (inps1, inps2) of
751− [] -> ""
854+ ([], _) -> mempty
752− [l] -> T.take (c2 - c1) l
855+ (_, []) -> mconcat $ map snd inps1
753− ls -> T.unlines (init ls) <> T.take (c2 - 1) (last ls)
856+ ((p1,t1):rest1, (p2, t2):rest2)
754− return (result, raw)
857+ | p1 == p2
858+ , t1 == t2 -> go rest1 rest2
860+ , t1 /= t2 -> fromMaybe mempty $ T.stripSuffix t2 t1
861+ | otherwise -> t1 <> go rest1 inps2
756-- | Parses backslash, then applies character parser.
863-- | Parses backslash, then applies character parser.
757−escaped :: Stream s m Char
864+escaped :: (Stream s m Char, UpdateSourcePos s Char)
758 => ParserT s st m Char -- ^ Parser for character to escape
865 => ParserT s st m Char -- ^ Parser for character to escape
759 -> ParserT s st m Char
866 -> ParserT s st m Char
760escaped parser = try $ char '\\' >> parser
867escaped parser = try $ char '\\' >> parser
762-- | Parse character entity.
869-- | Parse character entity.
763−characterReference :: Stream s m Char => ParserT s st m Char
870+characterReference :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Char
764characterReference = try $ do
871characterReference = try $ do
766 ent <- many1Till nonspaceChar (char ';')
873 ent <- many1Till nonspaceChar (char ';')
@@ -773,19 +880,19 @@ characterReference = try $ do
773 _ -> Prelude.fail "entity not found"
880 _ -> Prelude.fail "entity not found"
775-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
882-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
776−upperRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
883+upperRoman :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (ListNumberStyle, Int)
777upperRoman = do
884upperRoman = do
778 num <- romanNumeral True
885 num <- romanNumeral True
779 return (UpperRoman, num)
886 return (UpperRoman, num)
781-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
888-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
782−lowerRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
889+lowerRoman :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (ListNumberStyle, Int)
783lowerRoman = do
890lowerRoman = do
784 num <- romanNumeral False
891 num <- romanNumeral False
785 return (LowerRoman, num)
892 return (LowerRoman, num)
787-- | Parses a decimal numeral and returns (Decimal, number).
894-- | Parses a decimal numeral and returns (Decimal, number).
788−decimal :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
895+decimal :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (ListNumberStyle, Int)
789decimal = do
896decimal = do
790 num <- many1 digit
897 num <- many1 digit
791 return (Decimal, fromMaybe 1 $ safeRead $ T.pack num)
898 return (Decimal, fromMaybe 1 $ safeRead $ T.pack num)
@@ -794,7 +901,7 @@ decimal = do
794-- returns (DefaultStyle, [next example number]). The next
901-- returns (DefaultStyle, [next example number]). The next
795-- example number is incremented in parser state, and the label
902-- example number is incremented in parser state, and the label
796-- (if present) is added to the label table.
903-- (if present) is added to the label table.
797−exampleNum :: Stream s m Char
904+exampleNum :: (Stream s m Char, UpdateSourcePos s Char)
798 => ParserT s ParserState m (ListNumberStyle, Int)
905 => ParserT s ParserState m (ListNumberStyle, Int)
799exampleNum = do
906exampleNum = do
@@ -813,37 +920,37 @@ exampleNum = do
813 return (Example, num)
920 return (Example, num)
815-- | Parses a '#' returns (DefaultStyle, 1).
922-- | Parses a '#' returns (DefaultStyle, 1).
816−defaultNum :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
923+defaultNum :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (ListNumberStyle, Int)
817defaultNum = do
924defaultNum = do
819 return (DefaultStyle, 1)
926 return (DefaultStyle, 1)
821-- | Parses a lowercase letter and returns (LowerAlpha, number).
928-- | Parses a lowercase letter and returns (LowerAlpha, number).
822−lowerAlpha :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
929+lowerAlpha :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (ListNumberStyle, Int)
823lowerAlpha = do
930lowerAlpha = do
824− ch <- oneOf ['a'..'z']
931+ ch <- satisfy isAsciiLower
825 return (LowerAlpha, ord ch - ord 'a' + 1)
932 return (LowerAlpha, ord ch - ord 'a' + 1)
827-- | Parses an uppercase letter and returns (UpperAlpha, number).
934-- | Parses an uppercase letter and returns (UpperAlpha, number).
828−upperAlpha :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
935+upperAlpha :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (ListNumberStyle, Int)
829upperAlpha = do
936upperAlpha = do
830− ch <- oneOf ['A'..'Z']
937+ ch <- satisfy isAsciiUpper
831 return (UpperAlpha, ord ch - ord 'A' + 1)
938 return (UpperAlpha, ord ch - ord 'A' + 1)
833-- | Parses a roman numeral i or I
940-- | Parses a roman numeral i or I
834−romanOne :: Stream s m Char => ParserT s st m (ListNumberStyle, Int)
941+romanOne :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m (ListNumberStyle, Int)
835romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
942romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
836 (char 'I' >> return (UpperRoman, 1))
943 (char 'I' >> return (UpperRoman, 1))
838-- | Parses an ordered list marker and returns list attributes.
945-- | Parses an ordered list marker and returns list attributes.
839−anyOrderedListMarker :: Stream s m Char => ParserT s ParserState m ListAttributes
946+anyOrderedListMarker :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s ParserState m ListAttributes
840anyOrderedListMarker = choice
947anyOrderedListMarker = choice
841 [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
948 [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
842 numParser <- [decimal, exampleNum, defaultNum, romanOne,
949 numParser <- [decimal, exampleNum, defaultNum, romanOne,
843 lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
950 lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
845-- | Parses a list number (num) followed by a period, returns list attributes.
952-- | Parses a list number (num) followed by a period, returns list attributes.
846−inPeriod :: Stream s m Char
953+inPeriod :: (Stream s m Char, UpdateSourcePos s Char)
847 => ParserT s st m (ListNumberStyle, Int)
954 => ParserT s st m (ListNumberStyle, Int)
848 -> ParserT s st m ListAttributes
955 -> ParserT s st m ListAttributes
849inPeriod num = try $ do
956inPeriod num = try $ do
@@ -855,7 +962,7 @@ inPeriod num = try $ do
855 return (start, style, delim)
962 return (start, style, delim)
857-- | Parses a list number (num) followed by a paren, returns list attributes.
964-- | Parses a list number (num) followed by a paren, returns list attributes.
858−inOneParen :: Stream s m Char
965+inOneParen :: (Stream s m Char, UpdateSourcePos s Char)
859 => ParserT s st m (ListNumberStyle, Int)
966 => ParserT s st m (ListNumberStyle, Int)
860 -> ParserT s st m ListAttributes
967 -> ParserT s st m ListAttributes
861inOneParen num = try $ do
968inOneParen num = try $ do
@@ -864,7 +971,7 @@ inOneParen num = try $ do
864 return (start, style, OneParen)
971 return (start, style, OneParen)
866-- | Parses a list number (num) enclosed in parens, returns list attributes.
973-- | Parses a list number (num) enclosed in parens, returns list attributes.
867−inTwoParens :: Stream s m Char
974+inTwoParens :: (Stream s m Char, UpdateSourcePos s Char)
868 => ParserT s st m (ListNumberStyle, Int)
975 => ParserT s st m (ListNumberStyle, Int)
869 -> ParserT s st m ListAttributes
976 -> ParserT s st m ListAttributes
870inTwoParens num = try $ do
977inTwoParens num = try $ do
@@ -875,7 +982,7 @@ inTwoParens num = try $ do
876-- | Parses an ordered list marker with a given style and delimiter,
983-- | Parses an ordered list marker with a given style and delimiter,
877-- returns number.
984-- returns number.
878−orderedListMarker :: Stream s m Char
985+orderedListMarker :: (Stream s m Char, UpdateSourcePos s Char)
879 => ListNumberStyle
986 => ListNumberStyle
880 -> ListNumberDelim
987 -> ListNumberDelim
881 -> ParserT s ParserState m Int
988 -> ParserT s ParserState m Int
@@ -898,10 +1005,10 @@ orderedListMarker style delim = do
898 return start
1005 return start
900-- | Parses a character reference and returns a Str element.
1007-- | Parses a character reference and returns a Str element.
901−charRef :: Stream s m Char => ParserT s st m Inline
1008+charRef :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Inline
902charRef = Str . T.singleton <$> characterReference
1009charRef = Str . T.singleton <$> characterReference
904−lineBlockLine :: Monad m => ParserT Text st m Text
1011+lineBlockLine :: Monad m => ParserT Sources st m Text
905lineBlockLine = try $ do
1012lineBlockLine = try $ do
906 char '|'
1013 char '|'
907 char ' '
1014 char ' '
@@ -911,11 +1018,11 @@ lineBlockLine = try $ do
911 continuations <- many (try $ char ' ' >> anyLine)
1018 continuations <- many (try $ char ' ' >> anyLine)
912 return $ white <> T.unwords (line : continuations)
1019 return $ white <> T.unwords (line : continuations)
914−blankLineBlockLine :: Stream s m Char => ParserT s st m Char
1021+blankLineBlockLine :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Char
915blankLineBlockLine = try (char '|' >> blankline)
1022blankLineBlockLine = try (char '|' >> blankline)
917-- | Parses an RST-style line block and returns a list of strings.
1024-- | Parses an RST-style line block and returns a list of strings.
918−lineBlockLines :: Monad m => ParserT Text st m [Text]
1025+lineBlockLines :: Monad m => ParserT Sources st m [Text]
919lineBlockLines = try $ do
1026lineBlockLines = try $ do
920 lines' <- many1 (lineBlockLine <|> (T.singleton <$> blankLineBlockLine))
1027 lines' <- many1 (lineBlockLine <|> (T.singleton <$> blankLineBlockLine))
921 skipMany blankline
1028 skipMany blankline
@@ -923,7 +1030,8 @@ lineBlockLines = try $ do
924-- | Parse a table using 'headerParser', 'rowParser',
1031-- | Parse a table using 'headerParser', 'rowParser',
925-- 'lineParser', and 'footerParser'.
1032-- 'lineParser', and 'footerParser'.
1033+tableWith :: (Stream s m Char, UpdateSourcePos s Char,
926−tableWith :: (Stream s m Char, HasReaderOptions st, Monad mf)
1034+ HasReaderOptions st, Monad mf)
927 => ParserT s st m (mf [Blocks], [Alignment], [Int])
1035 => ParserT s st m (mf [Blocks], [Alignment], [Int])
928 -> ([Int] -> ParserT s st m (mf [Blocks]))
1036 -> ([Int] -> ParserT s st m (mf [Blocks]))
929 -> ParserT s st m sep
1037 -> ParserT s st m sep
@@ -943,7 +1051,8 @@ tableWith headerParser rowParser lineParser footerParser = try $ do
944type TableComponents mf = ([Alignment], [Double], mf [Row], mf [Row])
1052type TableComponents mf = ([Alignment], [Double], mf [Row], mf [Row])
1054+tableWith' :: (Stream s m Char, UpdateSourcePos s Char,
946−tableWith' :: (Stream s m Char, HasReaderOptions st, Monad mf)
1055+ HasReaderOptions st, Monad mf)
947 => ParserT s st m (mf [Blocks], [Alignment], [Int])
1056 => ParserT s st m (mf [Blocks], [Alignment], [Int])
948 -> ([Int] -> ParserT s st m (mf [Blocks]))
1057 -> ([Int] -> ParserT s st m (mf [Blocks]))
949 -> ParserT s st m sep
1058 -> ParserT s st m sep
@@ -992,20 +1101,19 @@ widthsFromIndices numColumns' indices =
992-- (which may be grid), then the rows,
1101-- (which may be grid), then the rows,
993-- which may be grid, separated by blank lines, and
1102-- which may be grid, separated by blank lines, and
994-- ending with a footer (dashed line followed by blank line).
1103-- ending with a footer (dashed line followed by blank line).
995−gridTableWith :: (Stream s m Char, HasReaderOptions st, HasLastStrPosition st,
1104+gridTableWith :: (Monad m, HasReaderOptions st, HasLastStrPosition st, Monad mf)
996− Monad mf, IsString s)
997− => ParserT s st m (mf Blocks) -- ^ Block list parser
1105+ => ParserT Sources st m (mf Blocks) -- ^ Block list parser
998 -> Bool -- ^ Headerless table
1106 -> Bool -- ^ Headerless table
999− -> ParserT s st m (mf Blocks)
1107+ -> ParserT Sources st m (mf Blocks)
1000gridTableWith blocks headless =
1108gridTableWith blocks headless =
1001 tableWith (gridTableHeader headless blocks) (gridTableRow blocks)
1109 tableWith (gridTableHeader headless blocks) (gridTableRow blocks)
1002 (gridTableSep '-') gridTableFooter
1110 (gridTableSep '-') gridTableFooter
1004−gridTableWith' :: (Stream s m Char, HasReaderOptions st, HasLastStrPosition st,
1112+gridTableWith' :: (Monad m, HasReaderOptions st, HasLastStrPosition st,
1005− Monad mf, IsString s)
1113+ Monad mf)
1006− => ParserT s st m (mf Blocks) -- ^ Block list parser
1114+ => ParserT Sources st m (mf Blocks) -- ^ Block list parser
1007 -> Bool -- ^ Headerless table
1115 -> Bool -- ^ Headerless table
1008− -> ParserT s st m (TableComponents mf)
1116+ -> ParserT Sources st m (TableComponents mf)
1009gridTableWith' blocks headless =
1117gridTableWith' blocks headless =
1010 tableWith' (gridTableHeader headless blocks) (gridTableRow blocks)
1118 tableWith' (gridTableHeader headless blocks) (gridTableRow blocks)
1011 (gridTableSep '-') gridTableFooter
1119 (gridTableSep '-') gridTableFooter
@@ -1014,7 +1122,7 @@ gridTableSplitLine :: [Int] -> Text -> [Text]
1014gridTableSplitLine indices line = map removeFinalBar $ tail $
1122gridTableSplitLine indices line = map removeFinalBar $ tail $
1015 splitTextByIndices (init indices) $ trimr line
1123 splitTextByIndices (init indices) $ trimr line
1017−gridPart :: Stream s m Char => Char -> ParserT s st m ((Int, Int), Alignment)
1125+gridPart :: Monad m => Char -> ParserT Sources st m ((Int, Int), Alignment)
1018gridPart ch = do
1126gridPart ch = do
1019 leftColon <- option False (True <$ char ':')
1127 leftColon <- option False (True <$ char ':')
1020 dashes <- many1 (char ch)
1128 dashes <- many1 (char ch)
@@ -1029,7 +1137,7 @@ gridPart ch = do
1029 (False, False) -> AlignDefault
1137 (False, False) -> AlignDefault
1030 return ((lengthDashes, lengthDashes + 1), alignment)
1138 return ((lengthDashes, lengthDashes + 1), alignment)
1032−gridDashedLines :: Stream s m Char => Char -> ParserT s st m [((Int, Int), Alignment)]
1140+gridDashedLines :: Monad m => Char -> ParserT Sources st m [((Int, Int), Alignment)]
1033gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
1141gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
1035removeFinalBar :: Text -> Text
1143removeFinalBar :: Text -> Text
@@ -1038,47 +1146,47 @@ removeFinalBar = T.dropWhileEnd go . T.dropWhileEnd (=='|')
1038 go c = T.any (== c) " \t"
1146 go c = T.any (== c) " \t"
1040-- | Separator between rows of grid table.
1148-- | Separator between rows of grid table.
1041−gridTableSep :: Stream s m Char => Char -> ParserT s st m Char
1149+gridTableSep :: Monad m => Char -> ParserT Sources st m Char
1042gridTableSep ch = try $ gridDashedLines ch >> return '\n'
1150gridTableSep ch = try $ gridDashedLines ch >> return '\n'
1044-- | Parse header for a grid table.
1152-- | Parse header for a grid table.
1045−gridTableHeader :: (Stream s m Char, Monad mf, IsString s, HasLastStrPosition st)
1153+gridTableHeader :: (Monad m, Monad mf, HasLastStrPosition st)
1046 => Bool -- ^ Headerless table
1154 => Bool -- ^ Headerless table
1047− -> ParserT s st m (mf Blocks)
1155+ -> ParserT Sources st m (mf Blocks)
1048− -> ParserT s st m (mf [Blocks], [Alignment], [Int])
1156+ -> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
1049−gridTableHeader headless blocks = try $ do
1157+gridTableHeader True _ = do
1158+ optional blanklines
1159+ dashes <- gridDashedLines '-'
1160+ let aligns = map snd dashes
1161+ let lines' = map (snd . fst) dashes
1162+ let indices = scanl (+) 0 lines'
1163+ return (return [], aligns, indices)
1164+gridTableHeader False blocks = try $ do
1050 optional blanklines
1165 optional blanklines
1051 dashes <- gridDashedLines '-'
1166 dashes <- gridDashedLines '-'
1052− rawContent <- if headless
1053− then return $ repeat ""
1055− (notFollowedBy (gridTableSep '=') >> char '|' >>
1167+ rawContent <- many1 (notFollowedBy (gridTableSep '=') >> char '|' >>
1056 T.pack <$> many1Till anyChar newline)
1168 T.pack <$> many1Till anyChar newline)
1057− underDashes <- if headless
1059− else gridDashedLines '='
1169+ underDashes <- gridDashedLines '='
1060 guard $ length dashes == length underDashes
1170 guard $ length dashes == length underDashes
1061 let lines' = map (snd . fst) underDashes
1171 let lines' = map (snd . fst) underDashes
1062 let indices = scanl (+) 0 lines'
1172 let indices = scanl (+) 0 lines'
1063 let aligns = map snd underDashes
1173 let aligns = map snd underDashes
1064− let rawHeads = if headless
1065− then replicate (length underDashes) ""
1066− else map (T.unlines . map trim) $ transpose
1174+ let rawHeads = map (T.unlines . map trim) $ transpose
1067 $ map (gridTableSplitLine indices) rawContent
1175 $ map (gridTableSplitLine indices) rawContent
1068 heads <- sequence <$> mapM (parseFromString' blocks . trim) rawHeads
1176 heads <- sequence <$> mapM (parseFromString' blocks . trim) rawHeads
1069 return (heads, aligns, indices)
1177 return (heads, aligns, indices)
1071−gridTableRawLine :: Stream s m Char => [Int] -> ParserT s st m [Text]
1179+gridTableRawLine :: (Stream s m Char, UpdateSourcePos s Char) => [Int] -> ParserT s st m [Text]
1072gridTableRawLine indices = do
1180gridTableRawLine indices = do
1073 char '|'
1181 char '|'
1074 line <- many1Till anyChar newline
1182 line <- many1Till anyChar newline
1075 return (gridTableSplitLine indices $ T.pack line)
1183 return (gridTableSplitLine indices $ T.pack line)
1077-- | Parse row of grid table.
1185-- | Parse row of grid table.
1078−gridTableRow :: (Stream s m Char, Monad mf, IsString s, HasLastStrPosition st)
1186+gridTableRow :: (Monad m, Monad mf, HasLastStrPosition st)
1079− => ParserT s st m (mf Blocks)
1187+ => ParserT Sources st m (mf Blocks)
1080 -> [Int]
1188 -> [Int]
1081− -> ParserT s st m (mf [Blocks])
1189+ -> ParserT Sources st m (mf [Blocks])
1082gridTableRow blocks indices = do
1190gridTableRow blocks indices = do
1083 colLines <- many1 (gridTableRawLine indices)
1191 colLines <- many1 (gridTableRawLine indices)
1084 let cols = map ((<> "\n") . T.unlines . removeOneLeadingSpace) $
1192 let cols = map ((<> "\n") . T.unlines . removeOneLeadingSpace) $
@@ -1099,34 +1207,38 @@ removeOneLeadingSpace xs =
1099 Just (c, _) -> c == ' '
1207 Just (c, _) -> c == ' '
1101-- | Parse footer for a grid table.
1209-- | Parse footer for a grid table.
1102−gridTableFooter :: Stream s m Char => ParserT s st m ()
1210+gridTableFooter :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m ()
1103gridTableFooter = optional blanklines
1211gridTableFooter = optional blanklines
1107-- | Removes the ParsecT layer from the monad transformer stack
1215-- | Removes the ParsecT layer from the monad transformer stack
1108−readWithM :: (Stream s m Char, ToText s)
1216+readWithM :: (Monad m, ToSources t)
1109− => ParserT s st m a -- ^ parser
1217+ => ParserT Sources st m a -- ^ parser
1110− -> st -- ^ initial state
1218+ -> st -- ^ initial state
1111− -> s -- ^ input
1219+ -> t -- ^ input
1112 -> m (Either PandocError a)
1220 -> m (Either PandocError a)
1113readWithM parser state input =
1221readWithM parser state input =
1114− mapLeft (PandocParsecError $ toText input) `liftM` runParserT parser state "source" input
1222+ mapLeft (PandocParsecError sources)
1223+ <$> runParserT parser state (initialSourceName sources) sources
1225+ sources = toSources input
1116-- | Parse a string with a given parser and state
1227-- | Parse a string with a given parser and state
1228+readWith :: ToSources t
1117−readWith :: Parser Text st a
1229+ => Parser Sources st a
1120 -> Either PandocError a
1232 -> Either PandocError a
1121readWith p t inp = runIdentity $ readWithM p t inp
1233readWith p t inp = runIdentity $ readWithM p t inp
1123-- | Parse a string with @parser@ (for testing).
1235-- | Parse a string with @parser@ (for testing).
1124testStringWith :: Show a
1236testStringWith :: Show a
1125− => ParserT Text ParserState Identity a
1237+ => ParserT Sources ParserState Identity a
1127 -> IO ()
1239 -> IO ()
1128−testStringWith parser str = UTF8.putStrLn $ show $
1240+testStringWith parser str = UTF8.putStrLn $ tshow $
1129− readWith parser defaultParserState str
1241+ readWith parser defaultParserState (toSources str)
1131-- | Parsing options.
1243-- | Parsing options.
1132data ParserState = ParserState
1244data ParserState = ParserState
@@ -1146,7 +1258,7 @@ data ParserState = ParserState
1146 stateInNote :: Bool, -- ^ True if parsing note contents
1258 stateInNote :: Bool, -- ^ True if parsing note contents
1147 stateNoteNumber :: Int, -- ^ Last note number for citations
1259 stateNoteNumber :: Int, -- ^ Last note number for citations
1148 stateMeta :: Meta, -- ^ Document metadata
1260 stateMeta :: Meta, -- ^ Document metadata
1149− stateMeta' :: F Meta, -- ^ Document metadata
1261+ stateMeta' :: Future ParserState Meta, -- ^ Document metadata
1150 stateCitations :: M.Map Text Text, -- ^ RST-style citations
1262 stateCitations :: M.Map Text Text, -- ^ RST-style citations
1151 stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
1263 stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
1152 stateIdentifiers :: Set.Set Text, -- ^ Header identifiers used
1264 stateIdentifiers :: Set.Set Text, -- ^ Header identifiers used
@@ -1325,7 +1437,7 @@ data QuoteContext
1326type NoteTable = [(Text, Text)]
1438type NoteTable = [(Text, Text)]
1328−type NoteTable' = M.Map Text (SourcePos, F Blocks)
1440+type NoteTable' = M.Map Text (SourcePos, Future ParserState Blocks)
1329-- used in markdown reader
1441-- used in markdown reader
1331newtype Key = Key Text deriving (Show, Read, Eq, Ord)
1443newtype Key = Key Text deriving (Show, Read, Eq, Ord)
@@ -1360,7 +1472,7 @@ registerHeader (ident,classes,kvs) header' = do
1361 let id' = uniqueIdent exts (B.toList header') ids
1473 let id' = uniqueIdent exts (B.toList header') ids
1362 let id'' = if Ext_ascii_identifiers `extensionEnabled` exts
1474 let id'' = if Ext_ascii_identifiers `extensionEnabled` exts
1363− then T.pack $ mapMaybe toAsciiChar $ T.unpack id'
1475+ then toAsciiText id'
1364 else id'
1476 else id'
1365 updateState $ updateIdentifierList $ Set.insert id'
1477 updateState $ updateIdentifierList $ Set.insert id'
1366 updateState $ updateIdentifierList $ Set.insert id''
1478 updateState $ updateIdentifierList $ Set.insert id''
@@ -1373,34 +1485,42 @@ registerHeader (ident,classes,kvs) header' = do
1373 updateState $ updateIdentifierList $ Set.insert ident
1485 updateState $ updateIdentifierList $ Set.insert ident
1374 return (ident,classes,kvs)
1486 return (ident,classes,kvs)
1376−smartPunctuation :: (HasReaderOptions st, HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
1488+smartPunctuation :: (HasReaderOptions st, HasLastStrPosition st,
1489+ HasQuoteContext st m,
1490+ Stream s m Char, UpdateSourcePos s Char)
1377 => ParserT s st m Inlines
1491 => ParserT s st m Inlines
1378 -> ParserT s st m Inlines
1492 -> ParserT s st m Inlines
1379smartPunctuation inlineParser = do
1493smartPunctuation inlineParser = do
1380 guardEnabled Ext_smart
1494 guardEnabled Ext_smart
1381− choice [ quoted inlineParser, apostrophe, dash, ellipses ]
1495+ choice [ quoted inlineParser, apostrophe, doubleCloseQuote, dash, ellipses ]
1383−apostrophe :: Stream s m Char => ParserT s st m Inlines
1384−apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\x2019")
1386−quoted :: (HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
1497+quoted :: (HasLastStrPosition st, HasQuoteContext st m,
1498+ Stream s m Char, UpdateSourcePos s Char)
1387 => ParserT s st m Inlines
1499 => ParserT s st m Inlines
1388 -> ParserT s st m Inlines
1500 -> ParserT s st m Inlines
1389quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
1501quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
1391−singleQuoted :: (HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
1503+singleQuoted :: (HasLastStrPosition st, HasQuoteContext st m,
1504+ Stream s m Char, UpdateSourcePos s Char)
1392 => ParserT s st m Inlines
1505 => ParserT s st m Inlines
1393 -> ParserT s st m Inlines
1506 -> ParserT s st m Inlines
1394−singleQuoted inlineParser = try $ B.singleQuoted . mconcat
1507+singleQuoted inlineParser = do
1395− <$ singleQuoteStart
1508+ singleQuoteStart
1509+ (B.singleQuoted . mconcat <$>
1396− <*> withQuoteContext InSingleQuote (many1Till inlineParser singleQuoteEnd)
1511+ (withQuoteContext InSingleQuote (many1Till inlineParser singleQuoteEnd)))
1397−
1512+ <|> pure "\8217"
1398−doubleQuoted :: (HasQuoteContext st m, Stream s m Char)
1514+doubleQuoted :: (HasQuoteContext st m, HasLastStrPosition st,
1515+ Stream s m Char, UpdateSourcePos s Char)
1399 => ParserT s st m Inlines
1516 => ParserT s st m Inlines
1400 -> ParserT s st m Inlines
1517 -> ParserT s st m Inlines
1401−doubleQuoted inlineParser = try $ B.doubleQuoted . mconcat
1518+doubleQuoted inlineParser = do
1402− <$ doubleQuoteStart
1519+ doubleQuoteStart
1520+ (B.doubleQuoted . mconcat <$>
1403− <*> withQuoteContext InDoubleQuote (manyTill inlineParser doubleQuoteEnd)
1522+ (withQuoteContext InDoubleQuote (manyTill inlineParser doubleQuoteEnd)))
1523+ <|> pure (B.str "\8220")
1405failIfInQuoteContext :: (HasQuoteContext st m, Stream s m t)
1525failIfInQuoteContext :: (HasQuoteContext st m, Stream s m t)
1406 => QuoteContext
1526 => QuoteContext
@@ -1409,13 +1529,14 @@ failIfInQuoteContext context = do
1409 context' <- getQuoteContext
1529 context' <- getQuoteContext
1410 when (context' == context) $ Prelude.fail "already inside quotes"
1530 when (context' == context) $ Prelude.fail "already inside quotes"
1412−charOrRef :: Stream s m Char => [Char] -> ParserT s st m Char
1532+charOrRef :: (Stream s m Char, UpdateSourcePos s Char) => [Char] -> ParserT s st m Char
1413charOrRef cs =
1533charOrRef cs =
1414 oneOf cs <|> try (do c <- characterReference
1534 oneOf cs <|> try (do c <- characterReference
1415 guard (c `elem` cs)
1535 guard (c `elem` cs)
1416 return c)
1536 return c)
1418−singleQuoteStart :: (HasLastStrPosition st, HasQuoteContext st m, Stream s m Char)
1538+singleQuoteStart :: (HasLastStrPosition st, HasQuoteContext st m,
1539+ Stream s m Char, UpdateSourcePos s Char)
1419 => ParserT s st m ()
1540 => ParserT s st m ()
1420singleQuoteStart = do
1541singleQuoteStart = do
1421 failIfInQuoteContext InSingleQuote
1542 failIfInQuoteContext InSingleQuote
@@ -1423,30 +1544,39 @@ singleQuoteStart = do
1423 guard =<< notAfterString
1544 guard =<< notAfterString
1424 try $ do
1545 try $ do
1425 charOrRef "'\8216\145"
1546 charOrRef "'\8216\145"
1426− notFollowedBy (oneOf [' ', '\t', '\n'])
1547+ void $ lookAhead (satisfy (not . isSpaceChar))
1428−singleQuoteEnd :: Stream s m Char
1549+singleQuoteEnd :: (Stream s m Char, UpdateSourcePos s Char)
1429 => ParserT s st m ()
1550 => ParserT s st m ()
1430singleQuoteEnd = try $ do
1551singleQuoteEnd = try $ do
1431 charOrRef "'\8217\146"
1552 charOrRef "'\8217\146"
1432 notFollowedBy alphaNum
1553 notFollowedBy alphaNum
1555+doubleQuoteStart :: (HasLastStrPosition st,
1434−doubleQuoteStart :: (HasQuoteContext st m, Stream s m Char)
1556+ HasQuoteContext st m,
1557+ Stream s m Char, UpdateSourcePos s Char)
1435 => ParserT s st m ()
1558 => ParserT s st m ()
1436doubleQuoteStart = do
1559doubleQuoteStart = do
1437 failIfInQuoteContext InDoubleQuote
1560 failIfInQuoteContext InDoubleQuote
1561+ guard =<< notAfterString
1438 try $ do charOrRef "\"\8220\147"
1562 try $ do charOrRef "\"\8220\147"
1439− notFollowedBy (oneOf [' ', '\t', '\n'])
1563+ void $ lookAhead (satisfy (not . isSpaceChar))
1441−doubleQuoteEnd :: Stream s m Char
1565+doubleQuoteEnd :: (Stream s m Char, UpdateSourcePos s Char)
1442 => ParserT s st m ()
1566 => ParserT s st m ()
1443doubleQuoteEnd = void (charOrRef "\"\8221\148")
1567doubleQuoteEnd = void (charOrRef "\"\8221\148")
1569+apostrophe :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Inlines
1570+apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\8217")
1572+doubleCloseQuote :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Inlines
1573+doubleCloseQuote = B.str "\8221" <$ char '"'
1445−ellipses :: Stream s m Char
1575+ellipses :: (Stream s m Char, UpdateSourcePos s Char)
1446 => ParserT s st m Inlines
1576 => ParserT s st m Inlines
1447ellipses = try (string "..." >> return (B.str "\8230"))
1577ellipses = try (string "..." >> return (B.str "\8230"))
1449−dash :: (HasReaderOptions st, Stream s m Char)
1579+dash :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
1450 => ParserT s st m Inlines
1580 => ParserT s st m Inlines
1451dash = try $ do
1581dash = try $ do
1452 oldDashes <- extensionEnabled Ext_old_dashes <$> getOption readerExtensions
1582 oldDashes <- extensionEnabled Ext_old_dashes <$> getOption readerExtensions
@@ -1473,20 +1603,28 @@ nested p = do
1473 updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
1603 updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
1474 return res
1604 return res
1476−citeKey :: (Stream s m Char, HasLastStrPosition st)
1606+citeKey :: (Stream s m Char, UpdateSourcePos s Char, HasLastStrPosition st)
1607+ => Bool -- ^ If True, allow expanded @{..} syntax.
1477− => ParserT s st m (Bool, Text)
1608+ -> ParserT s st m (Bool, Text)
1478−citeKey = try $ do
1609+citeKey allowBraced = try $ do
1479 guard =<< notAfterString
1610 guard =<< notAfterString
1480 suppress_author <- option False (True <$ char '-')
1611 suppress_author <- option False (True <$ char '-')
1481 char '@'
1612 char '@'
1613+ key <- simpleCiteIdentifier
1615+ then charsInBalanced '{' '}' (satisfy (not . isSpace))
1617+ return (suppress_author, key)
1619+simpleCiteIdentifier :: (Stream s m Char, UpdateSourcePos s Char)
1620+ => ParserT s st m Text
1621+simpleCiteIdentifier = do
1482 firstChar <- alphaNum <|> char '_' <|> char '*' -- @* for wildcard in nocite
1622 firstChar <- alphaNum <|> char '_' <|> char '*' -- @* for wildcard in nocite
1483 let regchar = satisfy (\c -> isAlphaNum c || c == '_')
1623 let regchar = satisfy (\c -> isAlphaNum c || c == '_')
1484 let internal p = try $ p <* lookAhead regchar
1624 let internal p = try $ p <* lookAhead regchar
1485 rest <- many $ regchar <|> internal (oneOf ":.#$%&-+?<>~/") <|>
1625 rest <- many $ regchar <|> internal (oneOf ":.#$%&-+?<>~/") <|>
1486 try (oneOf ":/" <* lookAhead (char '/'))
1626 try (oneOf ":/" <* lookAhead (char '/'))
1487− let key = firstChar:rest
1488− return (suppress_author, T.pack key)
1627+ return $ T.pack $ firstChar:rest
1491token :: (Stream s m t)
1629token :: (Stream s m t)
1492 => (t -> Text)
1630 => (t -> Text)
@@ -1506,12 +1644,15 @@ extractIdClass (ident, cls, kvs) = (ident', cls', kvs')
1506 cls' = maybe cls T.words $ lookup "class" kvs
1644 cls' = maybe cls T.words $ lookup "class" kvs
1507 kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
1645 kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
1509−insertIncludedFile' :: (PandocMonad m, HasIncludeFiles st)
1647+insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
1510− => ParserT a st m (mf Blocks)
1648+ => ParserT a st m b -- ^ parser to apply
1511− -> (Text -> a)
1649+ -> (Text -> a) -- ^ convert Text to stream type
1512− -> [FilePath] -> FilePath
1650+ -> [FilePath] -- ^ search path (directories)
1651+ -> FilePath -- ^ path of file to include
1652+ -> Maybe Int -- ^ start line (negative counts from end)
1653+ -> Maybe Int -- ^ end line (negative counts from end)
1513− -> ParserT a st m (mf Blocks)
1654+ -> ParserT a st m b
1514−insertIncludedFile' blocks totoks dirs f = do
1655+insertIncludedFile parser toStream dirs f mbstartline mbendline = do
1515 oldPos <- getPosition
1656 oldPos <- getPosition
1516 oldInput <- getInput
1657 oldInput <- getInput
1517 containers <- getIncludeFiles <$> getState
1658 containers <- getIncludeFiles <$> getState
@@ -1520,32 +1661,32 @@ insertIncludedFile' blocks totoks dirs f = do
1520 updateState $ addIncludeFile $ T.pack f
1661 updateState $ addIncludeFile $ T.pack f
1521 mbcontents <- readFileFromDirs dirs f
1662 mbcontents <- readFileFromDirs dirs f
1522 contents <- case mbcontents of
1663 contents <- case mbcontents of
1523− Just s -> return s
1664+ Just s -> return $ exciseLines mbstartline mbendline s
1524 Nothing -> do
1665 Nothing -> do
1525 report $ CouldNotLoadIncludeFile (T.pack f) oldPos
1666 report $ CouldNotLoadIncludeFile (T.pack f) oldPos
1526 return ""
1667 return ""
1668+ setInput $ toStream contents
1527− setPosition $ newPos f 1 1
1669+ setPosition $ newPos f (fromMaybe 1 mbstartline) 1
1528− setInput $ totoks contents
1670+ result <- parser
1530 setInput oldInput
1671 setInput oldInput
1531 setPosition oldPos
1672 setPosition oldPos
1532 updateState dropLatestIncludeFile
1673 updateState dropLatestIncludeFile
1533− return bs
1674+ return result
1676+exciseLines :: Maybe Int -> Maybe Int -> Text -> Text
1677+exciseLines Nothing Nothing t = t
1678+exciseLines mbstartline mbendline t =
1679+ T.unlines $ take (endline' - (startline' - 1))
1680+ $ drop (startline' - 1) contentLines
1682+ contentLines = T.lines t
1683+ numLines = length contentLines
1684+ startline' = case mbstartline of
1686+ Just x | x >= 0 -> x
1687+ | otherwise -> numLines + x -- negative from end
1688+ endline' = case mbendline of
1689+ Nothing -> numLines
1690+ Just x | x >= 0 -> x
1691+ | otherwise -> numLines + x -- negative from end
1535−-- | Parse content of include file as blocks. Circular includes result in an
1536−-- @PandocParseError@.
1537−insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
1538− => ParserT [a] st m Blocks
1540− -> [FilePath] -> FilePath
1541− -> ParserT [a] st m Blocks
1542−insertIncludedFile blocks totoks dirs f =
1543− runIdentity <$> insertIncludedFile' (Identity <$> blocks) totoks dirs f
1545−-- | Parse content of include file as future blocks. Circular includes result in
1546−-- an @PandocParseError@.
1547−insertIncludedFileF :: (PandocMonad m, HasIncludeFiles st)
1548− => ParserT Text st m (Future st Blocks)
1549− -> [FilePath] -> FilePath
1550− -> ParserT Text st m (Future st Blocks)
1551−insertIncludedFileF p = insertIncludedFile' p id