git.iko.soy/typeable/pandoc
on master help sign in
Added Text.Pandoc.Readers.LaTeX.Parsing (unexported).

This collects some of the general-purpose code from the LaTeX reader, with the aim of making the module smaller. (We've been having out-of-memory issues compiling this module on CI.)

commit9dac993835603a1a92136f07e80a6561b1598754 authorJohn MacFarlane <jgm@berkeley.edu> dateFri 28 Sep 2018, 10:33 (8 years ago) parent4f9ab7e
3 files changed+667−557
pandoc.cabal+1 src/Text/Pandoc/Readers/LaTeX.hs+3−557 src/Text/Pandoc/Readers/LaTeX/Parsing.hs+663
pandoc.cabal+1
@@ -508,6 +508,7 @@ library
508508 Text.Pandoc.Readers.Docx.Util,
509509 Text.Pandoc.Readers.Docx.StyleMap,
510510 Text.Pandoc.Readers.Docx.Fields,
511+ Text.Pandoc.Readers.LaTeX.Parsing,
511512 Text.Pandoc.Readers.Odt.Base,
512513 Text.Pandoc.Readers.Odt.Namespaces,
513514 Text.Pandoc.Readers.Odt.StyleReader,
src/Text/Pandoc/Readers/LaTeX.hs+3−557
@@ -47,8 +47,7 @@ import Prelude
4747import Control.Applicative (many, optional, (<|>))
4848import Control.Monad
4949import 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)
5251import Data.Default
5352import Data.List (intercalate, isPrefixOf)
5453import qualified Data.Map as M
@@ -63,7 +62,7 @@ import Text.Pandoc.Builder
6362import Text.Pandoc.Class (PandocMonad, PandocPure, getResourcePath, lookupEnv,
6463 readFileFromDirs, report, setResourcePath,
6564 setTranslations, translateTerm, trace)
66−import Text.Pandoc.Error (PandocError (PandocMacroLoop, PandocParseError, PandocParsecError))
65+import Text.Pandoc.Error (PandocError ( PandocParseError, PandocParsecError))
6766import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
6867import Text.Pandoc.ImageSize (numUnit, showFl)
6968import Text.Pandoc.Logging
@@ -72,10 +71,10 @@ import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,
7271 optional, space, spaces, withRaw, (<|>))
7372import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
7473 ArgSpec (..), Tok (..), TokType (..))
74+import Text.Pandoc.Readers.LaTeX.Parsing
7575import Text.Pandoc.Shared
7676import qualified Text.Pandoc.Translations as Translations
7777import Text.Pandoc.Walk
78−import Text.Parsec.Pos
7978import qualified Text.Pandoc.Builder as B
8079
8180-- for debugging:
@@ -137,151 +136,6 @@ resolveRefs _ x = x
137136-- Left e -> error (show e)
138137-- Right r -> return r
139138
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'
285139
286140rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)
287141 => ParserT String s m String
@@ -326,358 +180,6 @@ inlineCommand = do
326180 lookAhead (try (char '\\' >> letter))
327181 fst <$> rawLaTeXParser True (inlineEnvironment <|> inlineCommand') inlines
328182
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−
681183-- inline elements:
682184
683185word :: PandocMonad m => LP m Inlines
@@ -689,13 +191,6 @@ regularSymbol = (str . T.unpack . untoken) <$> satisfyTok isRegularSymbol
689191 isRegularSymbol _ = False
690192 isSpecial c = c `Set.member` specialChars
691193
692−specialChars :: Set.Set Char
693−specialChars = Set.fromList "#$%&~_^\\{}"
694−
695−isWordTok :: Tok -> Bool
696−isWordTok (Tok _ Word _) = True
697−isWordTok _ = False
698−
699194inlineGroup :: PandocMonad m => LP m Inlines
700195inlineGroup = do
701196 ils <- grouped inline
@@ -1396,9 +891,6 @@ breve 'U' = "Ŭ"
1396891breve 'u' = "ŭ"
1397892breve c = [c]
1398893
1399−toksToString :: [Tok] -> String
1400−toksToString = T.unpack . untokenize
1401−
1402894mathDisplay :: String -> Inlines
1403895mathDisplay = displayMath . trim
1404896
@@ -1562,19 +1054,6 @@ tok = try $ spaces >> grouped inline <|> inlineCommand' <|> singleChar'
15621054 Tok _ _ t <- singleChar
15631055 return (str (T.unpack t))
15641056
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−
15781057opt :: PandocMonad m => LP m Inlines
15791058opt = bracketed inline <|> (str . T.unpack <$> rawopt)
15801059
@@ -1611,20 +1090,6 @@ overlayTok =
16111090 Tok _ Symbol c -> c `elem` ["-","+","@","|",":",","]
16121091 _ -> False)
16131092
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−
16281093inBrackets :: Inlines -> Inlines
16291094inBrackets x = str "[" <> x <> str "]"
16301095
@@ -1634,17 +1099,6 @@ unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
16341099unescapeURL (x:xs) = x:unescapeURL xs
16351100unescapeURL [] = ""
16361101
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−
16481102mathEnvWith :: PandocMonad m
16491103 => (Inlines -> a) -> Maybe Text -> Text -> LP m a
16501104mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name
@@ -2364,9 +1818,6 @@ isArgTok :: Tok -> Bool
23641818isArgTok (Tok _ (Arg _) _) = True
23651819isArgTok _ = False
23661820
2367−bracedOrToken :: PandocMonad m => LP m [Tok]
2368−bracedOrToken = braced <|> ((:[]) <$> (anyControlSeq <|> singleChar))
2369−
23701821newcommand :: PandocMonad m => LP m (Text, Macro)
23711822newcommand = do
23721823 pos <- getPosition
@@ -2417,11 +1868,6 @@ newenvironment = do
24171868 return (name, Macro ExpandWhenUsed argspecs optarg startcontents,
24181869 Macro ExpandWhenUsed [] Nothing endcontents)
24191870
2420−bracketedToks :: PandocMonad m => LP m [Tok]
2421−bracketedToks = do
2422− symbol '['
2423− mconcat <$> manyTill (braced <|> (:[]) <$> anyTok) (symbol ']')
2424−
24251871bracketedNum :: PandocMonad m => LP m Int
24261872bracketedNum = do
24271873 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)