@@ -1,4 +1,7 @@
11{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE PatternGuards #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
25{-# LANGUAGE ScopedTypeVariables #-}
36{-
47Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu>
@@ -28,20 +31,26 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2831 Portability : portable
2932
3033Conversion of LaTeX to 'Pandoc' document.
34+
3135-}
3236module Text.Pandoc.Readers.LaTeX ( readLaTeX,
37+ applyMacros,
3338 rawLaTeXInline,
3439 rawLaTeXBlock,
35− inlineCommand,
40+ macro,
41+ inlineCommand
3642 ) where
3743
3844import Control.Applicative (many, optional, (<|>))
3945import Control.Monad
4046import Control.Monad.Except (throwError)
41−import Data.Char (chr, isAlphaNum, isLetter, ord)
42−import Data.Text (Text, unpack)
47+import Data.Char (chr, isAlphaNum, isLetter, ord, isDigit)
48+import Data.Default
49+import Data.Text (Text)
50+import qualified Data.Text as T
4351import Data.List (intercalate, isPrefixOf)
4452import qualified Data.Map as M
53+import qualified Data.Set as Set
4554import Data.Maybe (fromMaybe, maybeToList)
4655import Safe (minimumDef)
4756import System.FilePath (addExtension, replaceExtension, takeExtension)
@@ -52,10 +61,19 @@ import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
5261import Text.Pandoc.ImageSize (numUnit, showFl)
5362import Text.Pandoc.Logging
5463import Text.Pandoc.Options
55−import Text.Pandoc.Parsing hiding (many, mathDisplay, mathInline, optional,
56− space, (<|>))
64+import Text.Pandoc.Parsing hiding (many, optional, withRaw,
65+ mathInline, mathDisplay,
66+ space, (<|>), spaces, blankline)
5767import Text.Pandoc.Shared
68+import Text.Pandoc.Readers.LaTeX.Types (Macro(..), Tok(..),
69+ TokType(..))
5870import Text.Pandoc.Walk
71+import Text.Pandoc.Error (PandocError(PandocParsecError, PandocMacroLoop))
72+
73+-- for debugging:
74+-- import Text.Pandoc.Extensions (getDefaultExtensions)
75+-- import Text.Pandoc.Class (runIOorExplode, PandocIO)
76+-- import Debug.Trace (traceShowId)
5977
6078-- | Parse LaTeX from string and return 'Pandoc' document.
6179readLaTeX :: PandocMonad m
@@ -63,17 +81,18 @@ readLaTeX :: PandocMonad m
6381 -> Text -- ^ String to parse (assumes @'\n'@ line endings)
6482 -> m Pandoc
6583readLaTeX opts ltx = do
66− parsed <- readWithM parseLaTeX def{ stateOptions = opts } (unpack ltx)
84+ parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"
85+ (tokenize (crFilter ltx))
6786 case parsed of
6887 Right result -> return result
69− Left e -> throwError e
88+ Left e -> throwError $ PandocParsecError (T.unpack ltx) e
7089
7190parseLaTeX :: PandocMonad m => LP m Pandoc
7291parseLaTeX = do
7392 bs <- blocks
7493 eof
7594 st <- getState
76− let meta = stateMeta st
95+ let meta = sMeta st
7796 let doc' = doc bs
7897 let headerLevel (Header n _ _) = [n]
7998 headerLevel _ = []
@@ -87,177 +106,476 @@ parseLaTeX = do
87106 else id) doc'
88107 return $ Pandoc meta bs'
89108
90−type LP m = ParserT String ParserState m
91−
92−anyControlSeq :: PandocMonad m => LP m String
93−anyControlSeq = do
94− char '\\'
95− next <- option '\n' anyChar
96− case next of
97− '\n' -> return ""
98− c | isLetter c -> (c:) <$> (many letter <* optional sp)
99− | otherwise -> return [c]
100−
101−controlSeq :: PandocMonad m => String -> LP m String
102−controlSeq name = try $ do
103− char '\\'
104− case name of
105− "" -> mzero
106− [c] | not (isLetter c) -> string [c]
107− cs -> string cs <* notFollowedBy letter <* optional sp
108− return name
109−
110−dimenarg :: PandocMonad m => LP m String
111−dimenarg = try $ do
112− ch <- option "" $ string "="
113− num <- many1 digit
114− dim <- oneOfStrings ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
115− return $ ch ++ num ++ dim
109+-- testParser :: LP PandocIO a -> Text -> IO a
110+-- testParser p t = do
111+-- res <- runIOorExplode (runParserT p defaultLaTeXState{
112+-- sOptions = def{ readerExtensions =
113+-- enableExtension Ext_raw_tex $
114+-- getDefaultExtensions "latex" }} "source" (tokenize t))
115+-- case res of
116+-- Left e -> error (show e)
117+-- Right r -> return r
118+
119+data LaTeXState = LaTeXState{ sOptions :: ReaderOptions
120+ , sMeta :: Meta
121+ , sQuoteContext :: QuoteContext
122+ , sMacros :: M.Map Text Macro
123+ , sContainers :: [String]
124+ , sHeaders :: M.Map Inlines String
125+ , sLogMessages :: [LogMessage]
126+ , sIdentifiers :: Set.Set String
127+ , sVerbatimMode :: Bool
128+ , sCaption :: Maybe Inlines
129+ , sInListItem :: Bool
130+ , sInTableCell :: Bool
131+ }
132+ deriving Show
133+
134+defaultLaTeXState :: LaTeXState
135+defaultLaTeXState = LaTeXState{ sOptions = def
136+ , sMeta = nullMeta
137+ , sQuoteContext = NoQuote
138+ , sMacros = M.empty
139+ , sContainers = []
140+ , sHeaders = M.empty
141+ , sLogMessages = []
142+ , sIdentifiers = Set.empty
143+ , sVerbatimMode = False
144+ , sCaption = Nothing
145+ , sInListItem = False
146+ , sInTableCell = False
147+ }
148+
149+instance PandocMonad m => HasQuoteContext LaTeXState m where
150+ getQuoteContext = sQuoteContext <$> getState
151+ withQuoteContext context parser = do
152+ oldState <- getState
153+ let oldQuoteContext = sQuoteContext oldState
154+ setState oldState { sQuoteContext = context }
155+ result <- parser
156+ newState <- getState
157+ setState newState { sQuoteContext = oldQuoteContext }
158+ return result
159+
160+instance HasLogMessages LaTeXState where
161+ addLogMessage msg st = st{ sLogMessages = msg : sLogMessages st }
162+ getLogMessages st = reverse $ sLogMessages st
163+
164+instance HasIdentifierList LaTeXState where
165+ extractIdentifierList = sIdentifiers
166+ updateIdentifierList f st = st{ sIdentifiers = f $ sIdentifiers st }
167+
168+instance HasIncludeFiles LaTeXState where
169+ getIncludeFiles = sContainers
170+ addIncludeFile f s = s{ sContainers = f : sContainers s }
171+ dropLatestIncludeFile s = s { sContainers = drop 1 $ sContainers s }
172+
173+instance HasHeaderMap LaTeXState where
174+ extractHeaderMap = sHeaders
175+ updateHeaderMap f st = st{ sHeaders = f $ sHeaders st }
176+
177+instance HasMacros LaTeXState where
178+ extractMacros st = sMacros st
179+ updateMacros f st = st{ sMacros = f (sMacros st) }
180+
181+instance HasReaderOptions LaTeXState where
182+ extractReaderOptions = sOptions
183+
184+instance HasMeta LaTeXState where
185+ setMeta field val st =
186+ st{ sMeta = setMeta field val $ sMeta st }
187+ deleteMeta field st =
188+ st{ sMeta = deleteMeta field $ sMeta st }
189+
190+instance Default LaTeXState where
191+ def = defaultLaTeXState
192+
193+type LP m = ParserT [Tok] LaTeXState m
194+
195+withVerbatimMode :: PandocMonad m => LP m a -> LP m a
196+withVerbatimMode parser = do
197+ updateState $ \st -> st{ sVerbatimMode = True }
198+ result <- parser
199+ updateState $ \st -> st{ sVerbatimMode = False }
200+ return result
201+
202+rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)
203+ => ParserT String s m String
204+rawLaTeXBlock = do
205+ lookAhead (try (char '\\' >> letter))
206+ inp <- getInput
207+ let toks = tokenize $ T.pack inp
208+ let rawblock = do
209+ (_, raw) <- try $
210+ withRaw (environment <|> macroDef <|> blockCommand)
211+ return raw
212+ pstate <- getState
213+ let lstate = def{ sOptions = extractReaderOptions pstate }
214+ res <- runParserT rawblock lstate "source" toks
215+ case res of
216+ Left _ -> mzero
217+ Right raw -> takeP (T.length (untokenize raw))
218+
219+macro :: (PandocMonad m, HasMacros s, HasReaderOptions s)
220+ => ParserT String s m Blocks
221+macro = do
222+ guardEnabled Ext_latex_macros
223+ lookAhead (char '\\' *> oneOfStrings ["new", "renew", "provide"] *>
224+ oneOfStrings ["command", "environment"])
225+ inp <- getInput
226+ let toks = tokenize $ T.pack inp
227+ let rawblock = do
228+ (_, raw) <- withRaw $ try macroDef
229+ st <- getState
230+ return (raw, st)
231+ pstate <- getState
232+ let lstate = def{ sOptions = extractReaderOptions pstate
233+ , sMacros = extractMacros pstate }
234+ res <- runParserT rawblock lstate "source" toks
235+ case res of
236+ Left _ -> mzero
237+ Right (raw, st) -> do
238+ updateState (updateMacros (const $ sMacros st))
239+ mempty <$ takeP (T.length (untokenize raw))
240+
241+applyMacros :: (PandocMonad m, HasMacros s, HasReaderOptions s)
242+ => String -> ParserT String s m String
243+applyMacros s = do
244+ (guardEnabled Ext_latex_macros >>
245+ do let retokenize = doMacros 0 *> (toksToString <$> getInput)
246+ pstate <- getState
247+ let lstate = def{ sOptions = extractReaderOptions pstate
248+ , sMacros = extractMacros pstate }
249+ res <- runParserT retokenize lstate "math" (tokenize (T.pack s))
250+ case res of
251+ Left e -> fail (show e)
252+ Right s' -> return s') <|> return s
253+
254+rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)
255+ => ParserT String s m String
256+rawLaTeXInline = do
257+ lookAhead (try (char '\\' >> letter) <|> char '$')
258+ inp <- getInput
259+ let toks = tokenize $ T.pack inp
260+ let rawinline = do
261+ (_, raw) <- try $ withRaw (inlineEnvironment <|> inlineCommand')
262+ st <- getState
263+ return (raw, st)
264+ pstate <- getState
265+ let lstate = def{ sOptions = extractReaderOptions pstate
266+ , sMacros = extractMacros pstate }
267+ res <- runParserT rawinline lstate "source" toks
268+ case res of
269+ Left _ -> mzero
270+ Right (raw, s) -> do
271+ updateState $ updateMacros (const $ sMacros s)
272+ takeP (T.length (untokenize raw))
273+
274+inlineCommand :: PandocMonad m => ParserT String ParserState m Inlines
275+inlineCommand = do
276+ lookAhead (try (char '\\' >> letter) <|> char '$')
277+ inp <- getInput
278+ let toks = tokenize $ T.pack inp
279+ let rawinline = do
280+ (il, raw) <- try $ withRaw (inlineEnvironment <|> inlineCommand')
281+ st <- getState
282+ return (il, raw, st)
283+ pstate <- getState
284+ let lstate = def{ sOptions = extractReaderOptions pstate
285+ , sMacros = extractMacros pstate }
286+ res <- runParserT rawinline lstate "source" toks
287+ case res of
288+ Left _ -> mzero
289+ Right (il, raw, s) -> do
290+ updateState $ updateMacros (const $ sMacros s)
291+ takeP (T.length (untokenize raw))
292+ return il
293+
294+tokenize :: Text -> [Tok]
295+tokenize = totoks (1, 1)
296+
297+totoks :: (Line, Column) -> Text -> [Tok]
298+totoks (lin,col) t =
299+ case T.uncons t of
300+ Nothing -> []
301+ Just (c, rest)
302+ | c == '\n' ->
303+ Tok (lin, col) Newline "\n"
304+ : totoks (lin + 1,1) rest
305+ | isSpaceOrTab c ->
306+ let (sps, rest') = T.span isSpaceOrTab t
307+ in Tok (lin, col) Spaces sps
308+ : totoks (lin, col + T.length sps) rest'
309+ | isAlphaNum c ->
310+ let (ws, rest') = T.span isAlphaNum t
311+ in Tok (lin, col) Word ws
312+ : totoks (lin, col + T.length ws) rest'
313+ | c == '%' ->
314+ let (cs, rest') = T.break (== '\n') rest
315+ in Tok (lin, col) Comment ("%" <> cs)
316+ : totoks (lin, col + 1 + T.length cs) rest'
317+ | c == '\\' ->
318+ case T.uncons rest of
319+ Nothing -> [Tok (lin, col) Symbol (T.singleton c)]
320+ Just (d, rest')
321+ | isLetter d ->
322+ let (ws, rest'') = T.span isLetter rest
323+ (ss, rest''') = T.span isSpaceOrTab rest''
324+ in Tok (lin, col) (CtrlSeq ws) ("\\" <> ws <> ss)
325+ : totoks (lin,
326+ col + 1 + T.length ws + T.length ss) rest'''
327+ | d == '\t' || d == '\n' ->
328+ Tok (lin, col) Symbol ("\\")
329+ : totoks (lin, col + 1) rest
330+ | otherwise ->
331+ Tok (lin, col) (CtrlSeq (T.singleton d)) (T.pack [c,d])
332+ : totoks (lin, col + 2) rest'
333+ | c == '#' ->
334+ let (t1, t2) = T.span (\d -> d >= '0' && d <= '9') rest
335+ in case safeRead (T.unpack t1) of
336+ Just i ->
337+ Tok (lin, col) (Arg i) ("#" <> t1)
338+ : totoks (lin, col + 1 + T.length t1) t2
339+ Nothing ->
340+ Tok (lin, col) Symbol ("#")
341+ : totoks (lin, col + 1) t2
342+ | c == '^' ->
343+ case T.uncons rest of
344+ Just ('^', rest') ->
345+ case T.uncons rest' of
346+ Just (d, rest'')
347+ | isLowerHex d ->
348+ case T.uncons rest'' of
349+ Just (e, rest''') | isLowerHex e ->
350+ Tok (lin, col) Esc2 (T.pack ['^','^',d,e])
351+ : totoks (lin, col + 4) rest'''
352+ _ ->
353+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
354+ : totoks (lin, col + 3) rest''
355+ | d < '\128' ->
356+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
357+ : totoks (lin, col + 3) rest''
358+ _ -> [Tok (lin, col) Symbol ("^"),
359+ Tok (lin, col + 1) Symbol ("^")]
360+ _ -> Tok (lin, col) Symbol ("^")
361+ : totoks (lin, col + 1) rest
362+ | otherwise ->
363+ Tok (lin, col) Symbol (T.singleton c) : totoks (lin, col + 1) rest
364+
365+ where isSpaceOrTab ' ' = True
366+ isSpaceOrTab '\t' = True
367+ isSpaceOrTab _ = False
368+
369+isLowerHex :: Char -> Bool
370+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
371+
372+untokenize :: [Tok] -> Text
373+untokenize = mconcat . map untoken
374+
375+untoken :: Tok -> Text
376+untoken (Tok _ _ t) = t
377+
378+satisfyTok :: PandocMonad m => (Tok -> Bool) -> LP m Tok
379+satisfyTok f =
380+ try $ do
381+ res <- tokenPrim (T.unpack . untoken) updatePos matcher
382+ doMacros 0 -- apply macros on remaining input stream
383+ return res
384+ where matcher t | f t = Just t
385+ | otherwise = Nothing
386+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
387+ updatePos spos _ (Tok (lin,col) _ _ : _) =
388+ setSourceColumn (setSourceLine spos lin) col
389+ updatePos spos _ [] = spos
390+
391+doMacros :: PandocMonad m => Int -> LP m ()
392+doMacros n = do
393+ verbatimMode <- sVerbatimMode <$> getState
394+ when (not verbatimMode) $ do
395+ inp <- getInput
396+ case inp of
397+ Tok spos (CtrlSeq "begin") _ : Tok _ Symbol "{" :
398+ Tok _ Word name : Tok _ Symbol "}" : ts
399+ -> handleMacros spos name ts
400+ Tok spos (CtrlSeq "end") _ : Tok _ Symbol "{" :
401+ Tok _ Word name : Tok _ Symbol "}" : ts
402+ -> handleMacros spos ("end" <> name) ts
403+ Tok spos (CtrlSeq name) _ : ts
404+ -> handleMacros spos name ts
405+ _ -> return ()
406+ where handleMacros spos name ts = do
407+ macros <- sMacros <$> getState
408+ case M.lookup name macros of
409+ Nothing -> return ()
410+ Just (Macro numargs optarg newtoks) -> do
411+ setInput ts
412+ let getarg = spaces >> braced
413+ args <- case optarg of
414+ Nothing -> count numargs getarg
415+ Just o ->
416+ (:) <$> option o bracketedToks
417+ <*> count (numargs - 1) getarg
418+ let addTok (Tok _ (Arg i) _) acc | i > 0
419+ , i <= numargs =
420+ map (setpos spos) (args !! (i - 1)) ++ acc
421+ addTok t acc = setpos spos t : acc
422+ ts' <- getInput
423+ setInput $ foldr addTok ts' newtoks
424+ if n > 20 -- detect macro expansion loops
425+ then throwError $ PandocMacroLoop (T.unpack name)
426+ else doMacros (n + 1)
427+
428+setpos :: (Line, Column) -> Tok -> Tok
429+setpos spos (Tok _ tt txt) = Tok spos tt txt
430+
431+anyControlSeq :: PandocMonad m => LP m Tok
432+anyControlSeq = satisfyTok isCtrlSeq
433+ where isCtrlSeq (Tok _ (CtrlSeq _) _) = True
434+ isCtrlSeq _ = False
435+
436+anySymbol :: PandocMonad m => LP m Tok
437+anySymbol = satisfyTok isSym
438+ where isSym (Tok _ Symbol _) = True
439+ isSym _ = False
440+
441+spaces :: PandocMonad m => LP m ()
442+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
443+
444+spaces1 :: PandocMonad m => LP m ()
445+spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
446+
447+tokTypeIn :: [TokType] -> Tok -> Bool
448+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
449+
450+controlSeq :: PandocMonad m => Text -> LP m Tok
451+controlSeq name = satisfyTok isNamed
452+ where isNamed (Tok _ (CtrlSeq n) _) = n == name
453+ isNamed _ = False
454+
455+symbol :: PandocMonad m => Char -> LP m Tok
456+symbol c = satisfyTok isc
457+ where isc (Tok _ Symbol d) = case T.uncons d of
458+ Just (c',_) -> c == c'
459+ _ -> False
460+ isc _ = False
461+
462+symbolIn :: PandocMonad m => [Char] -> LP m Tok
463+symbolIn cs = satisfyTok isInCs
464+ where isInCs (Tok _ Symbol d) = case T.uncons d of
465+ Just (c,_) -> c `elem` cs
466+ _ -> False
467+ isInCs _ = False
116468
117469sp :: PandocMonad m => LP m ()
118470sp = whitespace <|> endline
119471
120472whitespace :: PandocMonad m => LP m ()
121−whitespace = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
473+whitespace = () <$ satisfyTok isSpaceTok
474+ where isSpaceTok (Tok _ Spaces _) = True
475+ isSpaceTok _ = False
122476
123−endline :: PandocMonad m => LP m ()
124−endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
125−
126−isLowerHex :: Char -> Bool
127−isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
477+newlineTok :: PandocMonad m => LP m ()
478+newlineTok = () <$ satisfyTok isNewlineTok
128479
129−tildeEscape :: PandocMonad m => LP m Char
130−tildeEscape = try $ do
131− string "^^"
132− c <- satisfy (\x -> x >= '\0' && x <= '\128')
133− d <- if isLowerHex c
134− then option "" $ count 1 (satisfy isLowerHex)
135− else return ""
136− if null d
137− then case ord c of
138− x | x >= 64 && x <= 127 -> return $ chr (x - 64)
139− | otherwise -> return $ chr (x + 64)
140− else return $ chr $ read ('0':'x':c:d)
480+isNewlineTok :: Tok -> Bool
481+isNewlineTok (Tok _ Newline _) = True
482+isNewlineTok _ = False
141483
142484comment :: PandocMonad m => LP m ()
143−comment = do
144− char '%'
145− skipMany (satisfy (/='\n'))
146− optional newline
147− return ()
485+comment = () <$ satisfyTok isCommentTok
486+ where isCommentTok (Tok _ Comment _) = True
487+ isCommentTok _ = False
488+
489+anyTok :: PandocMonad m => LP m Tok
490+anyTok = satisfyTok (const True)
148491
149−bgroup :: PandocMonad m => LP m ()
492+endline :: PandocMonad m => LP m ()
493+endline = try $ do
494+ newlineTok
495+ lookAhead anyTok
496+ notFollowedBy blankline
497+
498+blankline :: PandocMonad m => LP m ()
499+blankline = try $ skipMany whitespace *> newlineTok
500+
501+primEscape :: PandocMonad m => LP m Char
502+primEscape = do
503+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
504+ case toktype of
505+ Esc1 -> case T.uncons (T.drop 2 t) of
506+ Just (c, _)
507+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
508+ | otherwise -> return (chr (ord c + 64))
509+ Nothing -> fail "Empty content of Esc1"
510+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
511+ Just x -> return (chr x)
512+ Nothing -> fail $ "Could not read: " ++ T.unpack t
513+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
514+
515+bgroup :: PandocMonad m => LP m Tok
150516bgroup = try $ do
151− skipMany (spaceChar <|> try (newline <* notFollowedBy blankline))
152− () <$ char '{'
153− <|> () <$ controlSeq "bgroup"
154− <|> () <$ controlSeq "begingroup"
517+ skipMany sp
518+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
155519
156−egroup :: PandocMonad m => LP m ()
157−egroup = () <$ char '}'
158− <|> () <$ controlSeq "egroup"
159− <|> () <$ controlSeq "endgroup"
520+egroup :: PandocMonad m => LP m Tok
521+egroup = (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup")
160522
161−grouped :: PandocMonad m => Monoid a => LP m a -> LP m a
523+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
162524grouped parser = try $ do
163525 bgroup
164526 -- first we check for an inner 'grouped', because
165527 -- {{a,b}} should be parsed the same as {a,b}
166− try (grouped parser <* egroup)
167− <|> (mconcat <$> manyTill parser egroup)
168−
169−braced :: PandocMonad m => LP m String
170−braced = grouped chunk
171− where chunk =
172− many1 (satisfy (\c -> c /= '\\' && c /= '}' && c /= '{'))
173− <|> try (string "\\}")
174− <|> try (string "\\{")
175− <|> try (string "\\\\")
176− <|> ((\x -> "{" ++ x ++ "}") <$> braced)
177− <|> count 1 anyChar
528+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
529+
530+braced :: PandocMonad m => LP m [Tok]
531+braced = bgroup *> braced' 1
532+ where braced' (n :: Int) =
533+ handleEgroup n <|> handleBgroup n <|> handleOther n
534+ handleEgroup n = do
535+ t <- egroup
536+ if n == 1
537+ then return []
538+ else (t:) <$> braced' (n - 1)
539+ handleBgroup n = do
540+ t <- bgroup
541+ (t:) <$> braced' (n + 1)
542+ handleOther n = do
543+ t <- anyTok
544+ (t:) <$> braced' n
178545
179546bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
180−bracketed parser = try $ char '[' *> (mconcat <$> manyTill parser (char ']'))
181−
182−mathDisplay :: PandocMonad m => LP m String -> LP m Inlines
183−mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
184−
185−mathInline :: PandocMonad m => LP m String -> LP m Inlines
186−mathInline p = math <$> (try p >>= applyMacros')
187−
188−mathChars :: PandocMonad m => LP m String
189−mathChars =
190− concat <$> many (escapedChar
191− <|> (snd <$> withRaw braced)
192− <|> many1 (satisfy isOrdChar))
193− where escapedChar = try $ do char '\\'
194− c <- anyChar
195− return ['\\',c]
196− isOrdChar '$' = False
197− isOrdChar '{' = False
198− isOrdChar '}' = False
199− isOrdChar '\\' = False
200− isOrdChar _ = True
201−
202−quoted' :: PandocMonad m => (Inlines -> Inlines) -> LP m String -> LP m () -> LP m Inlines
203−quoted' f starter ender = do
204− startchs <- starter
205− smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
206− if smart
207− then do
208− ils <- many (notFollowedBy ender >> inline)
209− (ender >> return (f (mconcat ils))) <|>
210− (<> mconcat ils) <$>
211− lit (case startchs of
212− "``" -> "“"
213− "`" -> "‘"
214− _ -> startchs)
215− else lit startchs
547+bracketed parser = try $ do
548+ symbol '['
549+ mconcat <$> manyTill parser (symbol ']')
216550
217−doubleQuote :: PandocMonad m => LP m Inlines
218−doubleQuote = do
219− quoted' doubleQuoted (try $ string "``") (void $ try $ string "''")
220− <|> quoted' doubleQuoted (string "“") (void $ char '”')
221− -- the following is used by babel for localized quotes:
222− <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'")
223− <|> quoted' doubleQuoted (string "\"") (void $ char '"')
551+dimenarg :: PandocMonad m => LP m Text
552+dimenarg = try $ do
553+ ch <- option False $ True <$ symbol '='
554+ Tok _ _ s <- satisfyTok isWordTok
555+ guard $ (T.take 2 (T.reverse s)) `elem`
556+ ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
557+ let num = T.take (T.length s - 2) s
558+ guard $ T.length num > 0
559+ guard $ T.all isDigit num
560+ return $ T.pack ['=' | ch] <> s
224561
225−singleQuote :: PandocMonad m => LP m Inlines
226−singleQuote = do
227− smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
228− if smart
229− then quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter)
230− <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter)
231− else str <$> many1 (oneOf "`\'‘’")
562+-- inline elements:
232563
233−inline :: PandocMonad m => LP m Inlines
234−inline = (mempty <$ comment)
235− <|> (space <$ whitespace)
236− <|> (softbreak <$ endline)
237− <|> inlineText
238− <|> inlineCommand
239− <|> inlineEnvironment
240− <|> inlineGroup
241− <|> (char '-' *> option (str "-")
242− (char '-' *> option (str "–") (str "—" <$ char '-')))
243− <|> doubleQuote
244− <|> singleQuote
245− <|> (str "”" <$ try (string "''"))
246− <|> (str "”" <$ char '”')
247− <|> (str "’" <$ char '\'')
248− <|> (str "’" <$ char '’')
249− <|> (str "\160" <$ char '~')
250− <|> mathDisplay (string "$$" *> mathChars <* string "$$")
251− <|> mathInline (char '$' *> mathChars <* char '$')
252− <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
253− <|> (str . (:[]) <$> tildeEscape)
254− <|> (do res <- oneOf "#&~^'`\"[]"
255− pos <- getPosition
256− report $ ParsingUnescaped [res] pos
257− return $ str [res])
564+word :: PandocMonad m => LP m Inlines
565+word = (str . T.unpack . untoken) <$> satisfyTok isWordTok
258566
259−inlines :: PandocMonad m => LP m Inlines
260−inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
567+regularSymbol :: PandocMonad m => LP m Inlines
568+regularSymbol = (str . T.unpack . untoken) <$> satisfyTok isRegularSymbol
569+ where isRegularSymbol (Tok _ Symbol t) = not $ T.any isSpecial t
570+ isRegularSymbol _ = False
571+ isSpecial c = c `Set.member` specialChars
572+
573+specialChars :: Set.Set Char
574+specialChars = Set.fromList "#$%&~_^\\{}"
575+
576+isWordTok :: Tok -> Bool
577+isWordTok (Tok _ Word _) = True
578+isWordTok _ = False
261579
262580inlineGroup :: PandocMonad m => LP m Inlines
263581inlineGroup = do
@@ -268,248 +586,562 @@ inlineGroup = do
268586 -- we need the span so we can detitlecase bibtex entries;
269587 -- we need to know when something is {C}apitalized
270588
271−block :: PandocMonad m => LP m Blocks
272−block = (mempty <$ comment)
273− <|> (mempty <$ ((spaceChar <|> newline) *> spaces))
274− <|> environment
275− <|> include
276− <|> macro
277− <|> blockCommand
278− <|> paragraph
279− <|> grouped block
589+doLHSverb :: PandocMonad m => LP m Inlines
590+doLHSverb =
591+ (codeWith ("",["haskell"],[]) . T.unpack . untokenize)
592+ <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')
280593
281−blocks :: PandocMonad m => LP m Blocks
282−blocks = mconcat <$> many block
594+mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines
595+mkImage options src = do
596+ let replaceTextwidth (k,v) =
597+ case numUnit v of
598+ Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
599+ _ -> (k, v)
600+ let kvs = map replaceTextwidth
601+ $ filter (\(k,_) -> k `elem` ["width", "height"]) options
602+ let attr = ("",[], kvs)
603+ let alt = str "image"
604+ case takeExtension src of
605+ "" -> do
606+ defaultExt <- getOption readerDefaultImageExtension
607+ return $ imageWith attr (addExtension src defaultExt) "" alt
608+ _ -> return $ imageWith attr src "" alt
283609
284−getRawCommand :: PandocMonad m => String -> LP m String
285−getRawCommand name' = do
286− rawargs <- withRaw (many (try (optional sp *> opt)) *>
287− option "" (try (optional sp *> dimenarg)) *>
288− many braced)
289− return $ '\\' : name' ++ snd rawargs
610+-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
611+dosiunitx :: PandocMonad m => LP m Inlines
612+dosiunitx = do
613+ skipopts
614+ value <- tok
615+ valueprefix <- option "" $ bracketed tok
616+ unit <- tok
617+ let emptyOr160 "" = ""
618+ emptyOr160 _ = "\160"
619+ return . mconcat $ [valueprefix,
620+ emptyOr160 valueprefix,
621+ value,
622+ emptyOr160 unit,
623+ unit]
290624
291−lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
292−lookupListDefault d = (fromMaybe d .) . lookupList
293− where
294− lookupList l m = msum $ map (`M.lookup` m) l
625+lit :: String -> LP m Inlines
626+lit = pure . str
295627
296−blockCommand :: PandocMonad m => LP m Blocks
297−blockCommand = try $ do
298− name <- anyControlSeq
299− guard $ name /= "begin" && name /= "end"
300− star <- option "" (string "*" <* optional sp)
301− let name' = name ++ star
302− let raw = do
303− rawcommand <- getRawCommand name'
304− transformed <- applyMacros' rawcommand
305− guard $ transformed /= rawcommand
306− notFollowedBy $ parseFromString' inlines transformed
307− parseFromString' blocks transformed
308− lookupListDefault raw [name',name] blockCommands
628+removeDoubleQuotes :: Text -> Text
629+removeDoubleQuotes t =
630+ maybe t id $ T.stripPrefix "\"" t >>= T.stripSuffix "\""
309631
310−inBrackets :: Inlines -> Inlines
311−inBrackets x = str "[" <> x <> str "]"
632+doubleQuote :: PandocMonad m => LP m Inlines
633+doubleQuote = do
634+ quoted' doubleQuoted (try $ count 2 $ symbol '`')
635+ (void $ try $ count 2 $ symbol '\'')
636+ <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')
637+ -- the following is used by babel for localized quotes:
638+ <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])
639+ (void $ try $ sequence [symbol '"', symbol '\''])
640+ <|> quoted' doubleQuoted ((:[]) <$> symbol '"')
641+ (void $ symbol '"')
312642
313−-- eat an optional argument and one or more arguments in braces
314−ignoreInlines :: PandocMonad m => String -> (String, LP m Inlines)
315−ignoreInlines name = (name, p)
316− where
317− p = do oa <- optargs
318− let rawCommand = '\\':name ++ oa
319− let doraw = guardRaw >> return (rawInline "latex" rawCommand)
320− doraw <|> ignore rawCommand
643+singleQuote :: PandocMonad m => LP m Inlines
644+singleQuote = do
645+ quoted' singleQuoted ((:[]) <$> symbol '`')
646+ (try $ symbol '\'' >>
647+ notFollowedBy (satisfyTok startsWithLetter))
648+ <|> quoted' singleQuoted ((:[]) <$> symbol '‘')
649+ (try $ symbol '’' >>
650+ notFollowedBy (satisfyTok startsWithLetter))
651+ where startsWithLetter (Tok _ Word t) =
652+ case T.uncons t of
653+ Just (c, _) | isLetter c -> True
654+ _ -> False
655+ startsWithLetter _ = False
656+
657+quoted' :: PandocMonad m
658+ => (Inlines -> Inlines)
659+ -> LP m [Tok]
660+ -> LP m ()
661+ -> LP m Inlines
662+quoted' f starter ender = do
663+ startchs <- (T.unpack . untokenize) <$> starter
664+ smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
665+ if smart
666+ then do
667+ ils <- many (notFollowedBy ender >> inline)
668+ (ender >> return (f (mconcat ils))) <|>
669+ (<> mconcat ils) <$>
670+ lit (case startchs of
671+ "``" -> "“"
672+ "`" -> "‘"
673+ cs -> cs)
674+ else lit startchs
321675
322−guardRaw :: PandocMonad m => LP m ()
323−guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
676+enquote :: PandocMonad m => LP m Inlines
677+enquote = do
678+ skipopts
679+ quoteContext <- sQuoteContext <$> getState
680+ if quoteContext == InDoubleQuote
681+ then singleQuoted <$> withQuoteContext InSingleQuote tok
682+ else doubleQuoted <$> withQuoteContext InDoubleQuote tok
324683
325−optargs :: PandocMonad m => LP m String
326−optargs = snd <$> withRaw (skipopts *> skipMany (try $ optional sp *> braced))
684+doverb :: PandocMonad m => LP m Inlines
685+doverb = do
686+ Tok _ Symbol t <- anySymbol
687+ marker <- case T.uncons t of
688+ Just (c, ts) | T.null ts -> return c
689+ _ -> mzero
690+ withVerbatimMode $
691+ (code . T.unpack . untokenize) <$>
692+ manyTill (verbTok marker) (symbol marker)
693+
694+verbTok :: PandocMonad m => Char -> LP m Tok
695+verbTok stopchar = do
696+ t@(Tok (lin, col) toktype txt) <- satisfyTok (not . isNewlineTok)
697+ case T.findIndex (== stopchar) txt of
698+ Nothing -> return t
699+ Just i -> do
700+ let (t1, t2) = T.splitAt i txt
701+ inp <- getInput
702+ setInput $ Tok (lin, col + i) Symbol (T.singleton stopchar)
703+ : (totoks (lin, col + i + 1) (T.drop 1 t2)) ++ inp
704+ return $ Tok (lin, col) toktype t1
327705
328−ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
329−ignore raw = do
330− pos <- getPosition
331− report $ SkippedContent raw pos
332− return mempty
706+dolstinline :: PandocMonad m => LP m Inlines
707+dolstinline = do
708+ options <- option [] keyvals
709+ let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
710+ Tok _ Symbol t <- anySymbol
711+ marker <- case T.uncons t of
712+ Just (c, ts) | T.null ts -> return c
713+ _ -> mzero
714+ let stopchar = if marker == '{' then '}' else marker
715+ withVerbatimMode $
716+ (codeWith ("",classes,[]) . T.unpack . untokenize) <$>
717+ manyTill (verbTok stopchar) (symbol stopchar)
333718
334−ignoreBlocks :: PandocMonad m => String -> (String, LP m Blocks)
335−ignoreBlocks name = (name, p)
336− where
337− p = do oa <- optargs
338− let rawCommand = '\\':name ++ oa
339− let doraw = guardRaw >> return (rawBlock "latex" rawCommand)
340− doraw <|> ignore rawCommand
719+keyval :: PandocMonad m => LP m (String, String)
720+keyval = try $ do
721+ Tok _ Word key <- satisfyTok isWordTok
722+ let isSpecSym (Tok _ Symbol t) = t `elem` [".",":","-","|","\\"]
723+ isSpecSym _ = False
724+ val <- option [] $ do
725+ symbol '='
726+ braced <|> (many1 (satisfyTok isWordTok <|> satisfyTok isSpecSym
727+ <|> anyControlSeq))
728+ optional sp
729+ optional (symbol ',')
730+ optional sp
731+ return (T.unpack key, T.unpack . untokenize $ val)
341732
342−blockCommands :: PandocMonad m => M.Map String (LP m Blocks)
343−blockCommands = M.fromList $
344− [ ("par", mempty <$ skipopts)
345− , ("parbox", braced >> grouped blocks)
346− , ("title", mempty <$ (skipopts *>
347− (grouped inline >>= addMeta "title")
348− <|> (grouped block >>= addMeta "title")))
349− , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
350− , ("author", mempty <$ (skipopts *> authors))
351− -- -- in letter class, temp. store address & sig as title, author
352− , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
353− , ("signature", mempty <$ (skipopts *> authors))
354− , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
355− -- Koma-script metadata commands
356− , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
357− -- sectioning
358− , ("part", section nullAttr (-1))
359− , ("part*", section nullAttr (-1))
360− , ("chapter", section nullAttr 0)
361− , ("chapter*", section ("",["unnumbered"],[]) 0)
362− , ("section", section nullAttr 1)
363− , ("section*", section ("",["unnumbered"],[]) 1)
364− , ("subsection", section nullAttr 2)
365− , ("subsection*", section ("",["unnumbered"],[]) 2)
366− , ("subsubsection", section nullAttr 3)
367− , ("subsubsection*", section ("",["unnumbered"],[]) 3)
368− , ("paragraph", section nullAttr 4)
369− , ("paragraph*", section ("",["unnumbered"],[]) 4)
370− , ("subparagraph", section nullAttr 5)
371− , ("subparagraph*", section ("",["unnumbered"],[]) 5)
372− -- beamer slides
373− , ("frametitle", section nullAttr 3)
374− , ("framesubtitle", section nullAttr 4)
375− -- letters
376− , ("opening", (para . trimInlines) <$> (skipopts *> tok))
377− , ("closing", skipopts *> closing)
378− --
379− , ("hrule", pure horizontalRule)
380− , ("strut", pure mempty)
381− , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
382− , ("item", skipopts *> looseItem)
383− , ("documentclass", skipopts *> braced *> preamble)
384− , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
385− , ("caption", skipopts *> setCaption)
386− , ("bibliography", mempty <$ (skipopts *> braced >>=
387− addMeta "bibliography" . splitBibs))
388− , ("addbibresource", mempty <$ (skipopts *> braced >>=
389− addMeta "bibliography" . splitBibs))
390− -- includes
391− , ("lstinputlisting", inputListing)
392− , ("graphicspath", graphicsPath)
393− -- hyperlink
394− , ("hypertarget", braced >> grouped block)
395− -- LaTeX colors
396− , ("textcolor", coloredBlock "color")
397− , ("colorbox", coloredBlock "background-color")
398− ] ++ map ignoreBlocks
399− -- these commands will be ignored unless --parse-raw is specified,
400− -- in which case they will appear as raw latex blocks
401− [ "newcommand", "renewcommand", "newenvironment", "renewenvironment"
402− -- newcommand, etc. should be parsed by macro, but we need this
403− -- here so these aren't parsed as inline commands to ignore
404− , "special", "pdfannot", "pdfstringdef"
405− , "bibliographystyle"
406− , "maketitle", "makeindex", "makeglossary"
407− , "addcontentsline", "addtocontents", "addtocounter"
408− -- \ignore{} is used conventionally in literate haskell for definitions
409− -- that are to be processed by the compiler but not printed.
410− , "ignore"
411− , "hyperdef"
412− , "markboth", "markright", "markleft"
413− , "hspace", "vspace"
414− , "newpage"
415− , "clearpage"
416− , "pagebreak"
417− ]
733+keyvals :: PandocMonad m => LP m [(String, String)]
734+keyvals = try $ symbol '[' >> manyTill keyval (symbol ']')
418735
419−coloredBlock :: PandocMonad m => String -> LP m Blocks
420−coloredBlock stylename = do
421− skipopts
422− color <- braced
423− let constructor = divWith ("",[],[("style",stylename ++ ": " ++ color)])
424− inlineContents <|> constructor <$> blockContents
425− where inlineContents = do
426− ils <- grouped inline
427− rest <- inlines
428− return (para (ils <> rest))
429− blockContents = grouped block
736+accent :: (Char -> String) -> Inlines -> LP m Inlines
737+accent f ils =
738+ case toList ils of
739+ (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
740+ [] -> mzero
741+ _ -> return ils
430742
431−graphicsPath :: PandocMonad m => LP m Blocks
432−graphicsPath = do
433− ps <- bgroup *> (manyTill braced egroup)
434− getResourcePath >>= setResourcePath . (++ ps)
435− return mempty
743+grave :: Char -> String
744+grave 'A' = "À"
745+grave 'E' = "È"
746+grave 'I' = "Ì"
747+grave 'O' = "Ò"
748+grave 'U' = "Ù"
749+grave 'a' = "à"
750+grave 'e' = "è"
751+grave 'i' = "ì"
752+grave 'o' = "ò"
753+grave 'u' = "ù"
754+grave c = [c]
436755
437−addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
438−addMeta field val = updateState $ \st ->
439− st{ stateMeta = addMetaField field val $ stateMeta st }
756+acute :: Char -> String
757+acute 'A' = "Á"
758+acute 'E' = "É"
759+acute 'I' = "Í"
760+acute 'O' = "Ó"
761+acute 'U' = "Ú"
762+acute 'Y' = "Ý"
763+acute 'a' = "á"
764+acute 'e' = "é"
765+acute 'i' = "í"
766+acute 'o' = "ó"
767+acute 'u' = "ú"
768+acute 'y' = "ý"
769+acute 'C' = "Ć"
770+acute 'c' = "ć"
771+acute 'L' = "Ĺ"
772+acute 'l' = "ĺ"
773+acute 'N' = "Ń"
774+acute 'n' = "ń"
775+acute 'R' = "Ŕ"
776+acute 'r' = "ŕ"
777+acute 'S' = "Ś"
778+acute 's' = "ś"
779+acute 'Z' = "Ź"
780+acute 'z' = "ź"
781+acute c = [c]
440782
441−splitBibs :: String -> [Inlines]
442−splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')
783+circ :: Char -> String
784+circ 'A' = "Â"
785+circ 'E' = "Ê"
786+circ 'I' = "Î"
787+circ 'O' = "Ô"
788+circ 'U' = "Û"
789+circ 'a' = "â"
790+circ 'e' = "ê"
791+circ 'i' = "î"
792+circ 'o' = "ô"
793+circ 'u' = "û"
794+circ 'C' = "Ĉ"
795+circ 'c' = "ĉ"
796+circ 'G' = "Ĝ"
797+circ 'g' = "ĝ"
798+circ 'H' = "Ĥ"
799+circ 'h' = "ĥ"
800+circ 'J' = "Ĵ"
801+circ 'j' = "ĵ"
802+circ 'S' = "Ŝ"
803+circ 's' = "ŝ"
804+circ 'W' = "Ŵ"
805+circ 'w' = "ŵ"
806+circ 'Y' = "Ŷ"
807+circ 'y' = "ŷ"
808+circ c = [c]
443809
444−setCaption :: PandocMonad m => LP m Blocks
445−setCaption = do
446− ils <- tok
447− mblabel <- option Nothing $
448− try $ spaces' >> controlSeq "label" >> (Just <$> tok)
449− let ils' = case mblabel of
450− Just lab -> ils <> spanWith
451− ("",[],[("data-label", stringify lab)]) mempty
452− Nothing -> ils
453− updateState $ \st -> st{ stateCaption = Just ils' }
454− return mempty
810+tilde :: Char -> String
811+tilde 'A' = "Ã"
812+tilde 'a' = "ã"
813+tilde 'O' = "Õ"
814+tilde 'o' = "õ"
815+tilde 'I' = "Ĩ"
816+tilde 'i' = "ĩ"
817+tilde 'U' = "Ũ"
818+tilde 'u' = "ũ"
819+tilde 'N' = "Ñ"
820+tilde 'n' = "ñ"
821+tilde c = [c]
455822
456−resetCaption :: PandocMonad m => LP m ()
457−resetCaption = updateState $ \st -> st{ stateCaption = Nothing }
823+umlaut :: Char -> String
824+umlaut 'A' = "Ä"
825+umlaut 'E' = "Ë"
826+umlaut 'I' = "Ï"
827+umlaut 'O' = "Ö"
828+umlaut 'U' = "Ü"
829+umlaut 'a' = "ä"
830+umlaut 'e' = "ë"
831+umlaut 'i' = "ï"
832+umlaut 'o' = "ö"
833+umlaut 'u' = "ü"
834+umlaut c = [c]
458835
459−authors :: PandocMonad m => LP m ()
460−authors = try $ do
461− bgroup
462− let oneAuthor = mconcat <$>
463− many1 (notFollowedBy' (controlSeq "and") >>
464− (inline <|> mempty <$ blockCommand))
465− -- skip e.g. \vspace{10pt}
466− auths <- sepBy oneAuthor (controlSeq "and")
467− egroup
468− addMeta "author" (map trimInlines auths)
836+hungarumlaut :: Char -> String
837+hungarumlaut 'A' = "A̋"
838+hungarumlaut 'E' = "E̋"
839+hungarumlaut 'I' = "I̋"
840+hungarumlaut 'O' = "Ő"
841+hungarumlaut 'U' = "Ű"
842+hungarumlaut 'Y' = "ӳ"
843+hungarumlaut 'a' = "a̋"
844+hungarumlaut 'e' = "e̋"
845+hungarumlaut 'i' = "i̋"
846+hungarumlaut 'o' = "ő"
847+hungarumlaut 'u' = "ű"
848+hungarumlaut 'y' = "ӳ"
849+hungarumlaut c = [c]
469850
470−section :: PandocMonad m => Attr -> Int -> LP m Blocks
471−section (ident, classes, kvs) lvl = do
472− skipopts
473− contents <- grouped inline
474− lab <- option ident $ try (spaces' >> controlSeq "label" >> spaces' >> braced)
475− attr' <- registerHeader (lab, classes, kvs) contents
476− return $ headerWith attr' lvl contents
851+dot :: Char -> String
852+dot 'C' = "Ċ"
853+dot 'c' = "ċ"
854+dot 'E' = "Ė"
855+dot 'e' = "ė"
856+dot 'G' = "Ġ"
857+dot 'g' = "ġ"
858+dot 'I' = "İ"
859+dot 'Z' = "Ż"
860+dot 'z' = "ż"
861+dot c = [c]
862+
863+macron :: Char -> String
864+macron 'A' = "Ā"
865+macron 'E' = "Ē"
866+macron 'I' = "Ī"
867+macron 'O' = "Ō"
868+macron 'U' = "Ū"
869+macron 'a' = "ā"
870+macron 'e' = "ē"
871+macron 'i' = "ī"
872+macron 'o' = "ō"
873+macron 'u' = "ū"
874+macron c = [c]
875+
876+cedilla :: Char -> String
877+cedilla 'c' = "ç"
878+cedilla 'C' = "Ç"
879+cedilla 's' = "ş"
880+cedilla 'S' = "Ş"
881+cedilla 't' = "ţ"
882+cedilla 'T' = "Ţ"
883+cedilla 'e' = "ȩ"
884+cedilla 'E' = "Ȩ"
885+cedilla 'h' = "ḩ"
886+cedilla 'H' = "Ḩ"
887+cedilla 'o' = "o̧"
888+cedilla 'O' = "O̧"
889+cedilla c = [c]
890+
891+hacek :: Char -> String
892+hacek 'A' = "Ǎ"
893+hacek 'a' = "ǎ"
894+hacek 'C' = "Č"
895+hacek 'c' = "č"
896+hacek 'D' = "Ď"
897+hacek 'd' = "ď"
898+hacek 'E' = "Ě"
899+hacek 'e' = "ě"
900+hacek 'G' = "Ǧ"
901+hacek 'g' = "ǧ"
902+hacek 'H' = "Ȟ"
903+hacek 'h' = "ȟ"
904+hacek 'I' = "Ǐ"
905+hacek 'i' = "ǐ"
906+hacek 'j' = "ǰ"
907+hacek 'K' = "Ǩ"
908+hacek 'k' = "ǩ"
909+hacek 'L' = "Ľ"
910+hacek 'l' = "ľ"
911+hacek 'N' = "Ň"
912+hacek 'n' = "ň"
913+hacek 'O' = "Ǒ"
914+hacek 'o' = "ǒ"
915+hacek 'R' = "Ř"
916+hacek 'r' = "ř"
917+hacek 'S' = "Š"
918+hacek 's' = "š"
919+hacek 'T' = "Ť"
920+hacek 't' = "ť"
921+hacek 'U' = "Ǔ"
922+hacek 'u' = "ǔ"
923+hacek 'Z' = "Ž"
924+hacek 'z' = "ž"
925+hacek c = [c]
926+
927+breve :: Char -> String
928+breve 'A' = "Ă"
929+breve 'a' = "ă"
930+breve 'E' = "Ĕ"
931+breve 'e' = "ĕ"
932+breve 'G' = "Ğ"
933+breve 'g' = "ğ"
934+breve 'I' = "Ĭ"
935+breve 'i' = "ĭ"
936+breve 'O' = "Ŏ"
937+breve 'o' = "ŏ"
938+breve 'U' = "Ŭ"
939+breve 'u' = "ŭ"
940+breve c = [c]
941+
942+toksToString :: [Tok] -> String
943+toksToString = T.unpack . untokenize
944+
945+mathDisplay :: String -> Inlines
946+mathDisplay = displayMath . trim
947+
948+mathInline :: String -> Inlines
949+mathInline = math . trim
950+
951+dollarsMath :: PandocMonad m => LP m Inlines
952+dollarsMath = do
953+ symbol '$'
954+ display <- option False (True <$ symbol '$')
955+ contents <- trim . toksToString <$>
956+ many (notFollowedBy (symbol '$') >> anyTok)
957+ if display
958+ then do
959+ mathDisplay contents <$ try (symbol '$' >> symbol '$')
960+ <|> (guard (null contents) >> return (mathInline ""))
961+ else mathInline contents <$ (symbol '$')
962+
963+-- citations
964+
965+addPrefix :: [Inline] -> [Citation] -> [Citation]
966+addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
967+addPrefix _ _ = []
968+
969+addSuffix :: [Inline] -> [Citation] -> [Citation]
970+addSuffix s ks@(_:_) =
971+ let k = last ks
972+ in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
973+addSuffix _ _ = []
974+
975+simpleCiteArgs :: PandocMonad m => LP m [Citation]
976+simpleCiteArgs = try $ do
977+ first <- optionMaybe $ toList <$> opt
978+ second <- optionMaybe $ toList <$> opt
979+ keys <- try $ bgroup *> (manyTill citationLabel egroup)
980+ let (pre, suf) = case (first , second ) of
981+ (Just s , Nothing) -> (mempty, s )
982+ (Just s , Just t ) -> (s , t )
983+ _ -> (mempty, mempty)
984+ conv k = Citation { citationId = k
985+ , citationPrefix = []
986+ , citationSuffix = []
987+ , citationMode = NormalCitation
988+ , citationHash = 0
989+ , citationNoteNum = 0
990+ }
991+ return $ addPrefix pre $ addSuffix suf $ map conv keys
992+
993+citationLabel :: PandocMonad m => LP m String
994+citationLabel = do
995+ optional sp
996+ toksToString <$>
997+ (many1 (satisfyTok isWordTok <|> symbolIn bibtexKeyChar)
998+ <* optional sp
999+ <* optional (symbol ',')
1000+ <* optional sp)
1001+ where bibtexKeyChar = ".:;?!`'()/*@_+=-[]" :: [Char]
1002+
1003+cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
1004+cites mode multi = try $ do
1005+ cits <- if multi
1006+ then many1 simpleCiteArgs
1007+ else count 1 simpleCiteArgs
1008+ let cs = concat cits
1009+ return $ case mode of
1010+ AuthorInText -> case cs of
1011+ (c:rest) -> c {citationMode = mode} : rest
1012+ [] -> []
1013+ _ -> map (\a -> a {citationMode = mode}) cs
1014+
1015+citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines
1016+citation name mode multi = do
1017+ (c,raw) <- withRaw $ cites mode multi
1018+ return $ cite c (rawInline "latex" $ "\\" ++ name ++ (toksToString raw))
1019+
1020+handleCitationPart :: Inlines -> [Citation]
1021+handleCitationPart ils =
1022+ let isCite Cite{} = True
1023+ isCite _ = False
1024+ (pref, rest) = break isCite (toList ils)
1025+ in case rest of
1026+ (Cite cs _:suff) -> addPrefix pref $ addSuffix suff cs
1027+ _ -> []
1028+
1029+complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
1030+complexNatbibCitation mode = try $ do
1031+ (cs, raw) <-
1032+ withRaw $ concat <$> do
1033+ bgroup
1034+ items <- mconcat <$>
1035+ many1 (notFollowedBy (symbol ';') >> inline)
1036+ `sepBy1` (symbol ';')
1037+ egroup
1038+ return $ map handleCitationPart items
1039+ case cs of
1040+ [] -> mzero
1041+ (c:cits) -> return $ cite (c{ citationMode = mode }:cits)
1042+ (rawInline "latex" $ "\\citetext" ++ toksToString raw)
1043+
1044+inNote :: Inlines -> Inlines
1045+inNote ils =
1046+ note $ para $ ils <> str "."
4771047
478−inlineCommand :: PandocMonad m => LP m Inlines
479−inlineCommand = try $ do
480− (name, raw') <- withRaw anyControlSeq
1048+inlineCommand' :: PandocMonad m => LP m Inlines
1049+inlineCommand' = try $ do
1050+ Tok _ (CtrlSeq name) cmd <- anyControlSeq
4811051 guard $ name /= "begin" && name /= "end"
482− star <- option "" (string "*")
483− let name' = name ++ star
1052+ star <- option "" ("*" <$ symbol '*' <* optional sp)
1053+ let name' = name <> star
1054+ let names = ordNub [name', name] -- check non-starred as fallback
4841055 let raw = do
485− guard $ not (isBlockCommand name)
486− rawargs <- withRaw
487− (skipangles *> skipopts *> option "" dimenarg *> many braced)
488− let rawcommand = raw' ++ star ++ snd rawargs
489− transformed <- applyMacros' rawcommand
490− exts <- getOption readerExtensions
491− if transformed /= rawcommand
492− then parseFromString' inlines transformed
493− else if extensionEnabled Ext_raw_tex exts
494− then return $ rawInline "latex" rawcommand
495− else ignore rawcommand
496− (lookupListDefault raw [name',name] inlineCommands <*
497− optional (try (string "{}")))
498−
499−rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
500−rawInlineOr name' fallback = do
501− parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
502− if parseRaw
503− then rawInline "latex" <$> getRawCommand name'
504− else fallback
1056+ guard $ isInlineCommand name || not (isBlockCommand name)
1057+ rawcommand <- getRawCommand (cmd <> star)
1058+ (guardEnabled Ext_raw_tex >> return (rawInline "latex" rawcommand))
1059+ <|> ignore rawcommand
1060+ lookupListDefault raw names inlineCommands
1061+
1062+tok :: PandocMonad m => LP m Inlines
1063+tok = grouped inline <|> inlineCommand' <|> singleChar
1064+ where singleChar = try $ do
1065+ Tok (lin,col) toktype t <- satisfyTok (tokTypeIn [Word, Symbol])
1066+ guard $ not $ toktype == Symbol &&
1067+ T.any (`Set.member` specialChars) t
1068+ if T.length t > 1
1069+ then do
1070+ let (t1, t2) = (T.take 1 t, T.drop 1 t)
1071+ inp <- getInput
1072+ setInput $ (Tok (lin, col + 1) toktype t2) : inp
1073+ return $ str (T.unpack t1)
1074+ else return $ str (T.unpack t)
1075+
1076+opt :: PandocMonad m => LP m Inlines
1077+opt = bracketed inline
1078+
1079+rawopt :: PandocMonad m => LP m Text
1080+rawopt = do
1081+ symbol '['
1082+ inner <- untokenize <$> manyTill anyTok (symbol ']')
1083+ optional sp
1084+ return $ "[" <> inner <> "]"
1085+
1086+skipopts :: PandocMonad m => LP m ()
1087+skipopts = skipMany rawopt
1088+
1089+-- opts in angle brackets are used in beamer
1090+rawangle :: PandocMonad m => LP m ()
1091+rawangle = try $ do
1092+ symbol '<'
1093+ () <$ manyTill anyTok (symbol '>')
1094+
1095+skipangles :: PandocMonad m => LP m ()
1096+skipangles = skipMany rawangle
1097+
1098+ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
1099+ignore raw = do
1100+ pos <- getPosition
1101+ report $ SkippedContent raw pos
1102+ return mempty
1103+
1104+withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
1105+withRaw parser = do
1106+ inp <- getInput
1107+ result <- parser
1108+ nxt <- option (Tok (0,0) Word "") (lookAhead anyTok)
1109+ let raw = takeWhile (/= nxt) inp
1110+ return (result, raw)
1111+
1112+inBrackets :: Inlines -> Inlines
1113+inBrackets x = str "[" <> x <> str "]"
1114+
1115+unescapeURL :: String -> String
1116+unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
1117+ where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String)
1118+unescapeURL (x:xs) = x:unescapeURL xs
1119+unescapeURL [] = ""
5051120
506−isBlockCommand :: String -> Bool
507−isBlockCommand s = s `M.member` (blockCommands :: M.Map String (LP PandocPure Blocks))
1121+mathEnvWith :: PandocMonad m
1122+ => (Inlines -> a) -> Maybe Text -> Text -> LP m a
1123+mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name
1124+ where inner x = case innerEnv of
1125+ Nothing -> x
1126+ Just y -> "\\begin{" ++ T.unpack y ++ "}\n" ++ x ++
1127+ "\\end{" ++ T.unpack y ++ "}"
1128+
1129+mathEnv :: PandocMonad m => Text -> LP m String
1130+mathEnv name = do
1131+ skipopts
1132+ optional blankline
1133+ res <- manyTill anyTok (end_ name)
1134+ return $ stripTrailingNewlines $ T.unpack $ untokenize res
5081135
1136+inlineEnvironment :: PandocMonad m => LP m Inlines
1137+inlineEnvironment = try $ do
1138+ controlSeq "begin"
1139+ name <- untokenize <$> braced
1140+ M.findWithDefault mzero name inlineEnvironments
5091141
510−inlineEnvironments :: PandocMonad m => M.Map String (LP m Inlines)
511−inlineEnvironments = M.fromList
512− [ ("displaymath", mathEnvWith id Nothing "displaymath")
1142+inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)
1143+inlineEnvironments = M.fromList [
1144+ ("displaymath", mathEnvWith id Nothing "displaymath")
5131145 , ("math", math <$> mathEnv "math")
5141146 , ("equation", mathEnvWith id Nothing "equation")
5151147 , ("equation*", mathEnvWith id Nothing "equation*")
@@ -525,7 +1157,7 @@ inlineEnvironments = M.fromList
5251157 , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
5261158 ]
5271159
528−inlineCommands :: PandocMonad m => M.Map String (LP m Inlines)
1160+inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
5291161inlineCommands = M.fromList $
5301162 [ ("emph", extractSpaces emph <$> tok)
5311163 , ("textit", extractSpaces emph <$> tok)
@@ -554,9 +1186,9 @@ inlineCommands = M.fromList $
5541186 , ("textgreek", tok)
5551187 , ("sep", lit ",")
5561188 , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
557− , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
558− , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
559− , ("ensuremath", mathInline braced)
1189+ , ("(", mathInline . toksToString <$> manyTill anyTok (controlSeq ")"))
1190+ , ("[", mathDisplay . toksToString <$> manyTill anyTok (controlSeq "]"))
1191+ , ("ensuremath", mathInline . toksToString <$> braced)
5601192 , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
5611193 , ("P", lit "¶")
5621194 , ("S", lit "§")
@@ -606,7 +1238,10 @@ inlineCommands = M.fromList $
6061238 , ("v", option (str "v") $ try $ tok >>= accent hacek)
6071239 , ("u", option (str "u") $ try $ tok >>= accent breve)
6081240 , ("i", lit "i")
609− , ("\\", linebreak <$ (optional (bracketed inline) *> spaces'))
1241+ , ("\\", linebreak <$ (do inTableCell <- sInTableCell <$> getState
1242+ guard $ not inTableCell
1243+ optional (bracketed inline)
1244+ spaces))
6101245 , (",", lit "\8198")
6111246 , ("@", pure mempty)
6121247 , (" ", lit "\160")
@@ -621,13 +1256,14 @@ inlineCommands = M.fromList $
6211256 , ("verb", doverb)
6221257 , ("lstinline", dolstinline)
6231258 , ("Verb", doverb)
624− , ("url", (unescapeURL <$> braced) >>= \url ->
625− pure (link url "" (str url)))
626− , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
627− tok >>= \lab ->
628− pure (link url "" lab))
1259+ , ("url", ((unescapeURL . T.unpack . untokenize) <$> braced) >>= \url ->
1260+ pure (link url "" (str url)))
1261+ , ("href", (unescapeURL . toksToString <$>
1262+ braced <* optional sp) >>= \url ->
1263+ tok >>= \lab -> pure (link url "" lab))
6291264 , ("includegraphics", do options <- option [] keyvals
630− src <- unescapeURL . removeDoubleQuotes <$> braced
1265+ src <- unescapeURL . T.unpack .
1266+ removeDoubleQuotes . untokenize <$> braced
6311267 mkImage options src)
6321268 , ("enquote", enquote)
6331269 , ("cite", citation "cite" NormalCitation False)
@@ -703,368 +1339,469 @@ inlineCommands = M.fromList $
7031339 -- fontawesome
7041340 , ("faCheck", lit "\10003")
7051341 , ("faClose", lit "\10007")
706− ] ++ map ignoreInlines
707− -- these commands will be ignored unless --parse-raw is specified,
708− -- in which case they will appear as raw latex blocks:
709− [ "index"
710− , "hspace"
711− , "vspace"
712− , "newpage"
713− , "clearpage"
714− , "pagebreak"
7151342 ]
7161343
7171344coloredInline :: PandocMonad m => String -> LP m Inlines
7181345coloredInline stylename = do
7191346 skipopts
7201347 color <- braced
721− spanWith ("",[],[("style",stylename ++ ": " ++ color)]) <$> tok
1348+ spanWith ("",[],[("style",stylename ++ ": " ++ toksToString color)]) <$> tok
7221349
7231350ttfamily :: PandocMonad m => LP m Inlines
7241351ttfamily = (code . stringify . toList) <$> tok
7251352
726−mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines
727−mkImage options src = do
728− let replaceTextwidth (k,v) = case numUnit v of
729− Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
730− _ -> (k, v)
731− let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options
732− let attr = ("",[], kvs)
733− let alt = str "image"
734− case takeExtension src of
735− "" -> do
736− defaultExt <- getOption readerDefaultImageExtension
737− return $ imageWith attr (addExtension src defaultExt) "" alt
738− _ -> return $ imageWith attr src "" alt
1353+rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines
1354+rawInlineOr name' fallback = do
1355+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
1356+ if parseRaw
1357+ then rawInline "latex" <$> getRawCommand name'
1358+ else fallback
7391359
740−inNote :: Inlines -> Inlines
741−inNote ils =
742− note $ para $ ils <> str "."
1360+getRawCommand :: PandocMonad m => Text -> LP m String
1361+getRawCommand txt = do
1362+ (_, rawargs) <- withRaw
1363+ ((if txt == "\\write"
1364+ then () <$ satisfyTok isWordTok -- digits
1365+ else return ()) *>
1366+ skipangles *>
1367+ skipopts *>
1368+ option "" (try (optional sp *> dimenarg)) *>
1369+ many braced)
1370+ return $ T.unpack (txt <> untokenize rawargs)
1371+
1372+isBlockCommand :: Text -> Bool
1373+isBlockCommand s =
1374+ s `M.member` (blockCommands :: M.Map Text (LP PandocPure Blocks))
1375+ || s `Set.member` treatAsBlock
1376+
1377+treatAsBlock :: Set.Set Text
1378+treatAsBlock = Set.fromList
1379+ [ "newcommand", "renewcommand"
1380+ , "newenvironment", "renewenvironment"
1381+ , "providecommand", "provideenvironment"
1382+ -- newcommand, etc. should be parsed by macroDef, but we need this
1383+ -- here so these aren't parsed as inline commands to ignore
1384+ , "special", "pdfannot", "pdfstringdef"
1385+ , "bibliographystyle"
1386+ , "maketitle", "makeindex", "makeglossary"
1387+ , "addcontentsline", "addtocontents", "addtocounter"
1388+ -- \ignore{} is used conventionally in literate haskell for definitions
1389+ -- that are to be processed by the compiler but not printed.
1390+ , "ignore"
1391+ , "hyperdef"
1392+ , "markboth", "markright", "markleft"
1393+ , "hspace", "vspace"
1394+ , "newpage"
1395+ , "clearpage"
1396+ , "pagebreak"
1397+ ]
1398+
1399+isInlineCommand :: Text -> Bool
1400+isInlineCommand s =
1401+ s `M.member` (inlineCommands :: M.Map Text (LP PandocPure Inlines))
1402+ || s `Set.member` treatAsInline
1403+
1404+treatAsInline :: Set.Set Text
1405+treatAsInline = Set.fromList
1406+ [ "index"
1407+ , "hspace"
1408+ , "vspace"
1409+ , "noindent"
1410+ , "newpage"
1411+ , "clearpage"
1412+ , "pagebreak"
1413+ ]
7431414
744−unescapeURL :: String -> String
745−unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
746− where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String)
747−unescapeURL (x:xs) = x:unescapeURL xs
748−unescapeURL [] = ""
749−
750−enquote :: PandocMonad m => LP m Inlines
751−enquote = do
752− skipopts
753− context <- stateQuoteContext <$> getState
754− if context == InDoubleQuote
755− then singleQuoted <$> withQuoteContext InSingleQuote tok
756− else doubleQuoted <$> withQuoteContext InDoubleQuote tok
757−
758−doverb :: PandocMonad m => LP m Inlines
759−doverb = do
760− marker <- anyChar
761− code <$> manyTill (satisfy (/='\n')) (char marker)
762−
763−dolstinline :: PandocMonad m => LP m Inlines
764−dolstinline = do
765− options <- option [] keyvals
766− let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
767− marker <- char '{' <|> anyChar
768− codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)
769−
770−doLHSverb :: PandocMonad m => LP m Inlines
771−doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
772−
773−-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
774−dosiunitx :: PandocMonad m => LP m Inlines
775−dosiunitx = do
776− skipopts
777− value <- tok
778− valueprefix <- option "" $ char '[' >> (mconcat <$> manyTill tok (char ']'))
779− unit <- tok
780− let emptyOr160 "" = ""
781− emptyOr160 _ = "\160"
782− return . mconcat $ [valueprefix,
783− emptyOr160 valueprefix,
784− value,
785− emptyOr160 unit,
786− unit]
787−
788−lit :: String -> LP m Inlines
789−lit = pure . str
1415+lookupListDefault :: (Show k, Ord k) => v -> [k] -> M.Map k v -> v
1416+lookupListDefault d = (fromMaybe d .) . lookupList
1417+ where lookupList l m = msum $ map (`M.lookup` m) l
7901418
791−accent :: (Char -> String) -> Inlines -> LP m Inlines
792−accent f ils =
793− case toList ils of
794− (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
795− [] -> mzero
796− _ -> return ils
1419+inline :: PandocMonad m => LP m Inlines
1420+inline = (mempty <$ comment)
1421+ <|> (space <$ whitespace)
1422+ <|> (softbreak <$ endline)
1423+ <|> word
1424+ <|> inlineCommand'
1425+ <|> inlineEnvironment
1426+ <|> inlineGroup
1427+ <|> (symbol '-' *>
1428+ option (str "-") (symbol '-' *>
1429+ option (str "–") (str "—" <$ symbol '-')))
1430+ <|> doubleQuote
1431+ <|> singleQuote
1432+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
1433+ <|> (str "”" <$ symbol '”')
1434+ <|> (str "’" <$ symbol '\'')
1435+ <|> (str "’" <$ symbol '’')
1436+ <|> (str "\160" <$ symbol '~')
1437+ <|> dollarsMath
1438+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
1439+ <|> (str . (:[]) <$> primEscape)
1440+ <|> regularSymbol
1441+ <|> (do res <- symbolIn "#^'`\"[]"
1442+ pos <- getPosition
1443+ let s = T.unpack (untoken res)
1444+ report $ ParsingUnescaped s pos
1445+ return $ str s)
7971446
798−grave :: Char -> String
799−grave 'A' = "À"
800−grave 'E' = "È"
801−grave 'I' = "Ì"
802−grave 'O' = "Ò"
803−grave 'U' = "Ù"
804−grave 'a' = "à"
805−grave 'e' = "è"
806−grave 'i' = "ì"
807−grave 'o' = "ò"
808−grave 'u' = "ù"
809−grave c = [c]
1447+inlines :: PandocMonad m => LP m Inlines
1448+inlines = mconcat <$> many inline
8101449
811−acute :: Char -> String
812−acute 'A' = "Á"
813−acute 'E' = "É"
814−acute 'I' = "Í"
815−acute 'O' = "Ó"
816−acute 'U' = "Ú"
817−acute 'Y' = "Ý"
818−acute 'a' = "á"
819−acute 'e' = "é"
820−acute 'i' = "í"
821−acute 'o' = "ó"
822−acute 'u' = "ú"
823−acute 'y' = "ý"
824−acute 'C' = "Ć"
825−acute 'c' = "ć"
826−acute 'L' = "Ĺ"
827−acute 'l' = "ĺ"
828−acute 'N' = "Ń"
829−acute 'n' = "ń"
830−acute 'R' = "Ŕ"
831−acute 'r' = "ŕ"
832−acute 'S' = "Ś"
833−acute 's' = "ś"
834−acute 'Z' = "Ź"
835−acute 'z' = "ź"
836−acute c = [c]
1450+-- block elements:
8371451
838−circ :: Char -> String
839−circ 'A' = "Â"
840−circ 'E' = "Ê"
841−circ 'I' = "Î"
842−circ 'O' = "Ô"
843−circ 'U' = "Û"
844−circ 'a' = "â"
845−circ 'e' = "ê"
846−circ 'i' = "î"
847−circ 'o' = "ô"
848−circ 'u' = "û"
849−circ 'C' = "Ĉ"
850−circ 'c' = "ĉ"
851−circ 'G' = "Ĝ"
852−circ 'g' = "ĝ"
853−circ 'H' = "Ĥ"
854−circ 'h' = "ĥ"
855−circ 'J' = "Ĵ"
856−circ 'j' = "ĵ"
857−circ 'S' = "Ŝ"
858−circ 's' = "ŝ"
859−circ 'W' = "Ŵ"
860−circ 'w' = "ŵ"
861−circ 'Y' = "Ŷ"
862−circ 'y' = "ŷ"
863−circ c = [c]
864−
865−tilde :: Char -> String
866−tilde 'A' = "Ã"
867−tilde 'a' = "ã"
868−tilde 'O' = "Õ"
869−tilde 'o' = "õ"
870−tilde 'I' = "Ĩ"
871−tilde 'i' = "ĩ"
872−tilde 'U' = "Ũ"
873−tilde 'u' = "ũ"
874−tilde 'N' = "Ñ"
875−tilde 'n' = "ñ"
876−tilde c = [c]
1452+begin_ :: PandocMonad m => Text -> LP m ()
1453+begin_ t = (try $ do
1454+ controlSeq "begin"
1455+ spaces
1456+ symbol '{'
1457+ spaces
1458+ Tok _ Word txt <- satisfyTok isWordTok
1459+ spaces
1460+ symbol '}'
1461+ guard (t == txt)) <?> ("\\begin{" ++ T.unpack t ++ "}")
8771462
878−umlaut :: Char -> String
879−umlaut 'A' = "Ä"
880−umlaut 'E' = "Ë"
881−umlaut 'I' = "Ï"
882−umlaut 'O' = "Ö"
883−umlaut 'U' = "Ü"
884−umlaut 'a' = "ä"
885−umlaut 'e' = "ë"
886−umlaut 'i' = "ï"
887−umlaut 'o' = "ö"
888−umlaut 'u' = "ü"
889−umlaut c = [c]
1463+end_ :: PandocMonad m => Text -> LP m ()
1464+end_ t = (try $ do
1465+ controlSeq "end"
1466+ spaces
1467+ symbol '{'
1468+ spaces
1469+ Tok _ Word txt <- satisfyTok isWordTok
1470+ spaces
1471+ symbol '}'
1472+ guard $ t == txt) <?> ("\\end{" ++ T.unpack t ++ "}")
8901473
891−hungarumlaut :: Char -> String
892−hungarumlaut 'A' = "A̋"
893−hungarumlaut 'E' = "E̋"
894−hungarumlaut 'I' = "I̋"
895−hungarumlaut 'O' = "Ő"
896−hungarumlaut 'U' = "Ű"
897−hungarumlaut 'Y' = "ӳ"
898−hungarumlaut 'a' = "a̋"
899−hungarumlaut 'e' = "e̋"
900−hungarumlaut 'i' = "i̋"
901−hungarumlaut 'o' = "ő"
902−hungarumlaut 'u' = "ű"
903−hungarumlaut 'y' = "ӳ"
904−hungarumlaut c = [c]
1474+preamble :: PandocMonad m => LP m Blocks
1475+preamble = mempty <$ many preambleBlock
1476+ where preambleBlock = spaces1
1477+ <|> void include
1478+ <|> void macroDef
1479+ <|> void blockCommand
1480+ <|> void braced
1481+ <|> (notFollowedBy (begin_ "document") >> void anyTok)
9051482
906−dot :: Char -> String
907−dot 'C' = "Ċ"
908−dot 'c' = "ċ"
909−dot 'E' = "Ė"
910−dot 'e' = "ė"
911−dot 'G' = "Ġ"
912−dot 'g' = "ġ"
913−dot 'I' = "İ"
914−dot 'Z' = "Ż"
915−dot 'z' = "ż"
916−dot c = [c]
1483+paragraph :: PandocMonad m => LP m Blocks
1484+paragraph = do
1485+ x <- trimInlines . mconcat <$> many1 inline
1486+ if x == mempty
1487+ then return mempty
1488+ else return $ para x
9171489
918−macron :: Char -> String
919−macron 'A' = "Ā"
920−macron 'E' = "Ē"
921−macron 'I' = "Ī"
922−macron 'O' = "Ō"
923−macron 'U' = "Ū"
924−macron 'a' = "ā"
925−macron 'e' = "ē"
926−macron 'i' = "ī"
927−macron 'o' = "ō"
928−macron 'u' = "ū"
929−macron c = [c]
1490+include :: PandocMonad m => LP m Blocks
1491+include = do
1492+ (Tok _ (CtrlSeq name) _) <-
1493+ controlSeq "include" <|> controlSeq "input" <|>
1494+ controlSeq "subfile" <|> controlSeq "usepackage"
1495+ skipMany $ bracketed inline -- skip options
1496+ fs <- (map trim . splitBy (==',') . T.unpack . untokenize) <$> braced
1497+ let fs' = if name == "usepackage"
1498+ then map (maybeAddExtension ".sty") fs
1499+ else map (maybeAddExtension ".tex") fs
1500+ dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1501+ mconcat <$> mapM (insertIncludedFile blocks (tokenize . T.pack) dirs) fs'
9301502
931−cedilla :: Char -> String
932−cedilla 'c' = "ç"
933−cedilla 'C' = "Ç"
934−cedilla 's' = "ş"
935−cedilla 'S' = "Ş"
936−cedilla 't' = "ţ"
937−cedilla 'T' = "Ţ"
938−cedilla 'e' = "ȩ"
939−cedilla 'E' = "Ȩ"
940−cedilla 'h' = "ḩ"
941−cedilla 'H' = "Ḩ"
942−cedilla 'o' = "o̧"
943−cedilla 'O' = "O̧"
944−cedilla c = [c]
1503+maybeAddExtension :: String -> FilePath -> FilePath
1504+maybeAddExtension ext fp =
1505+ if null (takeExtension fp)
1506+ then addExtension fp ext
1507+ else fp
9451508
946−hacek :: Char -> String
947−hacek 'A' = "Ǎ"
948−hacek 'a' = "ǎ"
949−hacek 'C' = "Č"
950−hacek 'c' = "č"
951−hacek 'D' = "Ď"
952−hacek 'd' = "ď"
953−hacek 'E' = "Ě"
954−hacek 'e' = "ě"
955−hacek 'G' = "Ǧ"
956−hacek 'g' = "ǧ"
957−hacek 'H' = "Ȟ"
958−hacek 'h' = "ȟ"
959−hacek 'I' = "Ǐ"
960−hacek 'i' = "ǐ"
961−hacek 'j' = "ǰ"
962−hacek 'K' = "Ǩ"
963−hacek 'k' = "ǩ"
964−hacek 'L' = "Ľ"
965−hacek 'l' = "ľ"
966−hacek 'N' = "Ň"
967−hacek 'n' = "ň"
968−hacek 'O' = "Ǒ"
969−hacek 'o' = "ǒ"
970−hacek 'R' = "Ř"
971−hacek 'r' = "ř"
972−hacek 'S' = "Š"
973−hacek 's' = "š"
974−hacek 'T' = "Ť"
975−hacek 't' = "ť"
976−hacek 'U' = "Ǔ"
977−hacek 'u' = "ǔ"
978−hacek 'Z' = "Ž"
979−hacek 'z' = "ž"
980−hacek c = [c]
1509+addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
1510+addMeta field val = updateState $ \st ->
1511+ st{ sMeta = addMetaField field val $ sMeta st }
9811512
982−breve :: Char -> String
983−breve 'A' = "Ă"
984−breve 'a' = "ă"
985−breve 'E' = "Ĕ"
986−breve 'e' = "ĕ"
987−breve 'G' = "Ğ"
988−breve 'g' = "ğ"
989−breve 'I' = "Ĭ"
990−breve 'i' = "ĭ"
991−breve 'O' = "Ŏ"
992−breve 'o' = "ŏ"
993−breve 'U' = "Ŭ"
994−breve 'u' = "ŭ"
995−breve c = [c]
1513+authors :: PandocMonad m => LP m ()
1514+authors = try $ do
1515+ bgroup
1516+ let oneAuthor = mconcat <$>
1517+ many1 (notFollowedBy' (controlSeq "and") >>
1518+ (inline <|> mempty <$ blockCommand))
1519+ -- skip e.g. \vspace{10pt}
1520+ auths <- sepBy oneAuthor (controlSeq "and")
1521+ egroup
1522+ addMeta "author" (map trimInlines auths)
9961523
997−tok :: PandocMonad m => LP m Inlines
998−tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar
1524+macroDef :: PandocMonad m => LP m Blocks
1525+macroDef = do
1526+ guardEnabled Ext_latex_macros
1527+ mempty <$ ((commandDef <|> environmentDef) <* doMacros 0)
1528+ where commandDef = do
1529+ (name, macro') <- newcommand
1530+ updateState $ \s -> s{ sMacros = M.insert name macro' (sMacros s) }
1531+ environmentDef = do
1532+ (name, macro1, macro2) <- newenvironment
1533+ updateState $ \s -> s{ sMacros =
1534+ M.insert name macro1 (sMacros s) }
1535+ updateState $ \s -> s{ sMacros =
1536+ M.insert ("end" <> name) macro2 (sMacros s) }
1537+ -- @\newenvironment{envname}[n-args][default]{begin}{end}@
1538+ -- is equivalent to
1539+ -- @\newcommand{\envname}[n-args][default]{begin}@
1540+ -- @\newcommand{\endenvname}@
1541+
1542+newcommand :: PandocMonad m => LP m (Text, Macro)
1543+newcommand = do
1544+ pos <- getPosition
1545+ Tok _ (CtrlSeq mtype) _ <- controlSeq "newcommand" <|>
1546+ controlSeq "renewcommand" <|>
1547+ controlSeq "providecommand"
1548+ optional $ symbol '*'
1549+ Tok _ (CtrlSeq name) txt <- withVerbatimMode $ anyControlSeq <|>
1550+ (symbol '{' *> spaces *> anyControlSeq <* spaces <* symbol '}')
1551+ spaces
1552+ numargs <- option 0 $ try bracketedNum
1553+ spaces
1554+ optarg <- option Nothing $ Just <$> try bracketedToks
1555+ spaces
1556+ contents <- braced
1557+ when (mtype == "newcommand") $ do
1558+ macros <- sMacros <$> getState
1559+ case M.lookup name macros of
1560+ Just _ -> report $ MacroAlreadyDefined (T.unpack txt) pos
1561+ Nothing -> return ()
1562+ return (name, Macro numargs optarg contents)
1563+
1564+newenvironment :: PandocMonad m => LP m (Text, Macro, Macro)
1565+newenvironment = do
1566+ pos <- getPosition
1567+ Tok _ (CtrlSeq mtype) _ <- controlSeq "newenvironment" <|>
1568+ controlSeq "renewenvironment" <|>
1569+ controlSeq "provideenvironment"
1570+ optional $ symbol '*'
1571+ symbol '{'
1572+ spaces
1573+ Tok _ Word name <- satisfyTok isWordTok
1574+ spaces
1575+ symbol '}'
1576+ spaces
1577+ numargs <- option 0 $ try bracketedNum
1578+ spaces
1579+ optarg <- option Nothing $ Just <$> try bracketedToks
1580+ spaces
1581+ startcontents <- braced
1582+ spaces
1583+ endcontents <- braced
1584+ when (mtype == "newenvironment") $ do
1585+ macros <- sMacros <$> getState
1586+ case M.lookup name macros of
1587+ Just _ -> report $ MacroAlreadyDefined (T.unpack name) pos
1588+ Nothing -> return ()
1589+ return (name, Macro numargs optarg startcontents,
1590+ Macro 0 Nothing endcontents)
1591+
1592+bracketedToks :: PandocMonad m => LP m [Tok]
1593+bracketedToks = do
1594+ symbol '['
1595+ manyTill anyTok (symbol ']')
1596+
1597+bracketedNum :: PandocMonad m => LP m Int
1598+bracketedNum = do
1599+ ds <- untokenize <$> bracketedToks
1600+ case safeRead (T.unpack ds) of
1601+ Just i -> return i
1602+ _ -> return 0
9991603
1000−opt :: PandocMonad m => LP m Inlines
1001−opt = bracketed inline
1604+setCaption :: PandocMonad m => LP m Blocks
1605+setCaption = do
1606+ ils <- tok
1607+ mblabel <- option Nothing $
1608+ try $ spaces >> controlSeq "label" >> (Just <$> tok)
1609+ let ils' = case mblabel of
1610+ Just lab -> ils <> spanWith
1611+ ("",[],[("data-label", stringify lab)]) mempty
1612+ Nothing -> ils
1613+ updateState $ \st -> st{ sCaption = Just ils' }
1614+ return mempty
10021615
1003−rawopt :: PandocMonad m => LP m String
1004−rawopt = do
1005− contents <- bracketed (many1 (noneOf "[]") <|> try (string "\\]") <|>
1006− try (string "\\[") <|> rawopt)
1007− optional sp
1008− return $ "[" ++ contents ++ "]"
1616+looseItem :: PandocMonad m => LP m Blocks
1617+looseItem = do
1618+ inListItem <- sInListItem <$> getState
1619+ guard $ not inListItem
1620+ skipopts
1621+ return mempty
10091622
1010−skipopts :: PandocMonad m => LP m ()
1011−skipopts = skipMany rawopt
1623+resetCaption :: PandocMonad m => LP m ()
1624+resetCaption = updateState $ \st -> st{ sCaption = Nothing }
10121625
1013−-- opts in angle brackets are used in beamer
1014−rawangle :: PandocMonad m => LP m ()
1015−rawangle = try $ do
1016− char '<'
1017− skipMany (noneOf ">")
1018− char '>'
1019− return ()
1626+section :: PandocMonad m => Attr -> Int -> LP m Blocks
1627+section (ident, classes, kvs) lvl = do
1628+ skipopts
1629+ contents <- grouped inline
1630+ lab <- option ident $
1631+ try (spaces >> controlSeq "label"
1632+ >> spaces >> toksToString <$> braced)
1633+ attr' <- registerHeader (lab, classes, kvs) contents
1634+ return $ headerWith attr' lvl contents
10201635
1021−skipangles :: PandocMonad m => LP m ()
1022−skipangles = skipMany rawangle
1636+blockCommand :: PandocMonad m => LP m Blocks
1637+blockCommand = try $ do
1638+ Tok _ (CtrlSeq name) txt <- anyControlSeq
1639+ guard $ name /= "begin" && name /= "end"
1640+ star <- option "" ("*" <$ symbol '*' <* optional sp)
1641+ let name' = name <> star
1642+ let names = ordNub [name', name]
1643+ let raw = do
1644+ guard $ isBlockCommand name || not (isInlineCommand name)
1645+ rawBlock "latex" <$> getRawCommand (txt <> star)
1646+ lookupListDefault raw names blockCommands
10231647
1024−inlineText :: PandocMonad m => LP m Inlines
1025−inlineText = str <$> many1 inlineChar
1648+closing :: PandocMonad m => LP m Blocks
1649+closing = do
1650+ contents <- tok
1651+ st <- getState
1652+ let extractInlines (MetaBlocks [Plain ys]) = ys
1653+ extractInlines (MetaBlocks [Para ys ]) = ys
1654+ extractInlines _ = []
1655+ let sigs = case lookupMeta "author" (sMeta st) of
1656+ Just (MetaList xs) ->
1657+ para $ trimInlines $ fromList $
1658+ intercalate [LineBreak] $ map extractInlines xs
1659+ _ -> mempty
1660+ return $ para (trimInlines contents) <> sigs
10261661
1027−inlineChar :: PandocMonad m => LP m Char
1028−inlineChar = noneOf "\\$%&~#{}^'`\"‘’“”-[] \t\n"
1662+blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
1663+blockCommands = M.fromList $
1664+ [ ("par", mempty <$ skipopts)
1665+ , ("parbox", braced >> grouped blocks)
1666+ , ("title", mempty <$ (skipopts *>
1667+ (grouped inline >>= addMeta "title")
1668+ <|> (grouped block >>= addMeta "title")))
1669+ , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
1670+ , ("author", mempty <$ (skipopts *> authors))
1671+ -- -- in letter class, temp. store address & sig as title, author
1672+ , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
1673+ , ("signature", mempty <$ (skipopts *> authors))
1674+ , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
1675+ -- Koma-script metadata commands
1676+ , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
1677+ -- sectioning
1678+ , ("part", section nullAttr (-1))
1679+ , ("part*", section nullAttr (-1))
1680+ , ("chapter", section nullAttr 0)
1681+ , ("chapter*", section ("",["unnumbered"],[]) 0)
1682+ , ("section", section nullAttr 1)
1683+ , ("section*", section ("",["unnumbered"],[]) 1)
1684+ , ("subsection", section nullAttr 2)
1685+ , ("subsection*", section ("",["unnumbered"],[]) 2)
1686+ , ("subsubsection", section nullAttr 3)
1687+ , ("subsubsection*", section ("",["unnumbered"],[]) 3)
1688+ , ("paragraph", section nullAttr 4)
1689+ , ("paragraph*", section ("",["unnumbered"],[]) 4)
1690+ , ("subparagraph", section nullAttr 5)
1691+ , ("subparagraph*", section ("",["unnumbered"],[]) 5)
1692+ -- beamer slides
1693+ , ("frametitle", section nullAttr 3)
1694+ , ("framesubtitle", section nullAttr 4)
1695+ -- letters
1696+ , ("opening", (para . trimInlines) <$> (skipopts *> tok))
1697+ , ("closing", skipopts *> closing)
1698+ --
1699+ , ("hrule", pure horizontalRule)
1700+ , ("strut", pure mempty)
1701+ , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
1702+ , ("item", looseItem)
1703+ , ("documentclass", skipopts *> braced *> preamble)
1704+ , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
1705+ , ("caption", skipopts *> setCaption)
1706+ , ("bibliography", mempty <$ (skipopts *> braced >>=
1707+ addMeta "bibliography" . splitBibs . toksToString))
1708+ , ("addbibresource", mempty <$ (skipopts *> braced >>=
1709+ addMeta "bibliography" . splitBibs . toksToString))
1710+ -- includes
1711+ , ("lstinputlisting", inputListing)
1712+ , ("graphicspath", graphicsPath)
1713+ -- hyperlink
1714+ , ("hypertarget", try $ braced >> grouped block)
1715+ -- LaTeX colors
1716+ , ("textcolor", coloredBlock "color")
1717+ , ("colorbox", coloredBlock "background-color")
1718+ ]
1719+
1720+
1721+environments :: PandocMonad m => M.Map Text (LP m Blocks)
1722+environments = M.fromList
1723+ [ ("document", env "document" blocks)
1724+ , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
1725+ , ("letter", env "letter" letterContents)
1726+ , ("minipage", env "minipage" $
1727+ skipopts *> spaces *> optional braced *> spaces *> blocks)
1728+ , ("figure", env "figure" $ skipopts *> figure)
1729+ , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
1730+ , ("center", env "center" blocks)
1731+ , ("longtable", env "longtable" $
1732+ resetCaption *> simpTable "longtable" False >>= addTableCaption)
1733+ , ("table", env "table" $
1734+ resetCaption *> skipopts *> blocks >>= addTableCaption)
1735+ , ("tabular*", env "tabular" $ simpTable "tabular*" True)
1736+ , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1737+ , ("tabular", env "tabular" $ simpTable "tabular" False)
1738+ , ("quote", blockQuote <$> env "quote" blocks)
1739+ , ("quotation", blockQuote <$> env "quotation" blocks)
1740+ , ("verse", blockQuote <$> env "verse" blocks)
1741+ , ("itemize", bulletList <$> listenv "itemize" (many item))
1742+ , ("description", definitionList <$> listenv "description" (many descItem))
1743+ , ("enumerate", orderedList')
1744+ , ("alltt", alltt <$> env "alltt" blocks)
1745+ , ("code", guardEnabled Ext_literate_haskell *>
1746+ (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
1747+ verbEnv "code"))
1748+ , ("comment", mempty <$ verbEnv "comment")
1749+ , ("verbatim", codeBlock <$> verbEnv "verbatim")
1750+ , ("Verbatim", fancyverbEnv "Verbatim")
1751+ , ("BVerbatim", fancyverbEnv "BVerbatim")
1752+ , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals
1753+ codeBlockWith attr <$> verbEnv "lstlisting")
1754+ , ("minted", minted)
1755+ , ("obeylines", obeylines)
1756+ , ("displaymath", mathEnvWith para Nothing "displaymath")
1757+ , ("equation", mathEnvWith para Nothing "equation")
1758+ , ("equation*", mathEnvWith para Nothing "equation*")
1759+ , ("gather", mathEnvWith para (Just "gathered") "gather")
1760+ , ("gather*", mathEnvWith para (Just "gathered") "gather*")
1761+ , ("multline", mathEnvWith para (Just "gathered") "multline")
1762+ , ("multline*", mathEnvWith para (Just "gathered") "multline*")
1763+ , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray")
1764+ , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*")
1765+ , ("align", mathEnvWith para (Just "aligned") "align")
1766+ , ("align*", mathEnvWith para (Just "aligned") "align*")
1767+ , ("alignat", mathEnvWith para (Just "aligned") "alignat")
1768+ , ("alignat*", mathEnvWith para (Just "aligned") "alignat*")
1769+ , ("tikzpicture", rawVerbEnv "tikzpicture")
1770+ ]
10291771
10301772environment :: PandocMonad m => LP m Blocks
10311773environment = do
10321774 controlSeq "begin"
1033− name <- braced
1775+ name <- untokenize <$> braced
10341776 M.findWithDefault mzero name environments
10351777 <|> rawEnv name
10361778
1037−inlineEnvironment :: PandocMonad m => LP m Inlines
1038−inlineEnvironment = try $ do
1039− controlSeq "begin"
1040− name <- braced
1041− M.findWithDefault mzero name inlineEnvironments
1779+env :: PandocMonad m => Text -> LP m a -> LP m a
1780+env name p = p <* end_ name
10421781
1043−rawEnv :: PandocMonad m => String -> LP m Blocks
1782+rawEnv :: PandocMonad m => Text -> LP m Blocks
10441783rawEnv name = do
10451784 exts <- getOption readerExtensions
10461785 let parseRaw = extensionEnabled Ext_raw_tex exts
10471786 rawOptions <- mconcat <$> many rawopt
1048− let beginCommand = "\\begin{" ++ name ++ "}" ++ rawOptions
1787+ let beginCommand = "\\begin{" <> name <> "}" <> rawOptions
10491788 pos1 <- getPosition
10501789 (bs, raw) <- withRaw $ env name blocks
1051− raw' <- applyMacros' $ beginCommand ++ raw
1052− if raw' /= beginCommand ++ raw
1053− then parseFromString' blocks raw'
1054− else if parseRaw
1055− then return $ rawBlock "latex" $ beginCommand ++ raw'
1056− else do
1057− unless parseRaw $ do
1058− report $ SkippedContent beginCommand pos1
1059− pos2 <- getPosition
1060− report $ SkippedContent ("\\end{" ++ name ++ "}") pos2
1061− return bs
1062−
1063−rawVerbEnv :: PandocMonad m => String -> LP m Blocks
1790+ if parseRaw
1791+ then return $ rawBlock "latex"
1792+ $ T.unpack $ beginCommand <> untokenize raw
1793+ else do
1794+ unless parseRaw $ do
1795+ report $ SkippedContent (T.unpack beginCommand) pos1
1796+ pos2 <- getPosition
1797+ report $ SkippedContent ("\\end{" ++ T.unpack name ++ "}") pos2
1798+ return bs
1799+
1800+rawVerbEnv :: PandocMonad m => Text -> LP m Blocks
10641801rawVerbEnv name = do
10651802 pos <- getPosition
10661803 (_, raw) <- withRaw $ verbEnv name
1067− let raw' = "\\begin{tikzpicture}" ++ raw
1804+ let raw' = "\\begin{tikzpicture}" ++ toksToString raw
10681805 exts <- getOption readerExtensions
10691806 let parseRaw = extensionEnabled Ext_raw_tex exts
10701807 if parseRaw
@@ -1073,36 +1810,118 @@ rawVerbEnv name = do
10731810 report $ SkippedContent raw' pos
10741811 return mempty
10751812
1076−----
1813+verbEnv :: PandocMonad m => Text -> LP m String
1814+verbEnv name = withVerbatimMode $ do
1815+ skipopts
1816+ optional blankline
1817+ res <- manyTill anyTok (end_ name)
1818+ return $ stripTrailingNewlines $ toksToString res
1819+
1820+fancyverbEnv :: PandocMonad m => Text -> LP m Blocks
1821+fancyverbEnv name = do
1822+ options <- option [] keyvals
1823+ let kvs = [ (if k == "firstnumber"
1824+ then "startFrom"
1825+ else k, v) | (k,v) <- options ]
1826+ let classes = [ "numberLines" |
1827+ lookup "numbers" options == Just "left" ]
1828+ let attr = ("",classes,kvs)
1829+ codeBlockWith attr <$> verbEnv name
1830+
1831+obeylines :: PandocMonad m => LP m Blocks
1832+obeylines = do
1833+ para . fromList . removeLeadingTrailingBreaks .
1834+ walk softBreakToHard . toList <$> env "obeylines" inlines
1835+ where softBreakToHard SoftBreak = LineBreak
1836+ softBreakToHard x = x
1837+ removeLeadingTrailingBreaks = reverse . dropWhile isLineBreak .
1838+ reverse . dropWhile isLineBreak
1839+ isLineBreak LineBreak = True
1840+ isLineBreak _ = False
1841+
1842+minted :: PandocMonad m => LP m Blocks
1843+minted = do
1844+ options <- option [] keyvals
1845+ lang <- toksToString <$> braced
1846+ let kvs = [ (if k == "firstnumber"
1847+ then "startFrom"
1848+ else k, v) | (k,v) <- options ]
1849+ let classes = [ lang | not (null lang) ] ++
1850+ [ "numberLines" |
1851+ lookup "linenos" options == Just "true" ]
1852+ let attr = ("",classes,kvs)
1853+ codeBlockWith attr <$> verbEnv "minted"
1854+
1855+letterContents :: PandocMonad m => LP m Blocks
1856+letterContents = do
1857+ bs <- blocks
1858+ st <- getState
1859+ -- add signature (author) and address (title)
1860+ let addr = case lookupMeta "address" (sMeta st) of
1861+ Just (MetaBlocks [Plain xs]) ->
1862+ para $ trimInlines $ fromList xs
1863+ _ -> mempty
1864+ return $ addr <> bs -- sig added by \closing
1865+
1866+figure :: PandocMonad m => LP m Blocks
1867+figure = try $ do
1868+ resetCaption
1869+ blocks >>= addImageCaption
1870+
1871+addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
1872+addImageCaption = walkM go
1873+ where go (Image attr alt (src,tit))
1874+ | not ("fig:" `isPrefixOf` tit) = do
1875+ mbcapt <- sCaption <$> getState
1876+ return $ case mbcapt of
1877+ Just ils -> Image attr (toList ils) (src, "fig:" ++ tit)
1878+ Nothing -> Image attr alt (src,tit)
1879+ go x = return x
1880+
1881+coloredBlock :: PandocMonad m => String -> LP m Blocks
1882+coloredBlock stylename = do
1883+ skipopts
1884+ color <- braced
1885+ let constructor = divWith ("",[],[("style",stylename ++ ": " ++ toksToString color)])
1886+ inlineContents <|> constructor <$> blockContents
1887+ where inlineContents = do
1888+ ils <- grouped inline
1889+ rest <- inlines
1890+ return (para (ils <> rest))
1891+ blockContents = grouped block
10771892
1078−maybeAddExtension :: String -> FilePath -> FilePath
1079−maybeAddExtension ext fp =
1080− if null (takeExtension fp)
1081− then addExtension fp ext
1082− else fp
1893+graphicsPath :: PandocMonad m => LP m Blocks
1894+graphicsPath = do
1895+ ps <- map toksToString <$> (bgroup *> manyTill braced egroup)
1896+ getResourcePath >>= setResourcePath . (++ ps)
1897+ return mempty
10831898
1084−include :: PandocMonad m => LP m Blocks
1085−include = do
1086− fs' <- try $ do
1087− char '\\'
1088− name <- try (string "include")
1089− <|> try (string "input")
1090− <|> try (string "subfile")
1091− <|> string "usepackage"
1092− -- skip options
1093− skipMany $ try $ char '[' *> manyTill anyChar (char ']')
1094− fs <- (map trim . splitBy (==',')) <$> braced
1095− return $ if name == "usepackage"
1096− then map (maybeAddExtension ".sty") fs
1097− else map (maybeAddExtension ".tex") fs
1098− dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1099− mconcat <$> mapM (insertIncludedFile blocks dirs) fs'
1899+splitBibs :: String -> [Inlines]
1900+splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')
1901+
1902+alltt :: Blocks -> Blocks
1903+alltt = walk strToCode
1904+ where strToCode (Str s) = Code nullAttr s
1905+ strToCode Space = RawInline (Format "latex") "\\ "
1906+ strToCode SoftBreak = LineBreak
1907+ strToCode x = x
1908+
1909+parseListingsOptions :: [(String, String)] -> Attr
1910+parseListingsOptions options =
1911+ let kvs = [ (if k == "firstnumber"
1912+ then "startFrom"
1913+ else k, v) | (k,v) <- options ]
1914+ classes = [ "numberLines" |
1915+ lookup "numbers" options == Just "left" ]
1916+ ++ maybeToList (lookup "language" options
1917+ >>= fromListingsLanguage)
1918+ in (fromMaybe "" (lookup "label" options), classes, kvs)
11001919
11011920inputListing :: PandocMonad m => LP m Blocks
11021921inputListing = do
11031922 pos <- getPosition
11041923 options <- option [] keyvals
1105− f <- filter (/='"') <$> braced
1924+ f <- filter (/='"') . toksToString <$> braced
11061925 dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
11071926 mbCode <- readFileFromDirs dirs f
11081927 codeLines <- case mbCode of
@@ -1121,169 +1940,10 @@ inputListing = do
11211940 drop (firstline - 1) codeLines
11221941 return $ codeBlockWith (ident,ordNub (classes ++ language),kvs) codeContents
11231942
1124−parseListingsOptions :: [(String, String)] -> Attr
1125−parseListingsOptions options =
1126− let kvs = [ (if k == "firstnumber"
1127− then "startFrom"
1128− else k, v) | (k,v) <- options ]
1129− classes = [ "numberLines" |
1130− lookup "numbers" options == Just "left" ]
1131− ++ maybeToList (lookup "language" options
1132− >>= fromListingsLanguage)
1133− in (fromMaybe "" (lookup "label" options), classes, kvs)
1134−
1135−----
1136−
1137−keyval :: PandocMonad m => LP m (String, String)
1138−keyval = try $ do
1139− key <- many1 alphaNum
1140− val <- option "" $ char '=' >> braced <|> (many1 (alphaNum <|> oneOf ".:-|\\"))
1141− skipMany spaceChar
1142− optional (char ',')
1143− skipMany spaceChar
1144− return (key, val)
1145−
1146−
1147−keyvals :: PandocMonad m => LP m [(String, String)]
1148−keyvals = try $ char '[' *> manyTill keyval (char ']')
1149−
1150−alltt :: PandocMonad m => String -> LP m Blocks
1151−alltt t = walk strToCode <$> parseFromString' blocks
1152− (substitute " " "\\ " $ substitute "%" "\\%" $
1153− intercalate "\\\\\n" $ lines t)
1154− where strToCode (Str s) = Code nullAttr s
1155− strToCode x = x
1156−
1157−rawLaTeXBlock :: PandocMonad m => LP m String
1158−rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
1159−
1160−rawLaTeXInline :: PandocMonad m => LP m Inline
1161−rawLaTeXInline = do
1162− raw <- (snd <$> withRaw inlineCommand)
1163− <|> (snd <$> withRaw inlineEnvironment)
1164− <|> (snd <$> withRaw blockCommand)
1165− RawInline "latex" <$> applyMacros' raw
1166−
1167−addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
1168−addImageCaption = walkM go
1169− where go (Image attr alt (src,tit))
1170− | not ("fig:" `isPrefixOf` tit) = do
1171− mbcapt <- stateCaption <$> getState
1172− return $ case mbcapt of
1173− Just ils -> Image attr (toList ils) (src, "fig:" ++ tit)
1174− Nothing -> Image attr alt (src,tit)
1175− go x = return x
1176−
1177−addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
1178−addTableCaption = walkM go
1179− where go (Table c als ws hs rs) = do
1180− mbcapt <- stateCaption <$> getState
1181− return $ case mbcapt of
1182− Just ils -> Table (toList ils) als ws hs rs
1183− Nothing -> Table c als ws hs rs
1184− go x = return x
1185−
1186−environments :: PandocMonad m => M.Map String (LP m Blocks)
1187−environments = M.fromList
1188− [ ("document", env "document" blocks <* skipMany anyChar)
1189− , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
1190− , ("letter", env "letter" letterContents)
1191− , ("minipage", env "minipage" $
1192− skipopts *> spaces' *> optional braced *> spaces' *> blocks)
1193− , ("figure", env "figure" $ skipopts *> figure)
1194− , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
1195− , ("center", env "center" blocks)
1196− , ("longtable", env "longtable" $
1197− resetCaption *> simpTable "longtable" False >>= addTableCaption)
1198− , ("table", env "table" $
1199− resetCaption *> skipopts *> blocks >>= addTableCaption)
1200− , ("tabular*", env "tabular" $ simpTable "tabular*" True)
1201− , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1202− , ("tabular", env "tabular" $ simpTable "tabular" False)
1203− , ("quote", blockQuote <$> env "quote" blocks)
1204− , ("quotation", blockQuote <$> env "quotation" blocks)
1205− , ("verse", blockQuote <$> env "verse" blocks)
1206− , ("itemize", bulletList <$> listenv "itemize" (many item))
1207− , ("description", definitionList <$> listenv "description" (many descItem))
1208− , ("enumerate", orderedList')
1209− , ("alltt", alltt =<< verbEnv "alltt")
1210− , ("code", guardEnabled Ext_literate_haskell *>
1211− (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
1212− verbEnv "code"))
1213− , ("comment", mempty <$ verbEnv "comment")
1214− , ("verbatim", codeBlock <$> verbEnv "verbatim")
1215− , ("Verbatim", fancyverbEnv "Verbatim")
1216− , ("BVerbatim", fancyverbEnv "BVerbatim")
1217− , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals
1218− codeBlockWith attr <$> verbEnv "lstlisting")
1219− , ("minted", do options <- option [] keyvals
1220− lang <- grouped (many1 $ satisfy (/='}'))
1221− let kvs = [ (if k == "firstnumber"
1222− then "startFrom"
1223− else k, v) | (k,v) <- options ]
1224− let classes = [ lang | not (null lang) ] ++
1225− [ "numberLines" |
1226− lookup "linenos" options == Just "true" ]
1227− let attr = ("",classes,kvs)
1228− codeBlockWith attr <$> verbEnv "minted")
1229− , ("obeylines", parseFromString
1230− (para . trimInlines . mconcat <$> many inline) =<<
1231− intercalate "\\\\\n" . lines <$> verbEnv "obeylines")
1232− , ("displaymath", mathEnvWith para Nothing "displaymath")
1233− , ("equation", mathEnvWith para Nothing "equation")
1234− , ("equation*", mathEnvWith para Nothing "equation*")
1235− , ("gather", mathEnvWith para (Just "gathered") "gather")
1236− , ("gather*", mathEnvWith para (Just "gathered") "gather*")
1237− , ("multline", mathEnvWith para (Just "gathered") "multline")
1238− , ("multline*", mathEnvWith para (Just "gathered") "multline*")
1239− , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray")
1240− , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*")
1241− , ("align", mathEnvWith para (Just "aligned") "align")
1242− , ("align*", mathEnvWith para (Just "aligned") "align*")
1243− , ("alignat", mathEnvWith para (Just "aligned") "alignat")
1244− , ("alignat*", mathEnvWith para (Just "aligned") "alignat*")
1245− , ("tikzpicture", rawVerbEnv "tikzpicture")
1246− ]
1247−
1248−figure :: PandocMonad m => LP m Blocks
1249−figure = try $ do
1250− resetCaption
1251− blocks >>= addImageCaption
1252−
1253−letterContents :: PandocMonad m => LP m Blocks
1254−letterContents = do
1255− bs <- blocks
1256− st <- getState
1257− -- add signature (author) and address (title)
1258− let addr = case lookupMeta "address" (stateMeta st) of
1259− Just (MetaBlocks [Plain xs]) ->
1260− para $ trimInlines $ fromList xs
1261− _ -> mempty
1262− return $ addr <> bs -- sig added by \closing
1263−
1264−closing :: PandocMonad m => LP m Blocks
1265−closing = do
1266− contents <- tok
1267− st <- getState
1268− let extractInlines (MetaBlocks [Plain ys]) = ys
1269− extractInlines (MetaBlocks [Para ys ]) = ys
1270− extractInlines _ = []
1271− let sigs = case lookupMeta "author" (stateMeta st) of
1272− Just (MetaList xs) ->
1273− para $ trimInlines $ fromList $
1274− intercalate [LineBreak] $ map extractInlines xs
1275− _ -> mempty
1276− return $ para (trimInlines contents) <> sigs
1943+-- lists
12771944
12781945item :: PandocMonad m => LP m Blocks
1279−item = blocks *> controlSeq "item" *> skipopts *> blocks
1280−
1281−looseItem :: PandocMonad m => LP m Blocks
1282−looseItem = do
1283− ctx <- stateParserContext `fmap` getState
1284− if ctx == ListItemState
1285− then mzero
1286− else return mempty
1946+item = void blocks *> controlSeq "item" *> skipopts *> blocks
12871947
12881948descItem :: PandocMonad m => LP m (Inlines, [Blocks])
12891949descItem = do
@@ -1294,302 +1954,210 @@ descItem = do
12941954 bs <- blocks
12951955 return (ils, [bs])
12961956
1297−env :: PandocMonad m => String -> LP m a -> LP m a
1298−env name p = p <*
1299− (try (controlSeq "end" *> braced >>= guard . (== name))
1300− <?> ("\\end{" ++ name ++ "}"))
1301−
1302−listenv :: PandocMonad m => String -> LP m a -> LP m a
1957+listenv :: PandocMonad m => Text -> LP m a -> LP m a
13031958listenv name p = try $ do
1304− oldCtx <- stateParserContext `fmap` getState
1305− updateState $ \st -> st{ stateParserContext = ListItemState }
1959+ oldInListItem <- sInListItem `fmap` getState
1960+ updateState $ \st -> st{ sInListItem = True }
13061961 res <- env name p
1307− updateState $ \st -> st{ stateParserContext = oldCtx }
1962+ updateState $ \st -> st{ sInListItem = oldInListItem }
13081963 return res
13091964
1310−mathEnvWith :: PandocMonad m
1311− => (Inlines -> a) -> Maybe String -> String -> LP m a
1312−mathEnvWith f innerEnv name = f <$> mathDisplay (inner <$> mathEnv name)
1313− where inner x = case innerEnv of
1314− Nothing -> x
1315− Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
1316− "\\end{" ++ y ++ "}"
1317−
1318−mathEnv :: PandocMonad m => String -> LP m String
1319−mathEnv name = do
1320− skipopts
1321− optional blankline
1322− let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
1323− charMuncher = skipMany comment *>
1324− (many1 (noneOf "\\%") <|> try (string "\\%")
1325− <|> try (string "\\\\") <|> count 1 anyChar)
1326− res <- concat <$> manyTill charMuncher endEnv
1327− return $ stripTrailingNewlines res
1328−
1329−verbEnv :: PandocMonad m => String -> LP m String
1330−verbEnv name = do
1331− skipopts
1332− optional blankline
1333− let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
1334− charMuncher = anyChar
1335− res <- manyTill charMuncher endEnv
1336− return $ stripTrailingNewlines res
1337−
1338−fancyverbEnv :: PandocMonad m => String -> LP m Blocks
1339−fancyverbEnv name = do
1340− options <- option [] keyvals
1341− let kvs = [ (if k == "firstnumber"
1342− then "startFrom"
1343− else k, v) | (k,v) <- options ]
1344− let classes = [ "numberLines" |
1345− lookup "numbers" options == Just "left" ]
1346− let attr = ("",classes,kvs)
1347− codeBlockWith attr <$> verbEnv name
1348−
13491965orderedList' :: PandocMonad m => LP m Blocks
13501966orderedList' = try $ do
1351− optional sp
1352− (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
1353− try $ char '[' *> anyOrderedListMarker <* char ']'
13541967 spaces
1355− optional $ try $ controlSeq "setlength" *> grouped (controlSeq "itemindent") *> braced
1968+ let markerSpec = do
1969+ symbol '['
1970+ ts <- toksToString <$> manyTill anyTok (symbol ']')
1971+ case runParser anyOrderedListMarker def "option" ts of
1972+ Right r -> return r
1973+ Left _ -> do
1974+ pos <- getPosition
1975+ report $ SkippedContent ("[" ++ ts ++ "]") pos
1976+ return (1, DefaultStyle, DefaultDelim)
1977+ (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) markerSpec
13561978 spaces
1357− start <- option 1 $ try $ do controlSeq "setcounter"
1358− grouped (string "enum" *> many1 (oneOf "iv"))
1979+ optional $ try $ controlSeq "setlength"
1980+ *> grouped (count 1 $ controlSeq "itemindent")
1981+ *> braced
1982+ spaces
1983+ start <- option 1 $ try $ do pos <- getPosition
1984+ controlSeq "setcounter"
1985+ ctr <- toksToString <$> braced
1986+ guard $ "enum" `isPrefixOf` ctr
1987+ guard $ all (`elem` ['i','v']) (drop 4 ctr)
13591988 optional sp
1360− num <- grouped (many1 digit)
1361− spaces
1362− return (read num + 1 :: Int)
1989+ num <- toksToString <$> braced
1990+ case safeRead num of
1991+ Just i -> return (i + 1 :: Int)
1992+ Nothing -> do
1993+ report $ SkippedContent
1994+ ("\\setcounter{" ++ ctr ++
1995+ "}{" ++ num ++ "}") pos
1996+ return 1
13631997 bs <- listenv "enumerate" (many item)
13641998 return $ orderedListWith (start, style, delim) bs
13651999
1366−paragraph :: PandocMonad m => LP m Blocks
1367−paragraph = do
1368− x <- trimInlines . mconcat <$> many1 inline
1369− if x == mempty
1370− then return mempty
1371− else return $ para x
1372−
1373−preamble :: PandocMonad m => LP m Blocks
1374−preamble = mempty <$> manyTill preambleBlock beginDoc
1375− where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}"
1376− preambleBlock = void comment
1377− <|> void sp
1378− <|> void blanklines
1379− <|> void include
1380− <|> void macro
1381− <|> void blockCommand
1382− <|> void anyControlSeq
1383− <|> void braced
1384− <|> void anyChar
1385−
1386−-------
1387−
1388−-- citations
1389−
1390−addPrefix :: [Inline] -> [Citation] -> [Citation]
1391−addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
1392−addPrefix _ _ = []
1393−
1394−addSuffix :: [Inline] -> [Citation] -> [Citation]
1395−addSuffix s ks@(_:_) =
1396− let k = last ks
1397− in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
1398−addSuffix _ _ = []
1399−
1400−simpleCiteArgs :: PandocMonad m => LP m [Citation]
1401−simpleCiteArgs = try $ do
1402− first <- optionMaybe $ toList <$> opt
1403− second <- optionMaybe $ toList <$> opt
1404− keys <- try $ bgroup *> (manyTill citationLabel egroup)
1405− let (pre, suf) = case (first , second ) of
1406− (Just s , Nothing) -> (mempty, s )
1407− (Just s , Just t ) -> (s , t )
1408− _ -> (mempty, mempty)
1409− conv k = Citation { citationId = k
1410− , citationPrefix = []
1411− , citationSuffix = []
1412− , citationMode = NormalCitation
1413− , citationHash = 0
1414− , citationNoteNum = 0
1415− }
1416− return $ addPrefix pre $ addSuffix suf $ map conv keys
1417−
1418−citationLabel :: PandocMonad m => LP m String
1419−citationLabel = optional sp *>
1420− (many1 (satisfy isBibtexKeyChar)
1421− <* optional sp
1422− <* optional (char ',')
1423− <* optional sp)
1424− where isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]" :: String)
2000+-- tables
14252001
1426−cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
1427−cites mode multi = try $ do
1428− cits <- if multi
1429− then many1 simpleCiteArgs
1430− else count 1 simpleCiteArgs
1431− let cs = concat cits
1432− return $ case mode of
1433− AuthorInText -> case cs of
1434− (c:rest) -> c {citationMode = mode} : rest
1435− [] -> []
1436− _ -> map (\a -> a {citationMode = mode}) cs
2002+hline :: PandocMonad m => LP m ()
2003+hline = try $ do
2004+ spaces
2005+ controlSeq "hline" <|>
2006+ -- booktabs rules:
2007+ controlSeq "toprule" <|>
2008+ controlSeq "bottomrule" <|>
2009+ controlSeq "midrule" <|>
2010+ controlSeq "endhead" <|>
2011+ controlSeq "endfirsthead"
2012+ spaces
2013+ optional $ bracketed inline
2014+ return ()
14372015
1438−citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines
1439−citation name mode multi = do
1440− (c,raw) <- withRaw $ cites mode multi
1441− return $ cite c (rawInline "latex" $ "\\" ++ name ++ raw)
2016+lbreak :: PandocMonad m => LP m Tok
2017+lbreak = (controlSeq "\\" <|> controlSeq "tabularnewline") <* spaces
14422018
1443−complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
1444−complexNatbibCitation mode = try $ do
1445− let ils = (toList . trimInlines . mconcat) <$>
1446− many (notFollowedBy (oneOf "\\};") >> inline)
1447− let parseOne = try $ do
1448− skipSpaces
1449− pref <- ils
1450− cit' <- inline -- expect a citation
1451− let citlist = toList cit'
1452− cits' <- case citlist of
1453− [Cite cs _] -> return cs
1454− _ -> mzero
1455− suff <- ils
1456− skipSpaces
1457− optional $ char ';'
1458− return $ addPrefix pref $ addSuffix suff cits'
1459− (c:cits, raw) <- withRaw $ grouped parseOne
1460− return $ cite (c{ citationMode = mode }:cits)
1461− (rawInline "latex" $ "\\citetext" ++ raw)
2019+amp :: PandocMonad m => LP m Tok
2020+amp = symbol '&'
14622021
1463−-- tables
2022+-- Split a Word into individual Symbols (for parseAligns)
2023+splitWordTok :: PandocMonad m => LP m ()
2024+splitWordTok = do
2025+ inp <- getInput
2026+ case inp of
2027+ (Tok spos Word t : rest) -> do
2028+ setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) ++ rest
2029+ _ -> return ()
14642030
1465−parseAligns :: PandocMonad m => LP m [(Alignment, Double, (String, String))]
2031+parseAligns :: PandocMonad m => LP m [(Alignment, Double, ([Tok], [Tok]))]
14662032parseAligns = try $ do
1467− bgroup
1468− let maybeBar = skipMany $ sp <|> () <$ char '|' <|> () <$ (char '@' >> braced)
1469− maybeBar
1470− let cAlign = AlignCenter <$ char 'c'
1471− let lAlign = AlignLeft <$ char 'l'
1472− let rAlign = AlignRight <$ char 'r'
1473− let parAlign = AlignLeft <$ char 'p'
1474− -- algins from tabularx
1475− let xAlign = AlignLeft <$ char 'X'
1476− let mAlign = AlignLeft <$ char 'm'
1477− let bAlign = AlignLeft <$ char 'b'
1478− let alignChar = cAlign <|> lAlign <|> rAlign <|> parAlign
1479− <|> xAlign <|> mAlign <|> bAlign
1480− let alignPrefix = char '>' >> braced
1481− let alignSuffix = char '<' >> braced
2033+ let maybeBar = skipMany $
2034+ sp <|> () <$ symbol '|' <|> () <$ (symbol '@' >> braced)
2035+ let cAlign = AlignCenter <$ symbol 'c'
2036+ let lAlign = AlignLeft <$ symbol 'l'
2037+ let rAlign = AlignRight <$ symbol 'r'
2038+ let parAlign = AlignLeft <$ symbol 'p'
2039+ -- aligns from tabularx
2040+ let xAlign = AlignLeft <$ symbol 'X'
2041+ let mAlign = AlignLeft <$ symbol 'm'
2042+ let bAlign = AlignLeft <$ symbol 'b'
2043+ let alignChar = splitWordTok *> ( cAlign <|> lAlign <|> rAlign <|> parAlign
2044+ <|> xAlign <|> mAlign <|> bAlign )
2045+ let alignPrefix = symbol '>' >> braced
2046+ let alignSuffix = symbol '<' >> braced
14822047 let colWidth = try $ do
1483− char '{'
1484− ds <- many1 (oneOf "0123456789.")
2048+ symbol '{'
2049+ ds <- trim . toksToString <$> manyTill anyTok (controlSeq "linewidth")
14852050 spaces
1486− string "\\linewidth"
1487− char '}'
2051+ symbol '}'
14882052 case safeRead ds of
14892053 Just w -> return w
14902054 Nothing -> return 0.0
1491− let alignSpec = do
2055+ let alignSpec = try $ do
14922056 spaces
1493− pref <- option "" alignPrefix
2057+ pref <- option [] alignPrefix
14942058 spaces
14952059 al <- alignChar
1496− width <- colWidth <|> option 0.0 (do s <- braced
2060+ width <- colWidth <|> option 0.0 (do s <- toksToString <$> braced
14972061 pos <- getPosition
14982062 report $ SkippedContent s pos
14992063 return 0.0)
15002064 spaces
1501− suff <- option "" alignSuffix
2065+ suff <- option [] alignSuffix
15022066 return (al, width, (pref, suff))
1503− aligns' <- sepEndBy alignSpec maybeBar
2067+ bgroup
2068+ spaces
2069+ maybeBar
2070+ aligns' <- many (alignSpec <* maybeBar)
15042071 spaces
15052072 egroup
15062073 spaces
1507− return $ aligns'
1508−
1509−hline :: PandocMonad m => LP m ()
1510−hline = try $ do
1511− spaces'
1512− controlSeq "hline" <|>
1513− -- booktabs rules:
1514− controlSeq "toprule" <|>
1515− controlSeq "bottomrule" <|>
1516− controlSeq "midrule" <|>
1517− controlSeq "endhead" <|>
1518− controlSeq "endfirsthead"
1519− spaces'
1520− optional $ bracketed (many1 (satisfy (/=']')))
1521− return ()
1522−
1523−lbreak :: PandocMonad m => LP m ()
1524−lbreak = () <$ try (spaces' *>
1525− (controlSeq "\\" <|> controlSeq "tabularnewline") <*
1526− spaces')
1527−
1528−amp :: PandocMonad m => LP m ()
1529−amp = () <$ try (spaces' *> char '&' <* spaces')
2074+ return aligns'
15302075
15312076parseTableRow :: PandocMonad m
1532− => String -- ^ table environment name
1533− -> [(String, String)] -- ^ pref/suffixes
2077+ => Text -- ^ table environment name
2078+ -> [([Tok], [Tok])] -- ^ pref/suffixes
15342079 -> LP m [Blocks]
1535−parseTableRow envname prefsufs = try $ do
2080+parseTableRow envname prefsufs = do
2081+ notFollowedBy (spaces *> end_ envname)
15362082 let cols = length prefsufs
1537− let tableCellRaw = concat <$> many
1538− (do notFollowedBy amp
1539− notFollowedBy lbreak
1540− notFollowedBy $ () <$ try (string ("\\end{" ++ envname ++ "}"))
1541− many1 (noneOf "&%\n\r\\")
1542− <|> try (string "\\&")
1543− <|> count 1 anyChar)
1544− let plainify bs = case toList bs of
1545− [Para ils] -> plain (fromList ils)
1546− _ -> bs
1547− rawcells <- sepBy1 tableCellRaw amp
1548− guard $ length rawcells == cols
1549− let rawcells' = zipWith (\c (p, s) -> p ++ trim c ++ s) rawcells prefsufs
1550− let tableCell = plainify <$> blocks
1551− cells' <- mapM (parseFromString' tableCell) rawcells'
1552− let numcells = length cells'
2083+ -- add prefixes and suffixes in token stream:
2084+ let celltoks (pref, suff) = do
2085+ prefpos <- getPosition
2086+ contents <- many (notFollowedBy
2087+ (() <$ amp <|> () <$ lbreak <|> end_ envname)
2088+ >> anyTok)
2089+ suffpos <- getPosition
2090+ option [] (count 1 amp)
2091+ return $ map (setpos (sourceLine prefpos, sourceColumn prefpos)) pref
2092+ ++ contents ++
2093+ map (setpos (sourceLine suffpos, sourceColumn suffpos)) suff
2094+ rawcells <- sequence (map celltoks prefsufs)
2095+ oldInput <- getInput
2096+ cells <- sequence $ map (\ts -> setInput ts >> parseTableCell) rawcells
2097+ setInput oldInput
2098+ spaces
2099+ let numcells = length cells
15532100 guard $ numcells <= cols && numcells >= 1
1554− guard $ cells' /= [mempty]
2101+ guard $ cells /= [mempty]
15552102 -- note: a & b in a three-column table leaves an empty 3rd cell:
1556− let cells'' = cells' ++ replicate (cols - numcells) mempty
1557− spaces'
1558− return cells''
2103+ return $ cells ++ replicate (cols - numcells) mempty
15592104
1560−spaces' :: PandocMonad m => LP m ()
1561−spaces' = spaces *> skipMany (comment *> spaces)
2105+parseTableCell :: PandocMonad m => LP m Blocks
2106+parseTableCell = do
2107+ let plainify bs = case toList bs of
2108+ [Para ils] -> plain (fromList ils)
2109+ _ -> bs
2110+ updateState $ \st -> st{ sInTableCell = True }
2111+ cells <- plainify <$> blocks
2112+ updateState $ \st -> st{ sInTableCell = False }
2113+ return cells
15622114
1563−simpTable :: PandocMonad m => String -> Bool -> LP m Blocks
2115+simpTable :: PandocMonad m => Text -> Bool -> LP m Blocks
15642116simpTable envname hasWidthParameter = try $ do
1565− when hasWidthParameter $ () <$ (spaces' >> tok)
2117+ when hasWidthParameter $ () <$ (spaces >> tok)
15662118 skipopts
15672119 colspecs <- parseAligns
15682120 let (aligns, widths, prefsufs) = unzip3 colspecs
15692121 let cols = length colspecs
15702122 optional $ controlSeq "caption" *> skipopts *> setCaption
15712123 optional lbreak
1572− spaces'
2124+ spaces
15732125 skipMany hline
1574− spaces'
2126+ spaces
15752127 header' <- option [] $ try (parseTableRow envname prefsufs <*
15762128 lbreak <* many1 hline)
1577− spaces'
2129+ spaces
15782130 rows <- sepEndBy (parseTableRow envname prefsufs)
15792131 (lbreak <* optional (skipMany hline))
1580− spaces'
2132+ spaces
15812133 optional $ controlSeq "caption" *> skipopts *> setCaption
15822134 optional lbreak
1583− spaces'
2135+ spaces
15842136 let header'' = if null header'
15852137 then replicate cols mempty
15862138 else header'
15872139 lookAhead $ controlSeq "end" -- make sure we're at end
15882140 return $ table mempty (zip aligns widths) header'' rows
15892141
1590−removeDoubleQuotes :: String -> String
1591−removeDoubleQuotes ('"':xs) =
1592− case reverse xs of
1593− '"':ys -> reverse ys
1594− _ -> '"':xs
1595−removeDoubleQuotes xs = xs
2142+addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
2143+addTableCaption = walkM go
2144+ where go (Table c als ws hs rs) = do
2145+ mbcapt <- sCaption <$> getState
2146+ return $ case mbcapt of
2147+ Just ils -> Table (toList ils) als ws hs rs
2148+ Nothing -> Table c als ws hs rs
2149+ go x = return x
2150+
2151+
2152+block :: PandocMonad m => LP m Blocks
2153+block = (mempty <$ spaces1)
2154+ <|> environment
2155+ <|> include
2156+ <|> macroDef
2157+ <|> blockCommand
2158+ <|> paragraph
2159+ <|> grouped block
2160+
2161+blocks :: PandocMonad m => LP m Blocks
2162+blocks = mconcat <$> many block
2163+