git.iko.soy/typeable/pandoc
on master help sign in
Added Text.Pandoc.Readers.LaTeX.Parsing (unexported).
9dac993John MacFarlane
pandoc.cabal+1
compare with master
unifiedsplit
@@ -508,6 +508,7 @@ library
508 Text.Pandoc.Readers.Docx.Util,
508 Text.Pandoc.Readers.Docx.Util,
509 Text.Pandoc.Readers.Docx.StyleMap,
509 Text.Pandoc.Readers.Docx.StyleMap,
510 Text.Pandoc.Readers.Docx.Fields,
510 Text.Pandoc.Readers.Docx.Fields,
511+ Text.Pandoc.Readers.LaTeX.Parsing,
511 Text.Pandoc.Readers.Odt.Base,
512 Text.Pandoc.Readers.Odt.Base,
512 Text.Pandoc.Readers.Odt.Namespaces,
513 Text.Pandoc.Readers.Odt.Namespaces,
513 Text.Pandoc.Readers.Odt.StyleReader,
514 Text.Pandoc.Readers.Odt.StyleReader,
src/Text/Pandoc/Readers/LaTeX.hs+3−557
@@ -47,8 +47,7 @@ import Prelude
47import Control.Applicative (many, optional, (<|>))
47import Control.Applicative (many, optional, (<|>))
48import Control.Monad
48import Control.Monad
49import Control.Monad.Except (throwError)
49import Control.Monad.Except (throwError)
50−import Control.Monad.Trans (lift)
51−import Data.Char (chr, isAlphaNum, isDigit, isLetter, ord, toLower, toUpper)
50+import Data.Char (isDigit, isLetter, toLower, toUpper)
52import Data.Default
51import Data.Default
53import Data.List (intercalate, isPrefixOf)
52import Data.List (intercalate, isPrefixOf)
54import qualified Data.Map as M
53import qualified Data.Map as M
@@ -63,7 +62,7 @@ import Text.Pandoc.Builder
63import Text.Pandoc.Class (PandocMonad, PandocPure, getResourcePath, lookupEnv,
62import Text.Pandoc.Class (PandocMonad, PandocPure, getResourcePath, lookupEnv,
64 readFileFromDirs, report, setResourcePath,
63 readFileFromDirs, report, setResourcePath,
65 setTranslations, translateTerm, trace)
64 setTranslations, translateTerm, trace)
66−import Text.Pandoc.Error (PandocError (PandocMacroLoop, PandocParseError, PandocParsecError))
65+import Text.Pandoc.Error (PandocError ( PandocParseError, PandocParsecError))
67import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
66import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
68import Text.Pandoc.ImageSize (numUnit, showFl)
67import Text.Pandoc.ImageSize (numUnit, showFl)
69import Text.Pandoc.Logging
68import Text.Pandoc.Logging
@@ -72,10 +71,10 @@ import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,
72 optional, space, spaces, withRaw, (<|>))
71 optional, space, spaces, withRaw, (<|>))
73import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
72import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
74 ArgSpec (..), Tok (..), TokType (..))
73 ArgSpec (..), Tok (..), TokType (..))
74+import Text.Pandoc.Readers.LaTeX.Parsing
75import Text.Pandoc.Shared
75import Text.Pandoc.Shared
76import qualified Text.Pandoc.Translations as Translations
76import qualified Text.Pandoc.Translations as Translations
77import Text.Pandoc.Walk
77import Text.Pandoc.Walk
78−import Text.Parsec.Pos
79import qualified Text.Pandoc.Builder as B
78import qualified Text.Pandoc.Builder as B
80
79
81-- for debugging:
80-- for debugging:
@@ -137,151 +136,6 @@ resolveRefs _ x = x
137-- Left e -> error (show e)
136-- Left e -> error (show e)
138-- Right r -> return r
137-- Right r -> return r
139
138
140−newtype DottedNum = DottedNum [Int]
141− deriving (Show)
142−
143−renderDottedNum :: DottedNum -> String
144−renderDottedNum (DottedNum xs) =
145− intercalate "." (map show xs)
146−
147−incrementDottedNum :: Int -> DottedNum -> DottedNum
148−incrementDottedNum level (DottedNum ns) = DottedNum $
149− case reverse (take level (ns ++ repeat 0)) of
150− (x:xs) -> reverse (x+1 : xs)
151− [] -> [] -- shouldn't happen
152−
153−data LaTeXState = LaTeXState{ sOptions :: ReaderOptions
154− , sMeta :: Meta
155− , sQuoteContext :: QuoteContext
156− , sMacros :: M.Map Text Macro
157− , sContainers :: [String]
158− , sHeaders :: M.Map Inlines String
159− , sLogMessages :: [LogMessage]
160− , sIdentifiers :: Set.Set String
161− , sVerbatimMode :: Bool
162− , sCaption :: (Maybe Inlines, Maybe String)
163− , sInListItem :: Bool
164− , sInTableCell :: Bool
165− , sLastHeaderNum :: DottedNum
166− , sLastFigureNum :: DottedNum
167− , sLabels :: M.Map String [Inline]
168− , sHasChapters :: Bool
169− , sToggles :: M.Map String Bool
170− }
171− deriving Show
172−
173−defaultLaTeXState :: LaTeXState
174−defaultLaTeXState = LaTeXState{ sOptions = def
175− , sMeta = nullMeta
176− , sQuoteContext = NoQuote
177− , sMacros = M.empty
178− , sContainers = []
179− , sHeaders = M.empty
180− , sLogMessages = []
181− , sIdentifiers = Set.empty
182− , sVerbatimMode = False
183− , sCaption = (Nothing, Nothing)
184− , sInListItem = False
185− , sInTableCell = False
186− , sLastHeaderNum = DottedNum []
187− , sLastFigureNum = DottedNum []
188− , sLabels = M.empty
189− , sHasChapters = False
190− , sToggles = M.empty
191− }
192−
193−instance PandocMonad m => HasQuoteContext LaTeXState m where
194− getQuoteContext = sQuoteContext <$> getState
195− withQuoteContext context parser = do
196− oldState <- getState
197− let oldQuoteContext = sQuoteContext oldState
198− setState oldState { sQuoteContext = context }
199− result <- parser
200− newState <- getState
201− setState newState { sQuoteContext = oldQuoteContext }
202− return result
203−
204−instance HasLogMessages LaTeXState where
205− addLogMessage msg st = st{ sLogMessages = msg : sLogMessages st }
206− getLogMessages st = reverse $ sLogMessages st
207−
208−instance HasIdentifierList LaTeXState where
209− extractIdentifierList = sIdentifiers
210− updateIdentifierList f st = st{ sIdentifiers = f $ sIdentifiers st }
211−
212−instance HasIncludeFiles LaTeXState where
213− getIncludeFiles = sContainers
214− addIncludeFile f s = s{ sContainers = f : sContainers s }
215− dropLatestIncludeFile s = s { sContainers = drop 1 $ sContainers s }
216−
217−instance HasHeaderMap LaTeXState where
218− extractHeaderMap = sHeaders
219− updateHeaderMap f st = st{ sHeaders = f $ sHeaders st }
220−
221−instance HasMacros LaTeXState where
222− extractMacros st = sMacros st
223− updateMacros f st = st{ sMacros = f (sMacros st) }
224−
225−instance HasReaderOptions LaTeXState where
226− extractReaderOptions = sOptions
227−
228−instance HasMeta LaTeXState where
229− setMeta field val st =
230− st{ sMeta = setMeta field val $ sMeta st }
231− deleteMeta field st =
232− st{ sMeta = deleteMeta field $ sMeta st }
233−
234−instance Default LaTeXState where
235− def = defaultLaTeXState
236−
237−type LP m = ParserT [Tok] LaTeXState m
238−
239−withVerbatimMode :: PandocMonad m => LP m a -> LP m a
240−withVerbatimMode parser = do
241− updateState $ \st -> st{ sVerbatimMode = True }
242− result <- parser
243− updateState $ \st -> st{ sVerbatimMode = False }
244− return result
245−
246−rawLaTeXParser :: (PandocMonad m, HasMacros s, HasReaderOptions s)
247− => Bool -> LP m a -> LP m a -> ParserT String s m (a, String)
248−rawLaTeXParser retokenize parser valParser = do
249− inp <- getInput
250− let toks = tokenize "source" $ T.pack inp
251− pstate <- getState
252− let lstate = def{ sOptions = extractReaderOptions pstate }
253− let lstate' = lstate { sMacros = extractMacros pstate }
254− let rawparser = (,) <$> withRaw valParser <*> getState
255− res' <- lift $ runParserT (snd <$> withRaw parser) lstate "chunk" toks
256− case res' of
257− Left _ -> mzero
258− Right toks' -> do
259− res <- lift $ runParserT (do when retokenize $ do
260− -- retokenize, applying macros
261− doMacros 0
262− ts <- many (satisfyTok (const True))
263− setInput ts
264− rawparser)
265− lstate' "chunk" toks'
266− case res of
267− Left _ -> mzero
268− Right ((val, raw), st) -> do
269− updateState (updateMacros (sMacros st <>))
270− _ <- takeP (T.length (untokenize toks'))
271− return (val, T.unpack (untokenize raw))
272−
273−applyMacros :: (PandocMonad m, HasMacros s, HasReaderOptions s)
274− => String -> ParserT String s m String
275−applyMacros s = (guardDisabled Ext_latex_macros >> return s) <|>
276− do let retokenize = doMacros 0 *>
277− (toksToString <$> many (satisfyTok (const True)))
278− pstate <- getState
279− let lstate = def{ sOptions = extractReaderOptions pstate
280− , sMacros = extractMacros pstate }
281− res <- runParserT retokenize lstate "math" (tokenize "math" (T.pack s))
282− case res of
283− Left e -> fail (show e)
284− Right s' -> return s'
285
139
286rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)
140rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)
287 => ParserT String s m String
141 => ParserT String s m String
@@ -326,358 +180,6 @@ inlineCommand = do
326 lookAhead (try (char '\\' >> letter))
180 lookAhead (try (char '\\' >> letter))
327 fst <$> rawLaTeXParser True (inlineEnvironment <|> inlineCommand') inlines
181 fst <$> rawLaTeXParser True (inlineEnvironment <|> inlineCommand') inlines
328
182
329−tokenize :: SourceName -> Text -> [Tok]
330−tokenize sourcename = totoks (initialPos sourcename)
331−
332−totoks :: SourcePos -> Text -> [Tok]
333−totoks pos t =
334− case T.uncons t of
335− Nothing -> []
336− Just (c, rest)
337− | c == '\n' ->
338− Tok pos Newline "\n"
339− : totoks (setSourceColumn (incSourceLine pos 1) 1) rest
340− | isSpaceOrTab c ->
341− let (sps, rest') = T.span isSpaceOrTab t
342− in Tok pos Spaces sps
343− : totoks (incSourceColumn pos (T.length sps))
344− rest'
345− | isAlphaNum c ->
346− let (ws, rest') = T.span isAlphaNum t
347− in Tok pos Word ws
348− : totoks (incSourceColumn pos (T.length ws)) rest'
349− | c == '%' ->
350− let (cs, rest') = T.break (== '\n') rest
351− in Tok pos Comment ("%" <> cs)
352− : totoks (incSourceColumn pos (1 + T.length cs)) rest'
353− | c == '\\' ->
354− case T.uncons rest of
355− Nothing -> [Tok pos (CtrlSeq " ") "\\"]
356− Just (d, rest')
357− | isLetterOrAt d ->
358− -- \makeatletter is common in macro defs;
359− -- ideally we should make tokenization sensitive
360− -- to \makeatletter and \makeatother, but this is
361− -- probably best for now
362− let (ws, rest'') = T.span isLetterOrAt rest
363− (ss, rest''') = T.span isSpaceOrTab rest''
364− in Tok pos (CtrlSeq ws) ("\\" <> ws <> ss)
365− : totoks (incSourceColumn pos
366− (1 + T.length ws + T.length ss)) rest'''
367− | isSpaceOrTab d || d == '\n' ->
368− let (w1, r1) = T.span isSpaceOrTab rest
369− (w2, (w3, r3)) = case T.uncons r1 of
370− Just ('\n', r2)
371− -> (T.pack "\n",
372− T.span isSpaceOrTab r2)
373− _ -> (mempty, (mempty, r1))
374− ws = "\\" <> w1 <> w2 <> w3
375− in case T.uncons r3 of
376− Just ('\n', _) ->
377− Tok pos (CtrlSeq " ") ("\\" <> w1)
378− : totoks (incSourceColumn pos (T.length ws))
379− r1
380− _ ->
381− Tok pos (CtrlSeq " ") ws
382− : totoks (incSourceColumn pos (T.length ws))
383− r3
384− | otherwise ->
385− Tok pos (CtrlSeq (T.singleton d)) (T.pack [c,d])
386− : totoks (incSourceColumn pos 2) rest'
387− | c == '#' ->
388− let (t1, t2) = T.span (\d -> d >= '0' && d <= '9') rest
389− in case safeRead (T.unpack t1) of
390− Just i ->
391− Tok pos (Arg i) ("#" <> t1)
392− : totoks (incSourceColumn pos (1 + T.length t1)) t2
393− Nothing ->
394− Tok pos Symbol "#"
395− : totoks (incSourceColumn pos 1) t2
396− | c == '^' ->
397− case T.uncons rest of
398− Just ('^', rest') ->
399− case T.uncons rest' of
400− Just (d, rest'')
401− | isLowerHex d ->
402− case T.uncons rest'' of
403− Just (e, rest''') | isLowerHex e ->
404− Tok pos Esc2 (T.pack ['^','^',d,e])
405− : totoks (incSourceColumn pos 4) rest'''
406− _ ->
407− Tok pos Esc1 (T.pack ['^','^',d])
408− : totoks (incSourceColumn pos 3) rest''
409− | d < '\128' ->
410− Tok pos Esc1 (T.pack ['^','^',d])
411− : totoks (incSourceColumn pos 3) rest''
412− _ -> Tok pos Symbol "^" :
413− Tok (incSourceColumn pos 1) Symbol "^" :
414− totoks (incSourceColumn pos 2) rest'
415− _ -> Tok pos Symbol "^"
416− : totoks (incSourceColumn pos 1) rest
417− | otherwise ->
418− Tok pos Symbol (T.singleton c) : totoks (incSourceColumn pos 1) rest
419−
420−isSpaceOrTab :: Char -> Bool
421−isSpaceOrTab ' ' = True
422−isSpaceOrTab '\t' = True
423−isSpaceOrTab _ = False
424−
425−isLetterOrAt :: Char -> Bool
426−isLetterOrAt '@' = True
427−isLetterOrAt c = isLetter c
428−
429−isLowerHex :: Char -> Bool
430−isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
431−
432−untokenize :: [Tok] -> Text
433−untokenize = mconcat . map untoken
434−
435−untoken :: Tok -> Text
436−untoken (Tok _ _ t) = t
437−
438−satisfyTok :: PandocMonad m => (Tok -> Bool) -> LP m Tok
439−satisfyTok f =
440− try $ do
441− res <- tokenPrim (T.unpack . untoken) updatePos matcher
442− doMacros 0 -- apply macros on remaining input stream
443− return res
444− where matcher t | f t = Just t
445− | otherwise = Nothing
446− updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
447− updatePos _spos _ (Tok pos _ _ : _) = pos
448− updatePos spos _ [] = incSourceColumn spos 1
449−
450−doMacros :: PandocMonad m => Int -> LP m ()
451−doMacros n = do
452− verbatimMode <- sVerbatimMode <$> getState
453− unless verbatimMode $ do
454− inp <- getInput
455− case inp of
456− Tok spos (CtrlSeq "begin") _ : Tok _ Symbol "{" :
457− Tok _ Word name : Tok _ Symbol "}" : ts
458− -> handleMacros spos name ts
459− Tok spos (CtrlSeq "end") _ : Tok _ Symbol "{" :
460− Tok _ Word name : Tok _ Symbol "}" : ts
461− -> handleMacros spos ("end" <> name) ts
462− Tok _ (CtrlSeq "expandafter") _ : t : ts
463− -> do setInput ts
464− doMacros n
465− getInput >>= setInput . combineTok t
466− Tok spos (CtrlSeq name) _ : ts
467− -> handleMacros spos name ts
468− _ -> return ()
469− where combineTok (Tok spos (CtrlSeq name) x) (Tok _ Word w : ts)
470− | T.all isLetterOrAt w =
471− Tok spos (CtrlSeq (name <> w)) (x1 <> w <> x2) : ts
472− where (x1, x2) = T.break isSpaceOrTab x
473− combineTok t ts = t:ts
474− handleMacros spos name ts = do
475− macros <- sMacros <$> getState
476− case M.lookup name macros of
477− Nothing -> return ()
478− Just (Macro expansionPoint argspecs optarg newtoks) -> do
479− setInput ts
480− let matchTok (Tok _ toktype txt) =
481− satisfyTok (\(Tok _ toktype' txt') ->
482− toktype == toktype' &&
483− txt == txt')
484− let matchPattern toks = try $ mapM_ matchTok toks
485− let getargs argmap [] = return argmap
486− getargs argmap (Pattern toks : rest) = try $ do
487− matchPattern toks
488− getargs argmap rest
489− getargs argmap (ArgNum i : Pattern toks : rest) =
490− try $ do
491− x <- mconcat <$> manyTill
492− (braced <|> ((:[]) <$> anyTok))
493− (matchPattern toks)
494− getargs (M.insert i x argmap) rest
495− getargs argmap (ArgNum i : rest) = do
496− x <- try $ spaces >> bracedOrToken
497− getargs (M.insert i x argmap) rest
498− args <- case optarg of
499− Nothing -> getargs M.empty argspecs
500− Just o -> do
501− x <- option o bracketedToks
502− getargs (M.singleton 1 x) argspecs
503− -- first boolean param is true if we're tokenizing
504− -- an argument (in which case we don't want to
505− -- expand #1 etc.)
506− let addTok False (Tok _ (Arg i) _) acc =
507− case M.lookup i args of
508− Nothing -> mzero
509− Just xs -> foldr (addTok True) acc xs
510− -- see #4007
511− addTok _ (Tok _ (CtrlSeq x) txt)
512− acc@(Tok _ Word _ : _)
513− | not (T.null txt) &&
514− isLetter (T.last txt) =
515− Tok spos (CtrlSeq x) (txt <> " ") : acc
516− addTok _ t acc = setpos spos t : acc
517− ts' <- getInput
518− setInput $ foldr (addTok False) ts' newtoks
519− case expansionPoint of
520− ExpandWhenUsed ->
521− if n > 20 -- detect macro expansion loops
522− then throwError $ PandocMacroLoop (T.unpack name)
523− else doMacros (n + 1)
524− ExpandWhenDefined -> return ()
525−
526−
527−setpos :: SourcePos -> Tok -> Tok
528−setpos spos (Tok _ tt txt) = Tok spos tt txt
529−
530−anyControlSeq :: PandocMonad m => LP m Tok
531−anyControlSeq = satisfyTok isCtrlSeq
532−
533−isCtrlSeq :: Tok -> Bool
534−isCtrlSeq (Tok _ (CtrlSeq _) _) = True
535−isCtrlSeq _ = False
536−
537−anySymbol :: PandocMonad m => LP m Tok
538−anySymbol = satisfyTok isSymbolTok
539−
540−isSymbolTok :: Tok -> Bool
541−isSymbolTok (Tok _ Symbol _) = True
542−isSymbolTok _ = False
543−
544−spaces :: PandocMonad m => LP m ()
545−spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
546−
547−spaces1 :: PandocMonad m => LP m ()
548−spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
549−
550−tokTypeIn :: [TokType] -> Tok -> Bool
551−tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
552−
553−controlSeq :: PandocMonad m => Text -> LP m Tok
554−controlSeq name = satisfyTok isNamed
555− where isNamed (Tok _ (CtrlSeq n) _) = n == name
556− isNamed _ = False
557−
558−symbol :: PandocMonad m => Char -> LP m Tok
559−symbol c = satisfyTok isc
560− where isc (Tok _ Symbol d) = case T.uncons d of
561− Just (c',_) -> c == c'
562− _ -> False
563− isc _ = False
564−
565−symbolIn :: PandocMonad m => [Char] -> LP m Tok
566−symbolIn cs = satisfyTok isInCs
567− where isInCs (Tok _ Symbol d) = case T.uncons d of
568− Just (c,_) -> c `elem` cs
569− _ -> False
570− isInCs _ = False
571−
572−sp :: PandocMonad m => LP m ()
573−sp = whitespace <|> endline
574−
575−whitespace :: PandocMonad m => LP m ()
576−whitespace = () <$ satisfyTok isSpaceTok
577−
578−isSpaceTok :: Tok -> Bool
579−isSpaceTok (Tok _ Spaces _) = True
580−isSpaceTok _ = False
581−
582−newlineTok :: PandocMonad m => LP m ()
583−newlineTok = () <$ satisfyTok isNewlineTok
584−
585−isNewlineTok :: Tok -> Bool
586−isNewlineTok (Tok _ Newline _) = True
587−isNewlineTok _ = False
588−
589−comment :: PandocMonad m => LP m ()
590−comment = () <$ satisfyTok isCommentTok
591−
592−isCommentTok :: Tok -> Bool
593−isCommentTok (Tok _ Comment _) = True
594−isCommentTok _ = False
595−
596−anyTok :: PandocMonad m => LP m Tok
597−anyTok = satisfyTok (const True)
598−
599−endline :: PandocMonad m => LP m ()
600−endline = try $ do
601− newlineTok
602− lookAhead anyTok
603− notFollowedBy blankline
604−
605−blankline :: PandocMonad m => LP m ()
606−blankline = try $ skipMany whitespace *> newlineTok
607−
608−primEscape :: PandocMonad m => LP m Char
609−primEscape = do
610− Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
611− case toktype of
612− Esc1 -> case T.uncons (T.drop 2 t) of
613− Just (c, _)
614− | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
615− | otherwise -> return (chr (ord c + 64))
616− Nothing -> fail "Empty content of Esc1"
617− Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
618− Just x -> return (chr x)
619− Nothing -> fail $ "Could not read: " ++ T.unpack t
620− _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
621−
622−bgroup :: PandocMonad m => LP m Tok
623−bgroup = try $ do
624− skipMany sp
625− symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
626−
627−egroup :: PandocMonad m => LP m Tok
628−egroup = symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup"
629−
630−grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
631−grouped parser = try $ do
632− bgroup
633− -- first we check for an inner 'grouped', because
634− -- {{a,b}} should be parsed the same as {a,b}
635− try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
636−
637−braced' :: PandocMonad m => LP m Tok -> Int -> LP m [Tok]
638−braced' getTok n =
639− handleEgroup <|> handleBgroup <|> handleOther
640− where handleEgroup = do
641− t <- egroup
642− if n == 1
643− then return []
644− else (t:) <$> braced' getTok (n - 1)
645− handleBgroup = do
646− t <- bgroup
647− (t:) <$> braced' getTok (n + 1)
648− handleOther = do
649− t <- getTok
650− (t:) <$> braced' getTok n
651−
652−braced :: PandocMonad m => LP m [Tok]
653−braced = bgroup *> braced' anyTok 1
654−
655−-- URLs require special handling, because they can contain %
656−-- characters. So we retonenize comments as we go...
657−bracedUrl :: PandocMonad m => LP m [Tok]
658−bracedUrl = bgroup *> braced' (retokenizeComment >> anyTok) 1
659−
660−bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
661−bracketed parser = try $ do
662− symbol '['
663− mconcat <$> manyTill parser (symbol ']')
664−
665−parenWrapped :: PandocMonad m => Monoid a => LP m a -> LP m a
666−parenWrapped parser = try $ do
667− symbol '('
668− mconcat <$> manyTill parser (symbol ')')
669−
670−dimenarg :: PandocMonad m => LP m Text
671−dimenarg = try $ do
672− ch <- option False $ True <$ symbol '='
673− Tok _ _ s <- satisfyTok isWordTok
674− guard $ T.take 2 (T.reverse s) `elem`
675− ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
676− let num = T.take (T.length s - 2) s
677− guard $ T.length num > 0
678− guard $ T.all isDigit num
679− return $ T.pack ['=' | ch] <> s
680−
681-- inline elements:
183-- inline elements:
682
184
683word :: PandocMonad m => LP m Inlines
185word :: PandocMonad m => LP m Inlines
@@ -689,13 +191,6 @@ regularSymbol = (str . T.unpack . untoken) <$> satisfyTok isRegularSymbol
689 isRegularSymbol _ = False
191 isRegularSymbol _ = False
690 isSpecial c = c `Set.member` specialChars
192 isSpecial c = c `Set.member` specialChars
691
193
692−specialChars :: Set.Set Char
693−specialChars = Set.fromList "#$%&~_^\\{}"
694−
695−isWordTok :: Tok -> Bool
696−isWordTok (Tok _ Word _) = True
697−isWordTok _ = False
698−
699inlineGroup :: PandocMonad m => LP m Inlines
194inlineGroup :: PandocMonad m => LP m Inlines
700inlineGroup = do
195inlineGroup = do
701 ils <- grouped inline
196 ils <- grouped inline
@@ -1396,9 +891,6 @@ breve 'U' = "Ŭ"
1396breve 'u' = "ŭ"
891breve 'u' = "ŭ"
1397breve c = [c]
892breve c = [c]
1398
893
1399−toksToString :: [Tok] -> String
1400−toksToString = T.unpack . untokenize
1401−
1402mathDisplay :: String -> Inlines
894mathDisplay :: String -> Inlines
1403mathDisplay = displayMath . trim
895mathDisplay = displayMath . trim
1404
896
@@ -1562,19 +1054,6 @@ tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar'
1562 Tok _ _ t <- singleChar
1054 Tok _ _ t <- singleChar
1563 return (str (T.unpack t))
1055 return (str (T.unpack t))
1564
1056
1565−singleChar :: PandocMonad m => LP m Tok
1566−singleChar = try $ do
1567− Tok pos toktype t <- satisfyTok (tokTypeIn [Word, Symbol])
1568− guard $ not $ toktype == Symbol &&
1569− T.any (`Set.member` specialChars) t
1570− if T.length t > 1
1571− then do
1572− let (t1, t2) = (T.take 1 t, T.drop 1 t)
1573− inp <- getInput
1574− setInput $ Tok (incSourceColumn pos 1) toktype t2 : inp
1575− return $ Tok pos toktype t1
1576− else return $ Tok pos toktype t
1577−
1578opt :: PandocMonad m => LP m Inlines
1057opt :: PandocMonad m => LP m Inlines
1579opt = bracketed inline <|> (str . T.unpack <$> rawopt)
1058opt = bracketed inline <|> (str . T.unpack <$> rawopt)
1580
1059
@@ -1611,20 +1090,6 @@ overlayTok =
1611 Tok _ Symbol c -> c `elem` ["-","+","@","|",":",","]
1090 Tok _ Symbol c -> c `elem` ["-","+","@","|",":",","]
1612 _ -> False)
1091 _ -> False)
1613
1092
1614−ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
1615−ignore raw = do
1616− pos <- getPosition
1617− report $ SkippedContent raw pos
1618− return mempty
1619−
1620−withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
1621−withRaw parser = do
1622− inp <- getInput
1623− result <- parser
1624− nxt <- option (Tok (initialPos "source") Word "") (lookAhead anyTok)
1625− let raw = takeWhile (/= nxt) inp
1626− return (result, raw)
1627−
1628inBrackets :: Inlines -> Inlines
1093inBrackets :: Inlines -> Inlines
1629inBrackets x = str "[" <> x <> str "]"
1094inBrackets x = str "[" <> x <> str "]"
1630
1095
@@ -1634,17 +1099,6 @@ unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
1634unescapeURL (x:xs) = x:unescapeURL xs
1099unescapeURL (x:xs) = x:unescapeURL xs
1635unescapeURL [] = ""
1100unescapeURL [] = ""
1636
1101
1637−-- For handling URLs, which allow literal % characters...
1638−retokenizeComment :: PandocMonad m => LP m ()
1639−retokenizeComment = (do
1640− Tok pos Comment txt <- satisfyTok isCommentTok
1641− let updPos (Tok pos' toktype' txt') =
1642− Tok (incSourceColumn (incSourceLine pos' (sourceLine pos - 1))
1643− (sourceColumn pos)) toktype' txt'
1644− let newtoks = map updPos $ tokenize (sourceName pos) $ T.tail txt
1645− getInput >>= setInput . ((Tok pos Symbol "%" : newtoks) ++))
1646− <|> return ()
1647−
1648mathEnvWith :: PandocMonad m
1102mathEnvWith :: PandocMonad m
1649 => (Inlines -> a) -> Maybe Text -> Text -> LP m a
1103 => (Inlines -> a) -> Maybe Text -> Text -> LP m a
1650mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name
1104mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name
@@ -2364,9 +1818,6 @@ isArgTok :: Tok -> Bool
2364isArgTok (Tok _ (Arg _) _) = True
1818isArgTok (Tok _ (Arg _) _) = True
2365isArgTok _ = False
1819isArgTok _ = False
2366
1820
2367−bracedOrToken :: PandocMonad m => LP m [Tok]
2368−bracedOrToken = braced <|> ((:[]) <$> (anyControlSeq <|> singleChar))
2369−
2370newcommand :: PandocMonad m => LP m (Text, Macro)
1821newcommand :: PandocMonad m => LP m (Text, Macro)
2371newcommand = do
1822newcommand = do
2372 pos <- getPosition
1823 pos <- getPosition
@@ -2417,11 +1868,6 @@ newenvironment = do
2417 return (name, Macro ExpandWhenUsed argspecs optarg startcontents,
1868 return (name, Macro ExpandWhenUsed argspecs optarg startcontents,
2418 Macro ExpandWhenUsed [] Nothing endcontents)
1869 Macro ExpandWhenUsed [] Nothing endcontents)
2419
1870
2420−bracketedToks :: PandocMonad m => LP m [Tok]
2421−bracketedToks = do
2422− symbol '['
2423− mconcat <$> manyTill (braced <|> (:[]) <$> anyTok) (symbol ']')
2424−
2425bracketedNum :: PandocMonad m => LP m Int
1871bracketedNum :: PandocMonad m => LP m Int
2426bracketedNum = do
1872bracketedNum = do
2427 ds <- untokenize <$> bracketedToks
1873 ds <- untokenize <$> bracketedToks
src/Text/Pandoc/Readers/LaTeX/Parsing.hsnew file+663
@@ -0,0 +1,663 @@
1+{-# LANGUAGE NoImplicitPrelude #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
6+{-
7+Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu>
8+
9+This program is free software; you can redistribute it and/or modify
10+it under the terms of the GNU General Public License as published by
11+the Free Software Foundation; either version 2 of the License, or
12+(at your option) any later version.
13+
14+This program is distributed in the hope that it will be useful,
15+but WITHOUT ANY WARRANTY; without even the implied warranty of
16+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17+GNU General Public License for more details.
18+
19+You should have received a copy of the GNU General Public License
20+along with this program; if not, write to the Free Software
21+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22+-}
23+
24+{- |
25+ Module : Text.Pandoc.Readers.LaTeX.Parsing
26+ Copyright : Copyright (C) 2006-2018 John MacFarlane
27+ License : GNU GPL, version 2 or above
28+
29+ Maintainer : John MacFarlane <jgm@berkeley.edu>
30+ Stability : alpha
31+ Portability : portable
32+
33+General parsing types and functions for LaTeX.
34+-}
35+module Text.Pandoc.Readers.LaTeX.Parsing
36+ ( DottedNum(..)
37+ , renderDottedNum
38+ , incrementDottedNum
39+ , LaTeXState(..)
40+ , defaultLaTeXState
41+ , LP
42+ , withVerbatimMode
43+ , rawLaTeXParser
44+ , applyMacros
45+ , tokenize
46+ , untokenize
47+ , untoken
48+ , totoks
49+ , toksToString
50+ , satisfyTok
51+ , doMacros
52+ , setpos
53+ , anyControlSeq
54+ , anySymbol
55+ , isWordTok
56+ , isNewlineTok
57+ , spaces
58+ , spaces1
59+ , tokTypeIn
60+ , controlSeq
61+ , symbol
62+ , symbolIn
63+ , sp
64+ , whitespace
65+ , newlineTok
66+ , comment
67+ , anyTok
68+ , singleChar
69+ , specialChars
70+ , endline
71+ , blankline
72+ , primEscape
73+ , bgroup
74+ , egroup
75+ , grouped
76+ , braced
77+ , braced'
78+ , bracedUrl
79+ , bracedOrToken
80+ , bracketed
81+ , bracketedToks
82+ , parenWrapped
83+ , dimenarg
84+ , ignore
85+ , withRaw
86+ ) where
87+
88+import Prelude
89+import Control.Applicative (many, (<|>))
90+import Control.Monad
91+import Control.Monad.Except (throwError)
92+import Control.Monad.Trans (lift)
93+import Data.Char (chr, isAlphaNum, isDigit, isLetter, ord)
94+import Data.Default
95+import Data.List (intercalate)
96+import qualified Data.Map as M
97+import qualified Data.Set as Set
98+import Data.Text (Text)
99+import qualified Data.Text as T
100+import Text.Pandoc.Builder
101+import Text.Pandoc.Class (PandocMonad, report)
102+import Text.Pandoc.Error (PandocError (PandocMacroLoop))
103+import Text.Pandoc.Logging
104+import Text.Pandoc.Options
105+import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,
106+ optional, space, spaces, withRaw, (<|>))
107+import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
108+ ArgSpec (..), Tok (..), TokType (..))
109+import Text.Pandoc.Shared
110+import Text.Parsec.Pos
111+
112+newtype DottedNum = DottedNum [Int]
113+ deriving (Show)
114+
115+renderDottedNum :: DottedNum -> String
116+renderDottedNum (DottedNum xs) =
117+ intercalate "." (map show xs)
118+
119+incrementDottedNum :: Int -> DottedNum -> DottedNum
120+incrementDottedNum level (DottedNum ns) = DottedNum $
121+ case reverse (take level (ns ++ repeat 0)) of
122+ (x:xs) -> reverse (x+1 : xs)
123+ [] -> [] -- shouldn't happen
124+
125+data LaTeXState = LaTeXState{ sOptions :: ReaderOptions
126+ , sMeta :: Meta
127+ , sQuoteContext :: QuoteContext
128+ , sMacros :: M.Map Text Macro
129+ , sContainers :: [String]
130+ , sHeaders :: M.Map Inlines String
131+ , sLogMessages :: [LogMessage]
132+ , sIdentifiers :: Set.Set String
133+ , sVerbatimMode :: Bool
134+ , sCaption :: (Maybe Inlines, Maybe String)
135+ , sInListItem :: Bool
136+ , sInTableCell :: Bool
137+ , sLastHeaderNum :: DottedNum
138+ , sLastFigureNum :: DottedNum
139+ , sLabels :: M.Map String [Inline]
140+ , sHasChapters :: Bool
141+ , sToggles :: M.Map String Bool
142+ }
143+ deriving Show
144+
145+defaultLaTeXState :: LaTeXState
146+defaultLaTeXState = LaTeXState{ sOptions = def
147+ , sMeta = nullMeta
148+ , sQuoteContext = NoQuote
149+ , sMacros = M.empty
150+ , sContainers = []
151+ , sHeaders = M.empty
152+ , sLogMessages = []
153+ , sIdentifiers = Set.empty
154+ , sVerbatimMode = False
155+ , sCaption = (Nothing, Nothing)
156+ , sInListItem = False
157+ , sInTableCell = False
158+ , sLastHeaderNum = DottedNum []
159+ , sLastFigureNum = DottedNum []
160+ , sLabels = M.empty
161+ , sHasChapters = False
162+ , sToggles = M.empty
163+ }
164+
165+instance PandocMonad m => HasQuoteContext LaTeXState m where
166+ getQuoteContext = sQuoteContext <$> getState
167+ withQuoteContext context parser = do
168+ oldState <- getState
169+ let oldQuoteContext = sQuoteContext oldState
170+ setState oldState { sQuoteContext = context }
171+ result <- parser
172+ newState <- getState
173+ setState newState { sQuoteContext = oldQuoteContext }
174+ return result
175+
176+instance HasLogMessages LaTeXState where
177+ addLogMessage msg st = st{ sLogMessages = msg : sLogMessages st }
178+ getLogMessages st = reverse $ sLogMessages st
179+
180+instance HasIdentifierList LaTeXState where
181+ extractIdentifierList = sIdentifiers
182+ updateIdentifierList f st = st{ sIdentifiers = f $ sIdentifiers st }
183+
184+instance HasIncludeFiles LaTeXState where
185+ getIncludeFiles = sContainers
186+ addIncludeFile f s = s{ sContainers = f : sContainers s }
187+ dropLatestIncludeFile s = s { sContainers = drop 1 $ sContainers s }
188+
189+instance HasHeaderMap LaTeXState where
190+ extractHeaderMap = sHeaders
191+ updateHeaderMap f st = st{ sHeaders = f $ sHeaders st }
192+
193+instance HasMacros LaTeXState where
194+ extractMacros st = sMacros st
195+ updateMacros f st = st{ sMacros = f (sMacros st) }
196+
197+instance HasReaderOptions LaTeXState where
198+ extractReaderOptions = sOptions
199+
200+instance HasMeta LaTeXState where
201+ setMeta field val st =
202+ st{ sMeta = setMeta field val $ sMeta st }
203+ deleteMeta field st =
204+ st{ sMeta = deleteMeta field $ sMeta st }
205+
206+instance Default LaTeXState where
207+ def = defaultLaTeXState
208+
209+type LP m = ParserT [Tok] LaTeXState m
210+
211+withVerbatimMode :: PandocMonad m => LP m a -> LP m a
212+withVerbatimMode parser = do
213+ updateState $ \st -> st{ sVerbatimMode = True }
214+ result <- parser
215+ updateState $ \st -> st{ sVerbatimMode = False }
216+ return result
217+
218+rawLaTeXParser :: (PandocMonad m, HasMacros s, HasReaderOptions s)
219+ => Bool -> LP m a -> LP m a -> ParserT String s m (a, String)
220+rawLaTeXParser retokenize parser valParser = do
221+ inp <- getInput
222+ let toks = tokenize "source" $ T.pack inp
223+ pstate <- getState
224+ let lstate = def{ sOptions = extractReaderOptions pstate }
225+ let lstate' = lstate { sMacros = extractMacros pstate }
226+ let rawparser = (,) <$> withRaw valParser <*> getState
227+ res' <- lift $ runParserT (snd <$> withRaw parser) lstate "chunk" toks
228+ case res' of
229+ Left _ -> mzero
230+ Right toks' -> do
231+ res <- lift $ runParserT (do when retokenize $ do
232+ -- retokenize, applying macros
233+ doMacros 0
234+ ts <- many (satisfyTok (const True))
235+ setInput ts
236+ rawparser)
237+ lstate' "chunk" toks'
238+ case res of
239+ Left _ -> mzero
240+ Right ((val, raw), st) -> do
241+ updateState (updateMacros (sMacros st <>))
242+ _ <- takeP (T.length (untokenize toks'))
243+ return (val, T.unpack (untokenize raw))
244+
245+applyMacros :: (PandocMonad m, HasMacros s, HasReaderOptions s)
246+ => String -> ParserT String s m String
247+applyMacros s = (guardDisabled Ext_latex_macros >> return s) <|>
248+ do let retokenize = doMacros 0 *>
249+ (toksToString <$> many (satisfyTok (const True)))
250+ pstate <- getState
251+ let lstate = def{ sOptions = extractReaderOptions pstate
252+ , sMacros = extractMacros pstate }
253+ res <- runParserT retokenize lstate "math" (tokenize "math" (T.pack s))
254+ case res of
255+ Left e -> fail (show e)
256+ Right s' -> return s'
257+tokenize :: SourceName -> Text -> [Tok]
258+tokenize sourcename = totoks (initialPos sourcename)
259+
260+totoks :: SourcePos -> Text -> [Tok]
261+totoks pos t =
262+ case T.uncons t of
263+ Nothing -> []
264+ Just (c, rest)
265+ | c == '\n' ->
266+ Tok pos Newline "\n"
267+ : totoks (setSourceColumn (incSourceLine pos 1) 1) rest
268+ | isSpaceOrTab c ->
269+ let (sps, rest') = T.span isSpaceOrTab t
270+ in Tok pos Spaces sps
271+ : totoks (incSourceColumn pos (T.length sps))
272+ rest'
273+ | isAlphaNum c ->
274+ let (ws, rest') = T.span isAlphaNum t
275+ in Tok pos Word ws
276+ : totoks (incSourceColumn pos (T.length ws)) rest'
277+ | c == '%' ->
278+ let (cs, rest') = T.break (== '\n') rest
279+ in Tok pos Comment ("%" <> cs)
280+ : totoks (incSourceColumn pos (1 + T.length cs)) rest'
281+ | c == '\\' ->
282+ case T.uncons rest of
283+ Nothing -> [Tok pos (CtrlSeq " ") "\\"]
284+ Just (d, rest')
285+ | isLetterOrAt d ->
286+ -- \makeatletter is common in macro defs;
287+ -- ideally we should make tokenization sensitive
288+ -- to \makeatletter and \makeatother, but this is
289+ -- probably best for now
290+ let (ws, rest'') = T.span isLetterOrAt rest
291+ (ss, rest''') = T.span isSpaceOrTab rest''
292+ in Tok pos (CtrlSeq ws) ("\\" <> ws <> ss)
293+ : totoks (incSourceColumn pos
294+ (1 + T.length ws + T.length ss)) rest'''
295+ | isSpaceOrTab d || d == '\n' ->
296+ let (w1, r1) = T.span isSpaceOrTab rest
297+ (w2, (w3, r3)) = case T.uncons r1 of
298+ Just ('\n', r2)
299+ -> (T.pack "\n",
300+ T.span isSpaceOrTab r2)
301+ _ -> (mempty, (mempty, r1))
302+ ws = "\\" <> w1 <> w2 <> w3
303+ in case T.uncons r3 of
304+ Just ('\n', _) ->
305+ Tok pos (CtrlSeq " ") ("\\" <> w1)
306+ : totoks (incSourceColumn pos (T.length ws))
307+ r1
308+ _ ->
309+ Tok pos (CtrlSeq " ") ws
310+ : totoks (incSourceColumn pos (T.length ws))
311+ r3
312+ | otherwise ->
313+ Tok pos (CtrlSeq (T.singleton d)) (T.pack [c,d])
314+ : totoks (incSourceColumn pos 2) rest'
315+ | c == '#' ->
316+ let (t1, t2) = T.span (\d -> d >= '0' && d <= '9') rest
317+ in case safeRead (T.unpack t1) of
318+ Just i ->
319+ Tok pos (Arg i) ("#" <> t1)
320+ : totoks (incSourceColumn pos (1 + T.length t1)) t2
321+ Nothing ->
322+ Tok pos Symbol "#"
323+ : totoks (incSourceColumn pos 1) t2
324+ | c == '^' ->
325+ case T.uncons rest of
326+ Just ('^', rest') ->
327+ case T.uncons rest' of
328+ Just (d, rest'')
329+ | isLowerHex d ->
330+ case T.uncons rest'' of
331+ Just (e, rest''') | isLowerHex e ->
332+ Tok pos Esc2 (T.pack ['^','^',d,e])
333+ : totoks (incSourceColumn pos 4) rest'''
334+ _ ->
335+ Tok pos Esc1 (T.pack ['^','^',d])
336+ : totoks (incSourceColumn pos 3) rest''
337+ | d < '\128' ->
338+ Tok pos Esc1 (T.pack ['^','^',d])
339+ : totoks (incSourceColumn pos 3) rest''
340+ _ -> Tok pos Symbol "^" :
341+ Tok (incSourceColumn pos 1) Symbol "^" :
342+ totoks (incSourceColumn pos 2) rest'
343+ _ -> Tok pos Symbol "^"
344+ : totoks (incSourceColumn pos 1) rest
345+ | otherwise ->
346+ Tok pos Symbol (T.singleton c) : totoks (incSourceColumn pos 1) rest
347+
348+isSpaceOrTab :: Char -> Bool
349+isSpaceOrTab ' ' = True
350+isSpaceOrTab '\t' = True
351+isSpaceOrTab _ = False
352+
353+isLetterOrAt :: Char -> Bool
354+isLetterOrAt '@' = True
355+isLetterOrAt c = isLetter c
356+
357+isLowerHex :: Char -> Bool
358+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
359+
360+untokenize :: [Tok] -> Text
361+untokenize = mconcat . map untoken
362+
363+untoken :: Tok -> Text
364+untoken (Tok _ _ t) = t
365+
366+toksToString :: [Tok] -> String
367+toksToString = T.unpack . untokenize
368+
369+satisfyTok :: PandocMonad m => (Tok -> Bool) -> LP m Tok
370+satisfyTok f =
371+ try $ do
372+ res <- tokenPrim (T.unpack . untoken) updatePos matcher
373+ doMacros 0 -- apply macros on remaining input stream
374+ return res
375+ where matcher t | f t = Just t
376+ | otherwise = Nothing
377+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
378+ updatePos _spos _ (Tok pos _ _ : _) = pos
379+ updatePos spos _ [] = incSourceColumn spos 1
380+
381+doMacros :: PandocMonad m => Int -> LP m ()
382+doMacros n = do
383+ verbatimMode <- sVerbatimMode <$> getState
384+ unless verbatimMode $ do
385+ inp <- getInput
386+ case inp of
387+ Tok spos (CtrlSeq "begin") _ : Tok _ Symbol "{" :
388+ Tok _ Word name : Tok _ Symbol "}" : ts
389+ -> handleMacros spos name ts
390+ Tok spos (CtrlSeq "end") _ : Tok _ Symbol "{" :
391+ Tok _ Word name : Tok _ Symbol "}" : ts
392+ -> handleMacros spos ("end" <> name) ts
393+ Tok _ (CtrlSeq "expandafter") _ : t : ts
394+ -> do setInput ts
395+ doMacros n
396+ getInput >>= setInput . combineTok t
397+ Tok spos (CtrlSeq name) _ : ts
398+ -> handleMacros spos name ts
399+ _ -> return ()
400+ where combineTok (Tok spos (CtrlSeq name) x) (Tok _ Word w : ts)
401+ | T.all isLetterOrAt w =
402+ Tok spos (CtrlSeq (name <> w)) (x1 <> w <> x2) : ts
403+ where (x1, x2) = T.break isSpaceOrTab x
404+ combineTok t ts = t:ts
405+ handleMacros spos name ts = do
406+ macros <- sMacros <$> getState
407+ case M.lookup name macros of
408+ Nothing -> return ()
409+ Just (Macro expansionPoint argspecs optarg newtoks) -> do
410+ setInput ts
411+ let matchTok (Tok _ toktype txt) =
412+ satisfyTok (\(Tok _ toktype' txt') ->
413+ toktype == toktype' &&
414+ txt == txt')
415+ let matchPattern toks = try $ mapM_ matchTok toks
416+ let getargs argmap [] = return argmap
417+ getargs argmap (Pattern toks : rest) = try $ do
418+ matchPattern toks
419+ getargs argmap rest
420+ getargs argmap (ArgNum i : Pattern toks : rest) =
421+ try $ do
422+ x <- mconcat <$> manyTill
423+ (braced <|> ((:[]) <$> anyTok))
424+ (matchPattern toks)
425+ getargs (M.insert i x argmap) rest
426+ getargs argmap (ArgNum i : rest) = do
427+ x <- try $ spaces >> bracedOrToken
428+ getargs (M.insert i x argmap) rest
429+ args <- case optarg of
430+ Nothing -> getargs M.empty argspecs
431+ Just o -> do
432+ x <- option o bracketedToks
433+ getargs (M.singleton 1 x) argspecs
434+ -- first boolean param is true if we're tokenizing
435+ -- an argument (in which case we don't want to
436+ -- expand #1 etc.)
437+ let addTok False (Tok _ (Arg i) _) acc =
438+ case M.lookup i args of
439+ Nothing -> mzero
440+ Just xs -> foldr (addTok True) acc xs
441+ -- see #4007
442+ addTok _ (Tok _ (CtrlSeq x) txt)
443+ acc@(Tok _ Word _ : _)
444+ | not (T.null txt) &&
445+ isLetter (T.last txt) =
446+ Tok spos (CtrlSeq x) (txt <> " ") : acc
447+ addTok _ t acc = setpos spos t : acc
448+ ts' <- getInput
449+ setInput $ foldr (addTok False) ts' newtoks
450+ case expansionPoint of
451+ ExpandWhenUsed ->
452+ if n > 20 -- detect macro expansion loops
453+ then throwError $ PandocMacroLoop (T.unpack name)
454+ else doMacros (n + 1)
455+ ExpandWhenDefined -> return ()
456+
457+
458+setpos :: SourcePos -> Tok -> Tok
459+setpos spos (Tok _ tt txt) = Tok spos tt txt
460+
461+anyControlSeq :: PandocMonad m => LP m Tok
462+anyControlSeq = satisfyTok isCtrlSeq
463+
464+isCtrlSeq :: Tok -> Bool
465+isCtrlSeq (Tok _ (CtrlSeq _) _) = True
466+isCtrlSeq _ = False
467+
468+anySymbol :: PandocMonad m => LP m Tok
469+anySymbol = satisfyTok isSymbolTok
470+
471+isSymbolTok :: Tok -> Bool
472+isSymbolTok (Tok _ Symbol _) = True
473+isSymbolTok _ = False
474+
475+isWordTok :: Tok -> Bool
476+isWordTok (Tok _ Word _) = True
477+isWordTok _ = False
478+
479+spaces :: PandocMonad m => LP m ()
480+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
481+
482+spaces1 :: PandocMonad m => LP m ()
483+spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
484+
485+tokTypeIn :: [TokType] -> Tok -> Bool
486+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
487+
488+controlSeq :: PandocMonad m => Text -> LP m Tok
489+controlSeq name = satisfyTok isNamed
490+ where isNamed (Tok _ (CtrlSeq n) _) = n == name
491+ isNamed _ = False
492+
493+symbol :: PandocMonad m => Char -> LP m Tok
494+symbol c = satisfyTok isc
495+ where isc (Tok _ Symbol d) = case T.uncons d of
496+ Just (c',_) -> c == c'
497+ _ -> False
498+ isc _ = False
499+
500+symbolIn :: PandocMonad m => [Char] -> LP m Tok
501+symbolIn cs = satisfyTok isInCs
502+ where isInCs (Tok _ Symbol d) = case T.uncons d of
503+ Just (c,_) -> c `elem` cs
504+ _ -> False
505+ isInCs _ = False
506+
507+sp :: PandocMonad m => LP m ()
508+sp = whitespace <|> endline
509+
510+whitespace :: PandocMonad m => LP m ()
511+whitespace = () <$ satisfyTok isSpaceTok
512+
513+isSpaceTok :: Tok -> Bool
514+isSpaceTok (Tok _ Spaces _) = True
515+isSpaceTok _ = False
516+
517+newlineTok :: PandocMonad m => LP m ()
518+newlineTok = () <$ satisfyTok isNewlineTok
519+
520+isNewlineTok :: Tok -> Bool
521+isNewlineTok (Tok _ Newline _) = True
522+isNewlineTok _ = False
523+
524+comment :: PandocMonad m => LP m ()
525+comment = () <$ satisfyTok isCommentTok
526+
527+isCommentTok :: Tok -> Bool
528+isCommentTok (Tok _ Comment _) = True
529+isCommentTok _ = False
530+
531+anyTok :: PandocMonad m => LP m Tok
532+anyTok = satisfyTok (const True)
533+
534+singleChar :: PandocMonad m => LP m Tok
535+singleChar = try $ do
536+ Tok pos toktype t <- satisfyTok (tokTypeIn [Word, Symbol])
537+ guard $ not $ toktype == Symbol &&
538+ T.any (`Set.member` specialChars) t
539+ if T.length t > 1
540+ then do
541+ let (t1, t2) = (T.take 1 t, T.drop 1 t)
542+ inp <- getInput
543+ setInput $ Tok (incSourceColumn pos 1) toktype t2 : inp
544+ return $ Tok pos toktype t1
545+ else return $ Tok pos toktype t
546+
547+specialChars :: Set.Set Char
548+specialChars = Set.fromList "#$%&~_^\\{}"
549+
550+endline :: PandocMonad m => LP m ()
551+endline = try $ do
552+ newlineTok
553+ lookAhead anyTok
554+ notFollowedBy blankline
555+
556+blankline :: PandocMonad m => LP m ()
557+blankline = try $ skipMany whitespace *> newlineTok
558+
559+primEscape :: PandocMonad m => LP m Char
560+primEscape = do
561+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
562+ case toktype of
563+ Esc1 -> case T.uncons (T.drop 2 t) of
564+ Just (c, _)
565+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
566+ | otherwise -> return (chr (ord c + 64))
567+ Nothing -> fail "Empty content of Esc1"
568+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
569+ Just x -> return (chr x)
570+ Nothing -> fail $ "Could not read: " ++ T.unpack t
571+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
572+
573+bgroup :: PandocMonad m => LP m Tok
574+bgroup = try $ do
575+ skipMany sp
576+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
577+
578+egroup :: PandocMonad m => LP m Tok
579+egroup = symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup"
580+
581+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
582+grouped parser = try $ do
583+ bgroup
584+ -- first we check for an inner 'grouped', because
585+ -- {{a,b}} should be parsed the same as {a,b}
586+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
587+
588+braced' :: PandocMonad m => LP m Tok -> Int -> LP m [Tok]
589+braced' getTok n =
590+ handleEgroup <|> handleBgroup <|> handleOther
591+ where handleEgroup = do
592+ t <- egroup
593+ if n == 1
594+ then return []
595+ else (t:) <$> braced' getTok (n - 1)
596+ handleBgroup = do
597+ t <- bgroup
598+ (t:) <$> braced' getTok (n + 1)
599+ handleOther = do
600+ t <- getTok
601+ (t:) <$> braced' getTok n
602+
603+braced :: PandocMonad m => LP m [Tok]
604+braced = bgroup *> braced' anyTok 1
605+
606+-- URLs require special handling, because they can contain %
607+-- characters. So we retonenize comments as we go...
608+bracedUrl :: PandocMonad m => LP m [Tok]
609+bracedUrl = bgroup *> braced' (retokenizeComment >> anyTok) 1
610+
611+-- For handling URLs, which allow literal % characters...
612+retokenizeComment :: PandocMonad m => LP m ()
613+retokenizeComment = (do
614+ Tok pos Comment txt <- satisfyTok isCommentTok
615+ let updPos (Tok pos' toktype' txt') =
616+ Tok (incSourceColumn (incSourceLine pos' (sourceLine pos - 1))
617+ (sourceColumn pos)) toktype' txt'
618+ let newtoks = map updPos $ tokenize (sourceName pos) $ T.tail txt
619+ getInput >>= setInput . ((Tok pos Symbol "%" : newtoks) ++))
620+ <|> return ()
621+
622+bracedOrToken :: PandocMonad m => LP m [Tok]
623+bracedOrToken = braced <|> ((:[]) <$> (anyControlSeq <|> singleChar))
624+
625+bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
626+bracketed parser = try $ do
627+ symbol '['
628+ mconcat <$> manyTill parser (symbol ']')
629+
630+bracketedToks :: PandocMonad m => LP m [Tok]
631+bracketedToks = do
632+ symbol '['
633+ mconcat <$> manyTill (braced <|> (:[]) <$> anyTok) (symbol ']')
634+
635+parenWrapped :: PandocMonad m => Monoid a => LP m a -> LP m a
636+parenWrapped parser = try $ do
637+ symbol '('
638+ mconcat <$> manyTill parser (symbol ')')
639+
640+dimenarg :: PandocMonad m => LP m Text
641+dimenarg = try $ do
642+ ch <- option False $ True <$ symbol '='
643+ Tok _ _ s <- satisfyTok isWordTok
644+ guard $ T.take 2 (T.reverse s) `elem`
645+ ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
646+ let num = T.take (T.length s - 2) s
647+ guard $ T.length num > 0
648+ guard $ T.all isDigit num
649+ return $ T.pack ['=' | ch] <> s
650+
651+ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
652+ignore raw = do
653+ pos <- getPosition
654+ report $ SkippedContent raw pos
655+ return mempty
656+
657+withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
658+withRaw parser = do
659+ inp <- getInput
660+ result <- parser
661+ nxt <- option (Tok (initialPos "source") Word "") (lookAhead anyTok)
662+ let raw = takeWhile (/= nxt) inp
663+ return (result, raw)