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