@@ -5,7 +5,6 @@
55{-# LANGUAGE GeneralizedNewtypeDeriving #-}
66{-# LANGUAGE IncoherentInstances #-}
77{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE ViewPatterns #-}
98{-# LANGUAGE OverloadedStrings #-}
109{- |
1110 Module : Text.Pandoc.Parsing
@@ -19,8 +18,7 @@
1918A utility library with parsers used in pandoc readers.
2019-}
2120
22−module Text.Pandoc.Parsing ( take1WhileP,
23− takeP,
21+module Text.Pandoc.Parsing ( module Text.Pandoc.Sources,
2422 countChar,
2523 textStr,
2624 anyLine,
@@ -105,14 +103,14 @@ module Text.Pandoc.Parsing ( take1WhileP,
105103 singleQuoteEnd,
106104 doubleQuoteStart,
107105 doubleQuoteEnd,
108− ellipses,
109106 apostrophe,
107+ doubleCloseQuote,
108+ ellipses,
110109 dash,
111110 nested,
112111 citeKey,
113112 Parser,
114113 ParserT,
115− F,
116114 Future(..),
117115 runF,
118116 askF,
@@ -123,7 +121,6 @@ module Text.Pandoc.Parsing ( take1WhileP,
123121 (<+?>),
124122 extractIdClass,
125123 insertIncludedFile,
126− insertIncludedFileF,
127124 -- * Re-exports from Text.Parsec
128125 Stream,
129126 runParser,
@@ -134,22 +131,10 @@ module Text.Pandoc.Parsing ( take1WhileP,
134131 getInput,
135132 setInput,
136133 unexpected,
137− char,
138− letter,
139− digit,
140− alphaNum,
141134 skipMany,
142135 skipMany1,
143− spaces,
144− space,
145− anyChar,
146− satisfy,
147− newline,
148− string,
149136 count,
150137 eof,
151− noneOf,
152− oneOf,
153138 lookAhead,
154139 notFollowedBy,
155140 many,
@@ -174,6 +159,8 @@ module Text.Pandoc.Parsing ( take1WhileP,
174159 SourcePos,
175160 getPosition,
176161 setPosition,
162+ sourceName,
163+ setSourceName,
177164 sourceColumn,
178165 sourceLine,
179166 setSourceColumn,
@@ -189,48 +176,141 @@ module Text.Pandoc.Parsing ( take1WhileP,
189176where
190177
191178import Control.Monad.Identity
179+ ( guard,
180+ join,
181+ unless,
182+ when,
183+ void,
184+ liftM2,
185+ liftM,
186+ Identity(..),
187+ MonadPlus(mzero) )
192188import Control.Monad.Reader
189+ ( asks, runReader, MonadReader(ask), Reader, ReaderT(ReaderT) )
193190import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper, isAsciiLower,
194− isPunctuation, isSpace, ord, toLower, toUpper)
195−import Data.Default
191+ isSpace, ord, toLower, toUpper)
192+import Data.Default ( Default(..) )
196193import Data.Functor (($>))
197194import Data.List (intercalate, transpose)
198195import qualified Data.Map as M
199−import Data.Maybe (mapMaybe, fromMaybe)
196+import Data.Maybe (fromMaybe)
200197import qualified Data.Set as Set
201−import Data.String
202198import Data.Text (Text)
203199import qualified Data.Text as T
204200import Text.HTML.TagSoup.Entity (lookupEntity)
205−import Text.Pandoc.Asciify (toAsciiChar)
201+import Text.Pandoc.Asciify (toAsciiText)
206202import Text.Pandoc.Builder (Blocks, HasMeta (..), Inlines, trimInlines)
207203import qualified Text.Pandoc.Builder as B
208204import Text.Pandoc.Class.PandocMonad (PandocMonad, readFileFromDirs, report)
209205import Text.Pandoc.Definition
206+ ( Target,
207+ nullMeta,
208+ nullAttr,
209+ Meta,
210+ ColWidth(ColWidthDefault, ColWidth),
211+ TableFoot(TableFoot),
212+ TableBody(TableBody),
213+ Attr,
214+ TableHead(TableHead),
215+ Row(..),
216+ Alignment(..),
217+ Inline(Str),
218+ ListNumberDelim(..),
219+ ListAttributes,
220+ ListNumberStyle(..) )
210221import Text.Pandoc.Logging
222+ ( LogMessage(CouldNotLoadIncludeFile, DuplicateIdentifier) )
211223import Text.Pandoc.Options
224+ ( extensionEnabled,
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) )
212229import Text.Pandoc.Readers.LaTeX.Types (Macro)
213230import Text.Pandoc.Shared
231+ ( uniqueIdent,
232+ tshow,
233+ mapLeft,
234+ compactify,
235+ trim,
236+ trimr,
237+ splitTextByIndices,
238+ safeRead,
239+ trimMath,
240+ schemes,
241+ escapeURI )
242+import Text.Pandoc.Sources
214243import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
215244import Text.Pandoc.XML (fromEntities)
216−import Text.Parsec hiding (token)
217−import Text.Parsec.Pos (initialPos, newPos, updatePosString)
218−
219−import Control.Monad.Except
245+import Text.Parsec
246+ ( between,
247+ setSourceName,
248+ Parsec,
249+ Column,
250+ Line,
251+ incSourceLine,
252+ incSourceColumn,
253+ setSourceLine,
254+ setSourceColumn,
255+ sourceLine,
256+ sourceColumn,
257+ sourceName,
258+ setSourceName,
259+ setPosition,
260+ getPosition,
261+ updateState,
262+ setState,
263+ getState,
264+ optionMaybe,
265+ optional,
266+ option,
267+ endBy1,
268+ endBy,
269+ sepEndBy1,
270+ sepEndBy,
271+ sepBy1,
272+ sepBy,
273+ try,
274+ choice,
275+ (<?>),
276+ (<|>),
277+ manyTill,
278+ many1,
279+ many,
280+ notFollowedBy,
281+ lookAhead,
282+ eof,
283+ count,
284+ skipMany1,
285+ skipMany,
286+ unexpected,
287+ setInput,
288+ getInput,
289+ anyToken,
290+ tokenPrim,
291+ parse,
292+ runParserT,
293+ runParser,
294+ ParseError,
295+ ParsecT,
296+ SourcePos,
297+ Stream(..) )
298+import Text.Parsec.Pos (initialPos, newPos)
299+import Control.Monad.Except ( MonadError(throwError) )
220300import Text.Pandoc.Error
301+ ( PandocError(PandocParseError, PandocParsecError) )
221302
222303type Parser t s = Parsec t s
223304
224305type ParserT = ParsecT
225306
307+
226308-- | Reader monad wrapping the parser state. This is used to possibly delay
227309-- evaluation until all relevant information has been parsed and made available
228310-- in the parser state.
229311newtype Future s a = Future { runDelayed :: Reader s a }
230312 deriving (Monad, Applicative, Functor)
231313
232−type F = Future ParserState
233−
234314runF :: Future s a -> s -> a
235315runF = runReader . runDelayed
236316
@@ -253,70 +333,48 @@ instance (Semigroup a, Monoid a) => Monoid (Future s a) where
253333 mappend = (<>)
254334
255335-- | 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)
257337 => Int
258338 -> ParsecT s st m Char
259339 -> ParsecT s st m Text
260340countChar n = fmap T.pack . count n
261341
262342-- | Like @string@, but uses @Text@.
263−textStr :: Stream s m Char => Text -> ParsecT s u m Text
343+textStr :: (Stream s m Char, UpdateSourcePos s Char)
344+ => Text -> ParsecT s u m Text
264345textStr t = string (T.unpack t) $> t
265346
266−-- | Parse characters while a predicate is true.
267−take1WhileP :: Monad m
268− => (Char -> Bool)
269− -> ParserT Text st m Text
270−take1WhileP f = do
271− -- needed to persuade parsec that this won't match an empty string:
272− c <- satisfy f
273− inp <- getInput
274− pos <- getPosition
275− let (t, rest) = T.span f inp
276− setInput rest
277− setPosition $
278− if f '\t' || f '\n'
279− then updatePosString pos $ T.unpack t
280− else incSourceColumn pos (T.length t)
281− return $ T.singleton c <> t
282−
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
286−takeP n = do
287− guard (n > 0)
288− -- faster than 'count n anyChar'
289− inp <- getInput
290− pos <- getPosition
291− let (xs, rest) = T.splitAt n inp
292− -- needed to persuade parsec that this won't match an empty string:
293− anyChar
294− setInput rest
295− setPosition $ updatePosString pos $ T.unpack xs
296− return xs
297−
298−-- | Parse any line of text
299−anyLine :: Monad m => ParserT Text st m Text
347+
348+-- | Parse any line of text, returning the contents without the
349+-- final newline.
350+anyLine :: Monad m => ParserT Sources st m Text
300351anyLine = do
301352 -- This is much faster than:
302353 -- manyTill anyChar newline
303354 inp <- getInput
304− pos <- getPosition
305− case T.break (=='\n') inp of
306− (this, T.uncons -> Just ('\n', rest)) -> do
307− -- needed to persuade parsec that this won't match an empty string:
308− anyChar
309− setInput rest
310− setPosition $ incSourceLine (setSourceColumn pos 1) 1
311− return this
312− _ -> mzero
355+ case inp of
356+ Sources [] -> mzero
357+ Sources ((fp,t):inps) ->
358+ -- we assume that lines don't span different input files
359+ case T.break (=='\n') t of
360+ (this, rest)
361+ | T.null 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)
368+ char '\n' -- needed so parsec knows we won't match empty string
369+ -- and so source pos is updated
370+ return this
313371
314372-- | 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
316374anyLineNewline = (<> "\n") <$> anyLine
317375
318376-- | 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)
320378 => HasReaderOptions st
321379 => Int -> ParserT s st m Text
322380indentWith num = do
@@ -401,11 +459,13 @@ notFollowedBy' p = try $ join $ do a <- try p
401459 return (return ())
402460-- (This version due to Andrew Pimlott on the Haskell mailing list.)
403461
404−oneOfStrings' :: Stream s m Char => (Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
462+oneOfStrings' :: (Stream s m Char, UpdateSourcePos s Char)
463+ => (Char -> Char -> Bool) -> [Text] -> ParserT s st m Text
405464oneOfStrings' f = fmap T.pack . oneOfStrings'' f . fmap T.unpack
406465
407466-- TODO: This should be re-implemented in a Text-aware way
408−oneOfStrings'' :: Stream s m Char => (Char -> Char -> Bool) -> [String] -> ParserT s st m String
467+oneOfStrings'' :: (Stream s m Char, UpdateSourcePos s Char)
468+ => (Char -> Char -> Bool) -> [String] -> ParserT s st m String
409469oneOfStrings'' _ [] = Prelude.fail "no strings"
410470oneOfStrings'' matches strs = try $ do
411471 c <- anyChar
@@ -420,14 +480,16 @@ oneOfStrings'' matches strs = try $ do
420480-- | Parses one of a list of strings. If the list contains
421481-- two strings one of which is a prefix of the other, the longer
422482-- string will be matched if possible.
423−oneOfStrings :: Stream s m Char => [Text] -> ParserT s st m Text
483+oneOfStrings :: (Stream s m Char, UpdateSourcePos s Char)
484+ => [Text] -> ParserT s st m Text
424485oneOfStrings = oneOfStrings' (==)
425486
426487-- | Parses one of a list of strings (tried in order), case insensitive.
427488
428489-- TODO: This will not be accurate with general Unicode (neither
429490-- Text.toLower nor Text.toCaseFold can be implemented with a map)
430−oneOfStringsCI :: Stream s m Char => [Text] -> ParserT s st m Text
491+oneOfStringsCI :: (Stream s m Char, UpdateSourcePos s Char)
492+ => [Text] -> ParserT s st m Text
431493oneOfStringsCI = oneOfStrings' ciMatch
432494 where ciMatch x y = toLower' x == toLower' y
433495 -- this optimizes toLower by checking common ASCII case
@@ -438,11 +500,13 @@ oneOfStringsCI = oneOfStrings' ciMatch
438500 | otherwise = toLower c
439501
440502-- | Parses a space or tab.
441−spaceChar :: Stream s m Char => ParserT s st m Char
503+spaceChar :: (Stream s m Char, UpdateSourcePos s Char)
504+ => ParserT s st m Char
442505spaceChar = satisfy $ \c -> c == ' ' || c == '\t'
443506
444507-- | 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
446510nonspaceChar = satisfy (not . isSpaceChar)
447511
448512isSpaceChar :: Char -> Bool
@@ -453,21 +517,24 @@ isSpaceChar '\r' = True
453517isSpaceChar _ = False
454518
455519-- | Skips zero or more spaces or tabs.
456−skipSpaces :: Stream s m Char => ParserT s st m ()
520+skipSpaces :: (Stream s m Char, UpdateSourcePos s Char)
521+ => ParserT s st m ()
457522skipSpaces = skipMany spaceChar
458523
459524-- | Skips zero or more spaces or tabs, then reads a newline.
460−blankline :: Stream s m Char => ParserT s st m Char
525+blankline :: (Stream s m Char, UpdateSourcePos s Char)
526+ => ParserT s st m Char
461527blankline = try $ skipSpaces >> newline
462528
463529-- | Parses one or more blank lines and returns a string of newlines.
464−blanklines :: Stream s m Char => ParserT s st m Text
530+blanklines :: (Stream s m Char, UpdateSourcePos s Char)
531+ => ParserT s st m Text
465532blanklines = T.pack <$> many1 blankline
466533
467534-- | Gobble n spaces; if tabs are encountered, expand them
468535-- and gobble some or all of their spaces, leaving the rest.
469536gobbleSpaces :: (HasReaderOptions st, Monad m)
470− => Int -> ParserT Text st m ()
537+ => Int -> ParserT Sources st m ()
471538gobbleSpaces 0 = return ()
472539gobbleSpaces n
473540 | n < 0 = error "gobbleSpaces called with negative number"
@@ -475,18 +542,26 @@ gobbleSpaces n
475542 char ' ' <|> eatOneSpaceOfTab
476543 gobbleSpaces (n - 1)
477544
478−eatOneSpaceOfTab :: (HasReaderOptions st, Monad m) => ParserT Text st m Char
545+eatOneSpaceOfTab :: (HasReaderOptions st, Monad m) => ParserT Sources st m Char
479546eatOneSpaceOfTab = do
480− char '\t'
547+ lookAhead (char '\t')
548+ pos <- getPosition
481549 tabstop <- getOption readerTabStop
550+ -- replace the tab on the input stream with spaces
551+ let numSpaces = tabstop - ((sourceColumn pos - 1) `mod` tabstop)
482552 inp <- getInput
483− setInput $ T.replicate (tabstop - 1) " " <> inp
484− return ' '
553+ setInput $
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)
559+ char ' '
485560
486561-- | Gobble up to n spaces; if tabs are encountered, expand them
487562-- and gobble some or all of their spaces, leaving the rest.
488563gobbleAtMostSpaces :: (HasReaderOptions st, Monad m)
489− => Int -> ParserT Text st m Int
564+ => Int -> ParserT Sources st m Int
490565gobbleAtMostSpaces 0 = return 0
491566gobbleAtMostSpaces n
492567 | n < 0 = error "gobbleAtMostSpaces called with negative number"
@@ -495,7 +570,8 @@ gobbleAtMostSpaces n
495570 (+ 1) <$> gobbleAtMostSpaces (n - 1)
496571
497572-- | Parses material enclosed between start and end parsers.
498−enclosed :: (Show end, Stream s m Char) => ParserT s st m t -- ^ start parser
573+enclosed :: (Show end, Stream s m Char, UpdateSourcePos s Char)
574+ => ParserT s st m t -- ^ start parser
499575 -> ParserT s st m end -- ^ end parser
500576 -> ParserT s st m a -- ^ content parser (to be used repeatedly)
501577 -> ParserT s st m [a]
@@ -503,39 +579,41 @@ enclosed start end parser = try $
503579 start >> notFollowedBy space >> many1Till parser end
504580
505581-- | Parse string, case insensitive.
506−stringAnyCase :: Stream s m Char => Text -> ParserT s st m Text
582+stringAnyCase :: (Stream s m Char, UpdateSourcePos s Char)
583+ => Text -> ParserT s st m Text
507584stringAnyCase = fmap T.pack . stringAnyCase' . T.unpack
508585
509−stringAnyCase' :: Stream s m Char => String -> ParserT s st m String
586+stringAnyCase' :: (Stream s m Char, UpdateSourcePos s Char)
587+ => String -> ParserT s st m String
510588stringAnyCase' [] = string ""
511589stringAnyCase' (x:xs) = do
512590 firstChar <- char (toUpper x) <|> char (toLower x)
513591 rest <- stringAnyCase' xs
514592 return (firstChar:rest)
515593
594+-- TODO rewrite by just adding to Sources stream?
516595-- | Parse contents of 'str' using 'parser' and return result.
517−parseFromString :: (Stream s m Char, IsString s)
518− => ParserT s st m r
596+parseFromString :: Monad m
597+ => ParserT Sources st m r
519598 -> Text
520− -> ParserT s st m r
599+ -> ParserT Sources st m r
521600parseFromString parser str = do
522601 oldPos <- getPosition
523602 setPosition $ initialPos "chunk"
524603 oldInput <- getInput
525− setInput $ fromString $ T.unpack str
604+ setInput $ toSources str
526605 result <- parser
527606 spaces
528− eof
529607 setInput oldInput
530608 setPosition oldPos
531609 return result
532610
533611-- | Like 'parseFromString' but specialized for 'ParserState'.
534612-- This resets 'stateLastStrPos', which is almost always what we want.
535−parseFromString' :: (Stream s m Char, IsString s, HasLastStrPosition u)
536− => ParserT s u m a
613+parseFromString' :: (Monad m, HasLastStrPosition u)
614+ => ParserT Sources u m a
537615 -> Text
538− -> ParserT s u m a
616+ -> ParserT Sources u m a
539617parseFromString' parser str = do
540618 oldLastStrPos <- getLastStrPos <$> getState
541619 updateState $ setLastStrPos Nothing
@@ -544,7 +622,7 @@ parseFromString' parser str = do
544622 return res
545623
546624-- | Parse raw line block up to and including blank lines.
547−lineClump :: Monad m => ParserT Text st m Text
625+lineClump :: Monad m => ParserT Sources st m Text
548626lineClump = blanklines
549627 <|> (T.unlines <$> many1 (notFollowedBy blankline >> anyLine))
550628
@@ -553,7 +631,7 @@ lineClump = blanklines
553631-- pairs of open and close, which must be different. For example,
554632-- @charsInBalanced '(' ')' anyChar@ will parse "(hello (there))"
555633-- and return "hello (there)".
556−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
557635 -> ParserT s st m Text
558636charsInBalanced open close parser = try $ do
559637 char open
@@ -572,7 +650,7 @@ charsInBalanced open close parser = try $ do
572650-- Auxiliary functions for romanNumeral:
573651
574652-- | Parses a roman numeral (uppercase or lowercase), returns number.
575−romanNumeral :: Stream s m Char => Bool -- ^ Uppercase if true
653+romanNumeral :: (Stream s m Char, UpdateSourcePos s Char) => Bool -- ^ Uppercase if true
576654 -> ParserT s st m Int
577655romanNumeral upperCase = do
578656 let rchar uc = char $ if upperCase then uc else toLower uc
@@ -608,20 +686,19 @@ romanNumeral upperCase = do
608686
609687-- | Parses an email address; returns original and corresponding
610688-- escaped mailto: URI.
611−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)
612690emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)
613691 where toResult mbox dom = let full = fromEntities $ T.pack $ mbox ++ '@':dom
614692 in (full, escapeURI $ "mailto:" <> full)
615693 mailbox = intercalate "." <$> (emailWord `sepBy1'` dot)
616694 domain = intercalate "." <$> (subdomain `sepBy1'` dot)
617695 dot = char '.'
618− subdomain = many1 $ alphaNum <|> innerPunct
696+ subdomain = many1 $ alphaNum <|> innerPunct (=='-')
619697 -- this excludes some valid email addresses, since an
620698 -- email could contain e.g. '__', but gives better results
621699 -- for our purposes, when combined with markdown parsing:
622− innerPunct = try (satisfy (\c -> isEmailPunct c || c == '@')
623− <* notFollowedBy space
624− <* notFollowedBy (satisfy isPunctuation))
700+ innerPunct f = try (satisfy f
701+ <* notFollowedBy (satisfy (not . isAlphaNum)))
625702 -- technically an email address could begin with a symbol,
626703 -- but allowing this creates too many problems.
627704 -- See e.g. https://github.com/jgm/pandoc/issues/2940
@@ -632,11 +709,11 @@ emailAddress = try $ toResult <$> mailbox <*> (char '@' *> domain)
632709 isEmailPunct c = T.any (== c) "!\"#$%&'*+-/=?^_{|}~;"
633710
634711
635−uriScheme :: Stream s m Char => ParserT s st m Text
712+uriScheme :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Text
636713uriScheme = oneOfStringsCI (Set.toList schemes)
637714
638715-- | Parses a URI. Returns pair of original and URI-escaped version.
639−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)
640717uri = try $ do
641718 scheme <- uriScheme
642719 char ':'
@@ -679,7 +756,7 @@ uri = try $ do
679756 uriChunkBetween l r = try $ do chunk <- between (char l) (char r) uriChunk
680757 return (T.pack $ [l] ++ chunk ++ [r])
681758
682−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
683760mathInlineWith op cl = try $ do
684761 textStr op
685762 when (op == "$") $ notFollowedBy space
@@ -700,10 +777,10 @@ mathInlineWith op cl = try $ do
700777 notFollowedBy digit -- to prevent capture of $5
701778 return $ trimMath $ T.concat words'
702779 where
703− 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
704781 inBalancedBraces n = fmap T.pack . inBalancedBraces' n . T.unpack
705782
706− 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
707784 inBalancedBraces' 0 "" = do
708785 c <- anyChar
709786 if c == '{'
@@ -720,13 +797,13 @@ mathInlineWith op cl = try $ do
720797 '{' -> inBalancedBraces' (numOpen + 1) (c:xs)
721798 _ -> inBalancedBraces' numOpen (c:xs)
722799
723−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
724801mathDisplayWith op cl = try $ fmap T.pack $ do
725802 textStr op
726803 many1Till (satisfy (/= '\n') <|> (newline <* notFollowedBy' blankline))
727804 (try $ textStr cl)
728805
729−mathDisplay :: (HasReaderOptions st, Stream s m Char)
806+mathDisplay :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
730807 => ParserT s st m Text
731808mathDisplay =
732809 (guardEnabled Ext_tex_math_dollars >> mathDisplayWith "$$" "$$")
@@ -735,7 +812,7 @@ mathDisplay =
735812 <|> (guardEnabled Ext_tex_math_double_backslash >>
736813 mathDisplayWith "\\\\[" "\\\\]")
737814
738−mathInline :: (HasReaderOptions st , Stream s m Char)
815+mathInline :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
739816 => ParserT s st m Text
740817mathInline =
741818 (guardEnabled Ext_tex_math_dollars >> mathInlineWith "$" "$")
@@ -748,7 +825,7 @@ mathInline =
748825-- displacement (the difference between the source column at the end
749826-- and the source column at the beginning). Vertical displacement
750827-- (source row) is ignored.
751−withHorizDisplacement :: Stream s m Char
828+withHorizDisplacement :: (Stream s m Char, UpdateSourcePos s Char)
752829 => ParserT s st m a -- ^ Parser to apply
753830 -> ParserT s st m (a, Int) -- ^ (result, displacement)
754831withHorizDisplacement parser = do
@@ -760,30 +837,37 @@ withHorizDisplacement parser = do
760837-- | Applies a parser and returns the raw string that was parsed,
761838-- along with the value produced by the parser.
762839withRaw :: Monad m
763− => ParsecT Text st m a
764− -> ParsecT Text st m (a, Text)
840+ => ParsecT Sources st m a
841+ -> ParsecT Sources st m (a, Text)
765842withRaw parser = do
766− pos1 <- getPosition
767− inp <- getInput
843+ inps1 <- getInput
768844 result <- parser
769− pos2 <- getPosition
770− let (l1,c1) = (sourceLine pos1, sourceColumn pos1)
771− let (l2,c2) = (sourceLine pos2, sourceColumn pos2)
772− let inplines = take ((l2 - l1) + 1) $ T.lines inp
773− let raw = case inplines of
774− [] -> ""
775− [l] -> T.take (c2 - c1) l
776− ls -> T.unlines (init ls) <> T.take (c2 - 1) (last ls)
777− return (result, raw)
845+ inps2 <- getInput
846+ -- 'raw' is the difference between inps1 and inps2
847+ return (result, sourcesDifference inps1 inps2)
848+
849+sourcesDifference :: Sources -> Sources -> Text
850+sourcesDifference (Sources is1) (Sources is2) = go is1 is2
851+ where
852+ go inps1 inps2 =
853+ case (inps1, inps2) of
854+ ([], _) -> mempty
855+ (_, []) -> mconcat $ map snd inps1
856+ ((p1,t1):rest1, (p2, t2):rest2)
857+ | p1 == p2
858+ , t1 == t2 -> go rest1 rest2
859+ | p1 == p2
860+ , t1 /= t2 -> fromMaybe mempty $ T.stripSuffix t2 t1
861+ | otherwise -> t1 <> go rest1 inps2
778862
779863-- | Parses backslash, then applies character parser.
780−escaped :: Stream s m Char
864+escaped :: (Stream s m Char, UpdateSourcePos s Char)
781865 => ParserT s st m Char -- ^ Parser for character to escape
782866 -> ParserT s st m Char
783867escaped parser = try $ char '\\' >> parser
784868
785869-- | Parse character entity.
786−characterReference :: Stream s m Char => ParserT s st m Char
870+characterReference :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Char
787871characterReference = try $ do
788872 char '&'
789873 ent <- many1Till nonspaceChar (char ';')
@@ -796,19 +880,19 @@ characterReference = try $ do
796880 _ -> Prelude.fail "entity not found"
797881
798882-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
799−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)
800884upperRoman = do
801885 num <- romanNumeral True
802886 return (UpperRoman, num)
803887
804888-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
805−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)
806890lowerRoman = do
807891 num <- romanNumeral False
808892 return (LowerRoman, num)
809893
810894-- | Parses a decimal numeral and returns (Decimal, number).
811−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)
812896decimal = do
813897 num <- many1 digit
814898 return (Decimal, fromMaybe 1 $ safeRead $ T.pack num)
@@ -817,7 +901,7 @@ decimal = do
817901-- returns (DefaultStyle, [next example number]). The next
818902-- example number is incremented in parser state, and the label
819903-- (if present) is added to the label table.
820−exampleNum :: Stream s m Char
904+exampleNum :: (Stream s m Char, UpdateSourcePos s Char)
821905 => ParserT s ParserState m (ListNumberStyle, Int)
822906exampleNum = do
823907 char '@'
@@ -836,37 +920,37 @@ exampleNum = do
836920 return (Example, num)
837921
838922-- | Parses a '#' returns (DefaultStyle, 1).
839−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)
840924defaultNum = do
841925 char '#'
842926 return (DefaultStyle, 1)
843927
844928-- | Parses a lowercase letter and returns (LowerAlpha, number).
845−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)
846930lowerAlpha = do
847931 ch <- satisfy isAsciiLower
848932 return (LowerAlpha, ord ch - ord 'a' + 1)
849933
850934-- | Parses an uppercase letter and returns (UpperAlpha, number).
851−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)
852936upperAlpha = do
853937 ch <- satisfy isAsciiUpper
854938 return (UpperAlpha, ord ch - ord 'A' + 1)
855939
856940-- | Parses a roman numeral i or I
857−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)
858942romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
859943 (char 'I' >> return (UpperRoman, 1))
860944
861945-- | Parses an ordered list marker and returns list attributes.
862−anyOrderedListMarker :: Stream s m Char => ParserT s ParserState m ListAttributes
946+anyOrderedListMarker :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s ParserState m ListAttributes
863947anyOrderedListMarker = choice
864948 [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
865949 numParser <- [decimal, exampleNum, defaultNum, romanOne,
866950 lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
867951
868952-- | Parses a list number (num) followed by a period, returns list attributes.
869−inPeriod :: Stream s m Char
953+inPeriod :: (Stream s m Char, UpdateSourcePos s Char)
870954 => ParserT s st m (ListNumberStyle, Int)
871955 -> ParserT s st m ListAttributes
872956inPeriod num = try $ do
@@ -878,7 +962,7 @@ inPeriod num = try $ do
878962 return (start, style, delim)
879963
880964-- | Parses a list number (num) followed by a paren, returns list attributes.
881−inOneParen :: Stream s m Char
965+inOneParen :: (Stream s m Char, UpdateSourcePos s Char)
882966 => ParserT s st m (ListNumberStyle, Int)
883967 -> ParserT s st m ListAttributes
884968inOneParen num = try $ do
@@ -887,7 +971,7 @@ inOneParen num = try $ do
887971 return (start, style, OneParen)
888972
889973-- | Parses a list number (num) enclosed in parens, returns list attributes.
890−inTwoParens :: Stream s m Char
974+inTwoParens :: (Stream s m Char, UpdateSourcePos s Char)
891975 => ParserT s st m (ListNumberStyle, Int)
892976 -> ParserT s st m ListAttributes
893977inTwoParens num = try $ do
@@ -898,7 +982,7 @@ inTwoParens num = try $ do
898982
899983-- | Parses an ordered list marker with a given style and delimiter,
900984-- returns number.
901−orderedListMarker :: Stream s m Char
985+orderedListMarker :: (Stream s m Char, UpdateSourcePos s Char)
902986 => ListNumberStyle
903987 -> ListNumberDelim
904988 -> ParserT s ParserState m Int
@@ -921,10 +1005,10 @@ orderedListMarker style delim = do
9211005 return start
9221006
9231007-- | Parses a character reference and returns a Str element.
924−charRef :: Stream s m Char => ParserT s st m Inline
1008+charRef :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Inline
9251009charRef = Str . T.singleton <$> characterReference
9261010
927−lineBlockLine :: Monad m => ParserT Text st m Text
1011+lineBlockLine :: Monad m => ParserT Sources st m Text
9281012lineBlockLine = try $ do
9291013 char '|'
9301014 char ' '
@@ -934,11 +1018,11 @@ lineBlockLine = try $ do
9341018 continuations <- many (try $ char ' ' >> anyLine)
9351019 return $ white <> T.unwords (line : continuations)
9361020
937−blankLineBlockLine :: Stream s m Char => ParserT s st m Char
1021+blankLineBlockLine :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Char
9381022blankLineBlockLine = try (char '|' >> blankline)
9391023
9401024-- | Parses an RST-style line block and returns a list of strings.
941−lineBlockLines :: Monad m => ParserT Text st m [Text]
1025+lineBlockLines :: Monad m => ParserT Sources st m [Text]
9421026lineBlockLines = try $ do
9431027 lines' <- many1 (lineBlockLine <|> (T.singleton <$> blankLineBlockLine))
9441028 skipMany blankline
@@ -946,7 +1030,8 @@ lineBlockLines = try $ do
9461030
9471031-- | Parse a table using 'headerParser', 'rowParser',
9481032-- 'lineParser', and 'footerParser'.
949−tableWith :: (Stream s m Char, HasReaderOptions st, Monad mf)
1033+tableWith :: (Stream s m Char, UpdateSourcePos s Char,
1034+ HasReaderOptions st, Monad mf)
9501035 => ParserT s st m (mf [Blocks], [Alignment], [Int])
9511036 -> ([Int] -> ParserT s st m (mf [Blocks]))
9521037 -> ParserT s st m sep
@@ -966,7 +1051,8 @@ tableWith headerParser rowParser lineParser footerParser = try $ do
9661051
9671052type TableComponents mf = ([Alignment], [Double], mf [Row], mf [Row])
9681053
969−tableWith' :: (Stream s m Char, HasReaderOptions st, Monad mf)
1054+tableWith' :: (Stream s m Char, UpdateSourcePos s Char,
1055+ HasReaderOptions st, Monad mf)
9701056 => ParserT s st m (mf [Blocks], [Alignment], [Int])
9711057 -> ([Int] -> ParserT s st m (mf [Blocks]))
9721058 -> ParserT s st m sep
@@ -1015,20 +1101,19 @@ widthsFromIndices numColumns' indices =
10151101-- (which may be grid), then the rows,
10161102-- which may be grid, separated by blank lines, and
10171103-- ending with a footer (dashed line followed by blank line).
1018−gridTableWith :: (Stream s m Char, HasReaderOptions st, HasLastStrPosition st,
1019− Monad mf, IsString s)
1020− => ParserT s st m (mf Blocks) -- ^ Block list parser
1104+gridTableWith :: (Monad m, HasReaderOptions st, HasLastStrPosition st, Monad mf)
1105+ => ParserT Sources st m (mf Blocks) -- ^ Block list parser
10211106 -> Bool -- ^ Headerless table
1022− -> ParserT s st m (mf Blocks)
1107+ -> ParserT Sources st m (mf Blocks)
10231108gridTableWith blocks headless =
10241109 tableWith (gridTableHeader headless blocks) (gridTableRow blocks)
10251110 (gridTableSep '-') gridTableFooter
10261111
1027−gridTableWith' :: (Stream s m Char, HasReaderOptions st, HasLastStrPosition st,
1028− Monad mf, IsString s)
1029− => ParserT s st m (mf Blocks) -- ^ Block list parser
1112+gridTableWith' :: (Monad m, HasReaderOptions st, HasLastStrPosition st,
1113+ Monad mf)
1114+ => ParserT Sources st m (mf Blocks) -- ^ Block list parser
10301115 -> Bool -- ^ Headerless table
1031− -> ParserT s st m (TableComponents mf)
1116+ -> ParserT Sources st m (TableComponents mf)
10321117gridTableWith' blocks headless =
10331118 tableWith' (gridTableHeader headless blocks) (gridTableRow blocks)
10341119 (gridTableSep '-') gridTableFooter
@@ -1037,7 +1122,7 @@ gridTableSplitLine :: [Int] -> Text -> [Text]
10371122gridTableSplitLine indices line = map removeFinalBar $ tail $
10381123 splitTextByIndices (init indices) $ trimr line
10391124
1040−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)
10411126gridPart ch = do
10421127 leftColon <- option False (True <$ char ':')
10431128 dashes <- many1 (char ch)
@@ -1052,7 +1137,7 @@ gridPart ch = do
10521137 (False, False) -> AlignDefault
10531138 return ((lengthDashes, lengthDashes + 1), alignment)
10541139
1055−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)]
10561141gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
10571142
10581143removeFinalBar :: Text -> Text
@@ -1061,14 +1146,14 @@ removeFinalBar = T.dropWhileEnd go . T.dropWhileEnd (=='|')
10611146 go c = T.any (== c) " \t"
10621147
10631148-- | Separator between rows of grid table.
1064−gridTableSep :: Stream s m Char => Char -> ParserT s st m Char
1149+gridTableSep :: Monad m => Char -> ParserT Sources st m Char
10651150gridTableSep ch = try $ gridDashedLines ch >> return '\n'
10661151
10671152-- | Parse header for a grid table.
1068−gridTableHeader :: (Stream s m Char, Monad mf, IsString s, HasLastStrPosition st)
1153+gridTableHeader :: (Monad m, Monad mf, HasLastStrPosition st)
10691154 => Bool -- ^ Headerless table
1070− -> ParserT s st m (mf Blocks)
1071− -> ParserT s st m (mf [Blocks], [Alignment], [Int])
1155+ -> ParserT Sources st m (mf Blocks)
1156+ -> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
10721157gridTableHeader True _ = do
10731158 optional blanklines
10741159 dashes <- gridDashedLines '-'
@@ -1091,17 +1176,17 @@ gridTableHeader False blocks = try $ do
10911176 heads <- sequence <$> mapM (parseFromString' blocks . trim) rawHeads
10921177 return (heads, aligns, indices)
10931178
1094−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]
10951180gridTableRawLine indices = do
10961181 char '|'
10971182 line <- many1Till anyChar newline
10981183 return (gridTableSplitLine indices $ T.pack line)
10991184
11001185-- | Parse row of grid table.
1101−gridTableRow :: (Stream s m Char, Monad mf, IsString s, HasLastStrPosition st)
1102− => ParserT s st m (mf Blocks)
1186+gridTableRow :: (Monad m, Monad mf, HasLastStrPosition st)
1187+ => ParserT Sources st m (mf Blocks)
11031188 -> [Int]
1104− -> ParserT s st m (mf [Blocks])
1189+ -> ParserT Sources st m (mf [Blocks])
11051190gridTableRow blocks indices = do
11061191 colLines <- many1 (gridTableRawLine indices)
11071192 let cols = map ((<> "\n") . T.unlines . removeOneLeadingSpace) $
@@ -1122,34 +1207,38 @@ removeOneLeadingSpace xs =
11221207 Just (c, _) -> c == ' '
11231208
11241209-- | Parse footer for a grid table.
1125−gridTableFooter :: Stream s m Char => ParserT s st m ()
1210+gridTableFooter :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m ()
11261211gridTableFooter = optional blanklines
11271212
11281213---
11291214
11301215-- | Removes the ParsecT layer from the monad transformer stack
1131−readWithM :: (Stream s m Char, ToText s)
1132− => ParserT s st m a -- ^ parser
1133− -> st -- ^ initial state
1134− -> s -- ^ input
1216+readWithM :: (Monad m, ToSources t)
1217+ => ParserT Sources st m a -- ^ parser
1218+ -> st -- ^ initial state
1219+ -> t -- ^ input
11351220 -> m (Either PandocError a)
11361221readWithM parser state input =
1137− mapLeft (PandocParsecError $ toText input) `liftM` runParserT parser state "source" input
1222+ mapLeft (PandocParsecError sources)
1223+ <$> runParserT parser state (initialSourceName sources) sources
1224+ where
1225+ sources = toSources input
11381226
11391227-- | Parse a string with a given parser and state
1140−readWith :: Parser Text st a
1228+readWith :: ToSources t
1229+ => Parser Sources st a
11411230 -> st
1142− -> Text
1231+ -> t
11431232 -> Either PandocError a
11441233readWith p t inp = runIdentity $ readWithM p t inp
11451234
11461235-- | Parse a string with @parser@ (for testing).
11471236testStringWith :: Show a
1148− => ParserT Text ParserState Identity a
1237+ => ParserT Sources ParserState Identity a
11491238 -> Text
11501239 -> IO ()
11511240testStringWith parser str = UTF8.putStrLn $ tshow $
1152− readWith parser defaultParserState str
1241+ readWith parser defaultParserState (toSources str)
11531242
11541243-- | Parsing options.
11551244data ParserState = ParserState
@@ -1169,7 +1258,7 @@ data ParserState = ParserState
11691258 stateInNote :: Bool, -- ^ True if parsing note contents
11701259 stateNoteNumber :: Int, -- ^ Last note number for citations
11711260 stateMeta :: Meta, -- ^ Document metadata
1172− stateMeta' :: F Meta, -- ^ Document metadata
1261+ stateMeta' :: Future ParserState Meta, -- ^ Document metadata
11731262 stateCitations :: M.Map Text Text, -- ^ RST-style citations
11741263 stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
11751264 stateIdentifiers :: Set.Set Text, -- ^ Header identifiers used
@@ -1348,7 +1437,7 @@ data QuoteContext
13481437
13491438type NoteTable = [(Text, Text)]
13501439
1351−type NoteTable' = M.Map Text (SourcePos, F Blocks)
1440+type NoteTable' = M.Map Text (SourcePos, Future ParserState Blocks)
13521441-- used in markdown reader
13531442
13541443newtype Key = Key Text deriving (Show, Read, Eq, Ord)
@@ -1383,7 +1472,7 @@ registerHeader (ident,classes,kvs) header' = do
13831472 then do
13841473 let id' = uniqueIdent exts (B.toList header') ids
13851474 let id'' = if Ext_ascii_identifiers `extensionEnabled` exts
1386− then T.pack $ mapMaybe toAsciiChar $ T.unpack id'
1475+ then toAsciiText id'
13871476 else id'
13881477 updateState $ updateIdentifierList $ Set.insert id'
13891478 updateState $ updateIdentifierList $ Set.insert id''
@@ -1396,34 +1485,42 @@ registerHeader (ident,classes,kvs) header' = do
13961485 updateState $ updateIdentifierList $ Set.insert ident
13971486 return (ident,classes,kvs)
13981487
1399−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)
14001491 => ParserT s st m Inlines
14011492 -> ParserT s st m Inlines
14021493smartPunctuation inlineParser = do
14031494 guardEnabled Ext_smart
1404− choice [ quoted inlineParser, apostrophe, dash, ellipses ]
1495+ choice [ quoted inlineParser, apostrophe, doubleCloseQuote, dash, ellipses ]
14051496
1406−apostrophe :: Stream s m Char => ParserT s st m Inlines
1407−apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\x2019")
1408−
1409−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)
14101499 => ParserT s st m Inlines
14111500 -> ParserT s st m Inlines
14121501quoted inlineParser = doubleQuoted inlineParser <|> singleQuoted inlineParser
14131502
1414−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)
14151505 => ParserT s st m Inlines
14161506 -> ParserT s st m Inlines
1417−singleQuoted inlineParser = try $ B.singleQuoted . mconcat
1418− <$ singleQuoteStart
1419− <*> withQuoteContext InSingleQuote (many1Till inlineParser singleQuoteEnd)
1420−
1421−doubleQuoted :: (HasQuoteContext st m, Stream s m Char)
1507+singleQuoted inlineParser = do
1508+ singleQuoteStart
1509+ (B.singleQuoted . mconcat <$>
1510+ try
1511+ (withQuoteContext InSingleQuote (many1Till inlineParser singleQuoteEnd)))
1512+ <|> pure "\8217"
1513+
1514+doubleQuoted :: (HasQuoteContext st m, HasLastStrPosition st,
1515+ Stream s m Char, UpdateSourcePos s Char)
14221516 => ParserT s st m Inlines
14231517 -> ParserT s st m Inlines
1424−doubleQuoted inlineParser = try $ B.doubleQuoted . mconcat
1425− <$ doubleQuoteStart
1426− <*> withQuoteContext InDoubleQuote (manyTill inlineParser doubleQuoteEnd)
1518+doubleQuoted inlineParser = do
1519+ doubleQuoteStart
1520+ (B.doubleQuoted . mconcat <$>
1521+ try
1522+ (withQuoteContext InDoubleQuote (manyTill inlineParser doubleQuoteEnd)))
1523+ <|> pure (B.str "\8220")
14271524
14281525failIfInQuoteContext :: (HasQuoteContext st m, Stream s m t)
14291526 => QuoteContext
@@ -1432,13 +1529,14 @@ failIfInQuoteContext context = do
14321529 context' <- getQuoteContext
14331530 when (context' == context) $ Prelude.fail "already inside quotes"
14341531
1435−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
14361533charOrRef cs =
14371534 oneOf cs <|> try (do c <- characterReference
14381535 guard (c `elem` cs)
14391536 return c)
14401537
1441−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)
14421540 => ParserT s st m ()
14431541singleQuoteStart = do
14441542 failIfInQuoteContext InSingleQuote
@@ -1446,30 +1544,39 @@ singleQuoteStart = do
14461544 guard =<< notAfterString
14471545 try $ do
14481546 charOrRef "'\8216\145"
1449− notFollowedBy (oneOf [' ', '\t', '\n'])
1547+ void $ lookAhead (satisfy (not . isSpaceChar))
14501548
1451−singleQuoteEnd :: Stream s m Char
1549+singleQuoteEnd :: (Stream s m Char, UpdateSourcePos s Char)
14521550 => ParserT s st m ()
14531551singleQuoteEnd = try $ do
14541552 charOrRef "'\8217\146"
14551553 notFollowedBy alphaNum
14561554
1457−doubleQuoteStart :: (HasQuoteContext st m, Stream s m Char)
1555+doubleQuoteStart :: (HasLastStrPosition st,
1556+ HasQuoteContext st m,
1557+ Stream s m Char, UpdateSourcePos s Char)
14581558 => ParserT s st m ()
14591559doubleQuoteStart = do
14601560 failIfInQuoteContext InDoubleQuote
1561+ guard =<< notAfterString
14611562 try $ do charOrRef "\"\8220\147"
1462− notFollowedBy (oneOf [' ', '\t', '\n'])
1563+ void $ lookAhead (satisfy (not . isSpaceChar))
14631564
1464−doubleQuoteEnd :: Stream s m Char
1565+doubleQuoteEnd :: (Stream s m Char, UpdateSourcePos s Char)
14651566 => ParserT s st m ()
14661567doubleQuoteEnd = void (charOrRef "\"\8221\148")
14671568
1468−ellipses :: Stream s m Char
1569+apostrophe :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Inlines
1570+apostrophe = (char '\'' <|> char '\8217') >> return (B.str "\8217")
1571+
1572+doubleCloseQuote :: (Stream s m Char, UpdateSourcePos s Char) => ParserT s st m Inlines
1573+doubleCloseQuote = B.str "\8221" <$ char '"'
1574+
1575+ellipses :: (Stream s m Char, UpdateSourcePos s Char)
14691576 => ParserT s st m Inlines
14701577ellipses = try (string "..." >> return (B.str "\8230"))
14711578
1472−dash :: (HasReaderOptions st, Stream s m Char)
1579+dash :: (HasReaderOptions st, Stream s m Char, UpdateSourcePos s Char)
14731580 => ParserT s st m Inlines
14741581dash = try $ do
14751582 oldDashes <- extensionEnabled Ext_old_dashes <$> getOption readerExtensions
@@ -1496,20 +1603,28 @@ nested p = do
14961603 updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
14971604 return res
14981605
1499−citeKey :: (Stream s m Char, HasLastStrPosition st)
1500− => ParserT s st m (Bool, Text)
1501−citeKey = try $ do
1606+citeKey :: (Stream s m Char, UpdateSourcePos s Char, HasLastStrPosition st)
1607+ => Bool -- ^ If True, allow expanded @{..} syntax.
1608+ -> ParserT s st m (Bool, Text)
1609+citeKey allowBraced = try $ do
15021610 guard =<< notAfterString
15031611 suppress_author <- option False (True <$ char '-')
15041612 char '@'
1613+ key <- simpleCiteIdentifier
1614+ <|> if allowBraced
1615+ then charsInBalanced '{' '}' (satisfy (not . isSpace))
1616+ else mzero
1617+ return (suppress_author, key)
1618+
1619+simpleCiteIdentifier :: (Stream s m Char, UpdateSourcePos s Char)
1620+ => ParserT s st m Text
1621+simpleCiteIdentifier = do
15051622 firstChar <- alphaNum <|> char '_' <|> char '*' -- @* for wildcard in nocite
15061623 let regchar = satisfy (\c -> isAlphaNum c || c == '_')
15071624 let internal p = try $ p <* lookAhead regchar
15081625 rest <- many $ regchar <|> internal (oneOf ":.#$%&-+?<>~/") <|>
15091626 try (oneOf ":/" <* lookAhead (char '/'))
1510− let key = firstChar:rest
1511− return (suppress_author, T.pack key)
1512−
1627+ return $ T.pack $ firstChar:rest
15131628
15141629token :: (Stream s m t)
15151630 => (t -> Text)
@@ -1529,12 +1644,15 @@ extractIdClass (ident, cls, kvs) = (ident', cls', kvs')
15291644 cls' = maybe cls T.words $ lookup "class" kvs
15301645 kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
15311646
1532−insertIncludedFile' :: (PandocMonad m, HasIncludeFiles st)
1533− => ParserT a st m (mf Blocks)
1534− -> (Text -> a)
1535− -> [FilePath] -> FilePath
1536− -> ParserT a st m (mf Blocks)
1537−insertIncludedFile' blocks totoks dirs f = do
1647+insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
1648+ => ParserT a st m b -- ^ parser to apply
1649+ -> (Text -> a) -- ^ convert Text to stream type
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)
1654+ -> ParserT a st m b
1655+insertIncludedFile parser toStream dirs f mbstartline mbendline = do
15381656 oldPos <- getPosition
15391657 oldInput <- getInput
15401658 containers <- getIncludeFiles <$> getState
@@ -1543,32 +1661,32 @@ insertIncludedFile' blocks totoks dirs f = do
15431661 updateState $ addIncludeFile $ T.pack f
15441662 mbcontents <- readFileFromDirs dirs f
15451663 contents <- case mbcontents of
1546− Just s -> return s
1664+ Just s -> return $ exciseLines mbstartline mbendline s
15471665 Nothing -> do
15481666 report $ CouldNotLoadIncludeFile (T.pack f) oldPos
15491667 return ""
1550− setPosition $ newPos f 1 1
1551− setInput $ totoks contents
1552− bs <- blocks
1668+ setInput $ toStream contents
1669+ setPosition $ newPos f (fromMaybe 1 mbstartline) 1
1670+ result <- parser
15531671 setInput oldInput
15541672 setPosition oldPos
15551673 updateState dropLatestIncludeFile
1556− return bs
1674+ return result
1675+
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
1681+ where
1682+ contentLines = T.lines t
1683+ numLines = length contentLines
1684+ startline' = case mbstartline of
1685+ Nothing -> 1
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
15571692
1558−-- | Parse content of include file as blocks. Circular includes result in an
1559−-- @PandocParseError@.
1560−insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
1561− => ParserT [a] st m Blocks
1562− -> (Text -> [a])
1563− -> [FilePath] -> FilePath
1564− -> ParserT [a] st m Blocks
1565−insertIncludedFile blocks totoks dirs f =
1566− runIdentity <$> insertIncludedFile' (Identity <$> blocks) totoks dirs f
1567−
1568−-- | Parse content of include file as future blocks. Circular includes result in
1569−-- an @PandocParseError@.
1570−insertIncludedFileF :: (PandocMonad m, HasIncludeFiles st)
1571− => ParserT Text st m (Future st Blocks)
1572− -> [FilePath] -> FilePath
1573− -> ParserT Text st m (Future st Blocks)
1574−insertIncludedFileF p = insertIncludedFile' p id