@@ -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,34 +31,48 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2831 Portability : portable
2932
3033Conversion of LaTeX to 'Pandoc' document.
34+
35+TODO:
36+[ ] exported rawLaTeXInline, rawLaTeXBlock, inlineCommand
3137-}
3238module Text.Pandoc.Readers.LaTeX ( readLaTeX,
3339 rawLaTeXInline,
3440 rawLaTeXBlock,
35− inlineCommand,
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)
4857import Text.Pandoc.Builder
4958import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, readFileFromDirs,
50− report, setResourcePath, getResourcePath)
59+ report, setResourcePath, getResourcePath,
60+ runIOorExplode, PandocIO)
5161import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
5262import Text.Pandoc.ImageSize (numUnit, showFl)
5363import Text.Pandoc.Logging
5464import Text.Pandoc.Options
55−import Text.Pandoc.Parsing hiding (many, mathDisplay, mathInline, optional,
56− space, (<|>))
65+import Text.Pandoc.Parsing hiding (many, optional, withRaw,
66+ mathInline, mathDisplay, macro,
67+ space, (<|>), spaces, blankline)
5768import Text.Pandoc.Shared
69+import Text.Pandoc.Readers.LaTeX.Types (Macro(..), Tok(..),
70+ TokType(..), Line, Column)
5871import Text.Pandoc.Walk
72+import Text.Pandoc.Error (PandocError(PandocParsecError, PandocMacroLoop))
73+
74+import Text.Pandoc.Extensions (getDefaultExtensions)
75+import Debug.Trace (traceShowId)
5976
6077-- | Parse LaTeX from string and return 'Pandoc' document.
6178readLaTeX :: PandocMonad m
@@ -63,18 +80,18 @@ readLaTeX :: PandocMonad m
6380 -> Text -- ^ String to parse (assumes @'\n'@ line endings)
6481 -> m Pandoc
6582readLaTeX opts ltx = do
66− parsed <- readWithM parseLaTeX def{ stateOptions = opts }
67− (unpack (crFilter ltx))
83+ parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"
84+ (tokenize (crFilter ltx))
6885 case parsed of
6986 Right result -> return result
70− Left e -> throwError e
87+ Left e -> throwError $ PandocParsecError (T.unpack ltx) e
7188
7289parseLaTeX :: PandocMonad m => LP m Pandoc
7390parseLaTeX = do
7491 bs <- blocks
7592 eof
7693 st <- getState
77− let meta = stateMeta st
94+ let meta = sMeta st
7895 let doc' = doc bs
7996 let headerLevel (Header n _ _) = [n]
8097 headerLevel _ = []
@@ -88,177 +105,414 @@ parseLaTeX = do
88105 else id) doc'
89106 return $ Pandoc meta bs'
90107
91−type LP m = ParserT String ParserState m
92−
93−anyControlSeq :: PandocMonad m => LP m String
94−anyControlSeq = do
95− char '\\'
96− next <- option '\n' anyChar
97− case next of
98− '\n' -> return ""
99− c | isLetter c -> (c:) <$> (many letter <* optional sp)
100− | otherwise -> return [c]
101−
102−controlSeq :: PandocMonad m => String -> LP m String
103−controlSeq name = try $ do
104− char '\\'
105− case name of
106− "" -> mzero
107− [c] | not (isLetter c) -> string [c]
108− cs -> string cs <* notFollowedBy letter <* optional sp
109− return name
110−
111−dimenarg :: PandocMonad m => LP m String
112−dimenarg = try $ do
113− ch <- option "" $ string "="
114− num <- many1 digit
115− dim <- oneOfStrings ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
116− return $ ch ++ num ++ dim
108+testParser :: LP PandocIO a -> Text -> IO a
109+testParser p t = do
110+ res <- runIOorExplode (runParserT p defaultLaTeXState{
111+ sOptions = def{ readerExtensions =
112+ enableExtension Ext_raw_tex $
113+ getDefaultExtensions "latex" }} "source" (tokenize t))
114+ case res of
115+ Left e -> error (show e)
116+ Right r -> return r
117+
118+data LaTeXState = LaTeXState{ sOptions :: ReaderOptions
119+ , sMeta :: Meta
120+ , sQuoteContext :: QuoteContext
121+ , sMacros :: M.Map Text Macro
122+ , sContainers :: [String]
123+ , sHeaders :: M.Map Inlines String
124+ , sLogMessages :: [LogMessage]
125+ , sIdentifiers :: Set.Set String
126+ , sVerbatimMode :: Bool
127+ , sCaption :: Maybe Inlines
128+ , sInListItem :: Bool
129+ , sInTableCell :: Bool
130+ }
131+ deriving Show
132+
133+defaultLaTeXState :: LaTeXState
134+defaultLaTeXState = LaTeXState{ sOptions = def
135+ , sMeta = nullMeta
136+ , sQuoteContext = NoQuote
137+ , sMacros = M.empty
138+ , sContainers = []
139+ , sHeaders = M.empty
140+ , sLogMessages = []
141+ , sIdentifiers = Set.empty
142+ , sVerbatimMode = False
143+ , sCaption = Nothing
144+ , sInListItem = False
145+ , sInTableCell = False
146+ }
147+
148+instance PandocMonad m => HasQuoteContext LaTeXState m where
149+ getQuoteContext = sQuoteContext <$> getState
150+ withQuoteContext context parser = do
151+ oldState <- getState
152+ let oldQuoteContext = sQuoteContext oldState
153+ setState oldState { sQuoteContext = context }
154+ result <- parser
155+ newState <- getState
156+ setState newState { sQuoteContext = oldQuoteContext }
157+ return result
158+
159+instance HasLogMessages LaTeXState where
160+ addLogMessage msg st = st{ sLogMessages = msg : sLogMessages st }
161+ getLogMessages st = reverse $ sLogMessages st
162+
163+instance HasIdentifierList LaTeXState where
164+ extractIdentifierList = sIdentifiers
165+ updateIdentifierList f st = st{ sIdentifiers = f $ sIdentifiers st }
166+
167+instance HasIncludeFiles LaTeXState where
168+ getIncludeFiles = sContainers
169+ addIncludeFile f s = s{ sContainers = f : sContainers s }
170+ dropLatestIncludeFile s = s { sContainers = drop 1 $ sContainers s }
171+
172+instance HasHeaderMap LaTeXState where
173+ extractHeaderMap = sHeaders
174+ updateHeaderMap f st = st{ sHeaders = f $ sHeaders st }
175+
176+instance HasReaderOptions LaTeXState where
177+ extractReaderOptions = sOptions
178+
179+instance HasMeta LaTeXState where
180+ setMeta field val st =
181+ st{ sMeta = setMeta field val $ sMeta st }
182+ deleteMeta field st =
183+ st{ sMeta = deleteMeta field $ sMeta st }
184+
185+instance Default LaTeXState where
186+ def = defaultLaTeXState
187+
188+type LP m = ParserT [Tok] LaTeXState m
189+
190+withVerbatimMode :: PandocMonad m => LP m a -> LP m a
191+withVerbatimMode parser = do
192+ updateState $ \st -> st{ sVerbatimMode = True }
193+ result <- parser
194+ updateState $ \st -> st{ sVerbatimMode = False }
195+ return result
196+
197+-- TODO: export our local macro parsing code
198+-- use that in markdown reader and change ParserState
199+-- TODO: remove use of texmath's applyMacros in Markdown reader
200+-- (and elsewhere?). Instead, use an exported
201+-- applyMacros that uses our Macro type. or perhaps
202+-- just run the latex reader on the math (adding delims
203+-- $$).
204+
205+-- TODO: replace ParserState with variable and constraints.
206+-- can we use 'tokens' from Parsec?
207+-- feed ParserState -> LaTeXState and then back again
208+rawLaTeXBlock :: PandocMonad m => ParserT String ParserState m String
209+rawLaTeXBlock = mzero
210+-- rawLaTeXBlock :: PandocMonad m => ParserT String LaTeXState String
211+-- rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
212+
213+rawLaTeXInline :: PandocMonad m => ParserT String ParserState m Inline
214+rawLaTeXInline = mzero
215+-- rawLaTeXInline :: PandocMonad m => ParserT String LaTeXState Inline
216+-- rawLaTeXInline = do
217+-- raw <- (snd <$> withRaw inlineCommand)
218+-- <|> (snd <$> withRaw inlineEnvironment)
219+-- <|> (snd <$> withRaw blockCommand)
220+-- RawInline "latex" <$> applyMacros' raw
221+
222+-- TODO this is only used in org reader.
223+-- I think the reason is that tarleb wanted to avoid
224+-- the blockCommand alternative in rawLaTeXInline.
225+-- I don't know whyt that's there and I think it should be
226+-- removed.
227+inlineCommand :: PandocMonad m => ParserT String ParserState m Inlines
228+inlineCommand = mzero
229+
230+tokenize :: Text -> [Tok]
231+tokenize = totoks (1, 1)
232+
233+totoks :: (Line, Column) -> Text -> [Tok]
234+totoks (lin,col) t =
235+ case T.uncons t of
236+ Nothing -> []
237+ Just (c, rest)
238+ | c == '\n' ->
239+ Tok (lin, col) Newline "\n"
240+ : totoks (lin + 1,1) rest
241+ | isSpaceOrTab c ->
242+ let (sps, rest') = T.span isSpaceOrTab t
243+ in Tok (lin, col) Spaces sps
244+ : totoks (lin, col + T.length sps) rest'
245+ | isAlphaNum c ->
246+ let (ws, rest') = T.span isAlphaNum t
247+ in Tok (lin, col) Word ws
248+ : totoks (lin, col + T.length ws) rest'
249+ | c == '%' ->
250+ let (cs, rest') = T.break (== '\n') rest
251+ in Tok (lin, col) Comment ("%" <> cs)
252+ : totoks (lin, col + 1 + T.length cs) rest'
253+ | c == '\\' ->
254+ case T.uncons rest of
255+ Nothing -> [Tok (lin, col) Symbol (T.singleton c)]
256+ Just (d, rest')
257+ | isLetter d ->
258+ let (ws, rest'') = T.span isLetter rest
259+ (ss, rest''') = T.span isSpaceOrTab rest''
260+ in Tok (lin, col) (CtrlSeq ws) ("\\" <> ws <> ss)
261+ : totoks (lin,
262+ col + 1 + T.length ws + T.length ss) rest'''
263+ | d == '\t' || d == '\n' ->
264+ Tok (lin, col) Symbol ("\\")
265+ : totoks (lin, col + 1) rest
266+ | otherwise ->
267+ Tok (lin, col) (CtrlSeq (T.singleton d)) (T.pack [c,d])
268+ : totoks (lin, col + 2) rest'
269+ | c == '#' ->
270+ let (t1, t2) = T.span (\d -> d >= '0' && d <= '9') rest
271+ in case safeRead (T.unpack t1) of
272+ Just i ->
273+ Tok (lin, col) (Arg i) ("#" <> t1)
274+ : totoks (lin, col + 1 + T.length t1) t2
275+ Nothing ->
276+ Tok (lin, col) Symbol ("#")
277+ : totoks (lin, col + 1) t2
278+ | c == '^' ->
279+ case T.uncons rest of
280+ Just ('^', rest') ->
281+ case T.uncons rest' of
282+ Just (d, rest'')
283+ | isLowerHex d ->
284+ case T.uncons rest'' of
285+ Just (e, rest''') | isLowerHex e ->
286+ Tok (lin, col) Esc2 (T.pack ['^','^',d,e])
287+ : totoks (lin, col + 4) rest'''
288+ _ ->
289+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
290+ : totoks (lin, col + 3) rest''
291+ | d < '\128' ->
292+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
293+ : totoks (lin, col + 3) rest''
294+ _ -> [Tok (lin, col) Symbol ("^"),
295+ Tok (lin, col + 1) Symbol ("^")]
296+ _ -> Tok (lin, col) Symbol ("^")
297+ : totoks (lin, col + 1) rest
298+ | otherwise ->
299+ Tok (lin, col) Symbol (T.singleton c) : totoks (lin, col + 1) rest
300+
301+ where isSpaceOrTab ' ' = True
302+ isSpaceOrTab '\t' = True
303+ isSpaceOrTab _ = False
304+
305+isLowerHex :: Char -> Bool
306+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
307+
308+untokenize :: [Tok] -> Text
309+untokenize = mconcat . map untoken
310+
311+untoken :: Tok -> Text
312+untoken (Tok _ _ t) = t
313+
314+satisfyTok :: PandocMonad m => (Tok -> Bool) -> LP m Tok
315+satisfyTok f =
316+ try $ do
317+ res <- tokenPrim (T.unpack . untoken) updatePos matcher
318+ doMacros 0 -- apply macros on remaining input stream
319+ return res
320+ where matcher t | f t = Just t
321+ | otherwise = Nothing
322+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
323+ updatePos spos _ (Tok (lin,col) _ _ : _) =
324+ setSourceColumn (setSourceLine spos lin) col
325+ updatePos spos _ [] = spos
326+
327+doMacros :: PandocMonad m => Int -> LP m ()
328+doMacros n = do
329+ applyMacros <- readerApplyMacros . sOptions <$> getState
330+ verbatimMode <- sVerbatimMode <$> getState
331+ when (applyMacros && not verbatimMode) $ do
332+ inp <- getInput
333+ case inp of
334+ Tok spos (CtrlSeq "begin") _ : Tok _ Symbol "{" :
335+ Tok _ Word name : Tok _ Symbol "}" : ts
336+ -> handleMacros spos name ts
337+ Tok spos (CtrlSeq "end") _ : Tok _ Symbol "{" :
338+ Tok _ Word name : Tok _ Symbol "}" : ts
339+ -> handleMacros spos ("end" <> name) ts
340+ Tok spos (CtrlSeq name) _ : ts
341+ -> handleMacros spos name ts
342+ _ -> return ()
343+ where handleMacros spos name ts = do
344+ macros <- sMacros <$> getState
345+ case M.lookup name macros of
346+ Nothing -> return ()
347+ Just (Macro numargs optarg newtoks) -> do
348+ setInput ts
349+ let getarg = spaces >> braced
350+ args <- case optarg of
351+ Nothing -> count numargs getarg
352+ Just o ->
353+ (:) <$> option o bracketedToks
354+ <*> count (numargs - 1) getarg
355+ let addTok (Tok _ (Arg i) _) acc | i > 0
356+ , i <= numargs =
357+ map (setpos spos) (args !! (i - 1)) ++ acc
358+ addTok t acc = setpos spos t : acc
359+ ts' <- getInput
360+ setInput $ foldr addTok ts' newtoks
361+ if n > 20 -- detect macro expansion loops
362+ then throwError $ PandocMacroLoop (T.unpack name)
363+ else doMacros (n + 1)
364+
365+setpos :: (Line, Column) -> Tok -> Tok
366+setpos spos (Tok _ tt txt) = Tok spos tt txt
367+
368+anyControlSeq :: PandocMonad m => LP m Tok
369+anyControlSeq = satisfyTok isCtrlSeq
370+ where isCtrlSeq (Tok _ (CtrlSeq _) _) = True
371+ isCtrlSeq _ = False
372+
373+anySymbol :: PandocMonad m => LP m Tok
374+anySymbol = satisfyTok isSym
375+ where isSym (Tok _ Symbol _) = True
376+ isSym _ = False
377+
378+spaces :: PandocMonad m => LP m ()
379+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
380+
381+spaces1 :: PandocMonad m => LP m ()
382+spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
383+
384+tokTypeIn :: [TokType] -> Tok -> Bool
385+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
386+
387+controlSeq :: PandocMonad m => Text -> LP m Tok
388+controlSeq name = satisfyTok isNamed
389+ where isNamed (Tok _ (CtrlSeq n) _) = n == name
390+ isNamed _ = False
391+
392+symbol :: PandocMonad m => Char -> LP m Tok
393+symbol c = satisfyTok isc
394+ where isc (Tok _ Symbol d) = case T.uncons d of
395+ Just (c',_) -> c == c'
396+ _ -> False
397+ isc _ = False
398+
399+symbolIn :: PandocMonad m => [Char] -> LP m Tok
400+symbolIn cs = satisfyTok isInCs
401+ where isInCs (Tok _ Symbol d) = case T.uncons d of
402+ Just (c,_) -> c `elem` cs
403+ _ -> False
404+ isInCs _ = False
117405
118406sp :: PandocMonad m => LP m ()
119407sp = whitespace <|> endline
120408
121409whitespace :: PandocMonad m => LP m ()
122−whitespace = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
123−
124−endline :: PandocMonad m => LP m ()
125−endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
410+whitespace = () <$ satisfyTok isSpaceTok
411+ where isSpaceTok (Tok _ Spaces _) = True
412+ isSpaceTok _ = False
126413
127−isLowerHex :: Char -> Bool
128−isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
414+newlineTok :: PandocMonad m => LP m ()
415+newlineTok = () <$ satisfyTok isNewlineTok
129416
130−tildeEscape :: PandocMonad m => LP m Char
131−tildeEscape = try $ do
132− string "^^"
133− c <- satisfy (\x -> x >= '\0' && x <= '\128')
134− d <- if isLowerHex c
135− then option "" $ count 1 (satisfy isLowerHex)
136− else return ""
137− if null d
138− then case ord c of
139− x | x >= 64 && x <= 127 -> return $ chr (x - 64)
140− | otherwise -> return $ chr (x + 64)
141− else return $ chr $ read ('0':'x':c:d)
417+isNewlineTok :: Tok -> Bool
418+isNewlineTok (Tok _ Newline _) = True
419+isNewlineTok _ = False
142420
143421comment :: PandocMonad m => LP m ()
144−comment = do
145− char '%'
146− skipMany (satisfy (/='\n'))
147− optional newline
148− return ()
422+comment = () <$ satisfyTok isCommentTok
423+ where isCommentTok (Tok _ Comment _) = True
424+ isCommentTok _ = False
149425
150−bgroup :: PandocMonad m => LP m ()
426+anyTok :: PandocMonad m => LP m Tok
427+anyTok = satisfyTok (const True)
428+
429+endline :: PandocMonad m => LP m ()
430+endline = try $ do
431+ newlineTok
432+ lookAhead anyTok
433+ notFollowedBy blankline
434+
435+blankline :: PandocMonad m => LP m ()
436+blankline = try $ skipMany whitespace *> newlineTok
437+
438+primEscape :: PandocMonad m => LP m Char
439+primEscape = do
440+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
441+ case toktype of
442+ Esc1 -> case T.uncons (T.drop 2 t) of
443+ Just (c, _)
444+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
445+ | otherwise -> return (chr (ord c + 64))
446+ Nothing -> fail "Empty content of Esc1"
447+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
448+ Just x -> return (chr x)
449+ Nothing -> fail $ "Could not read: " ++ T.unpack t
450+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
451+
452+bgroup :: PandocMonad m => LP m Tok
151453bgroup = try $ do
152− skipMany (spaceChar <|> try (newline <* notFollowedBy blankline))
153− () <$ char '{'
154− <|> () <$ controlSeq "bgroup"
155− <|> () <$ controlSeq "begingroup"
454+ skipMany sp
455+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
156456
157−egroup :: PandocMonad m => LP m ()
158−egroup = () <$ char '}'
159− <|> () <$ controlSeq "egroup"
160− <|> () <$ controlSeq "endgroup"
457+egroup :: PandocMonad m => LP m Tok
458+egroup = (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup")
161459
162−grouped :: PandocMonad m => Monoid a => LP m a -> LP m a
460+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
163461grouped parser = try $ do
164462 bgroup
165463 -- first we check for an inner 'grouped', because
166464 -- {{a,b}} should be parsed the same as {a,b}
167− try (grouped parser <* egroup)
168− <|> (mconcat <$> manyTill parser egroup)
169−
170−braced :: PandocMonad m => LP m String
171−braced = grouped chunk
172− where chunk =
173− many1 (satisfy (\c -> c /= '\\' && c /= '}' && c /= '{'))
174− <|> try (string "\\}")
175− <|> try (string "\\{")
176− <|> try (string "\\\\")
177− <|> ((\x -> "{" ++ x ++ "}") <$> braced)
178− <|> count 1 anyChar
465+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
466+
467+braced :: PandocMonad m => LP m [Tok]
468+braced = bgroup *> braced' 1
469+ where braced' (n :: Int) =
470+ handleEgroup n <|> handleBgroup n <|> handleOther n
471+ handleEgroup n = do
472+ t <- egroup
473+ if n == 1
474+ then return []
475+ else (t:) <$> braced' (n - 1)
476+ handleBgroup n = do
477+ t <- bgroup
478+ (t:) <$> braced' (n + 1)
479+ handleOther n = do
480+ t <- anyTok
481+ (t:) <$> braced' n
179482
180483bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
181−bracketed parser = try $ char '[' *> (mconcat <$> manyTill parser (char ']'))
182−
183−mathDisplay :: PandocMonad m => LP m String -> LP m Inlines
184−mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
185−
186−mathInline :: PandocMonad m => LP m String -> LP m Inlines
187−mathInline p = math <$> (try p >>= applyMacros')
188−
189−mathChars :: PandocMonad m => LP m String
190−mathChars =
191− concat <$> many (escapedChar
192− <|> (snd <$> withRaw braced)
193− <|> many1 (satisfy isOrdChar))
194− where escapedChar = try $ do char '\\'
195− c <- anyChar
196− return ['\\',c]
197− isOrdChar '$' = False
198− isOrdChar '{' = False
199− isOrdChar '}' = False
200− isOrdChar '\\' = False
201− isOrdChar _ = True
202−
203−quoted' :: PandocMonad m => (Inlines -> Inlines) -> LP m String -> LP m () -> LP m Inlines
204−quoted' f starter ender = do
205− startchs <- starter
206− smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
207− if smart
208− then do
209− ils <- many (notFollowedBy ender >> inline)
210− (ender >> return (f (mconcat ils))) <|>
211− (<> mconcat ils) <$>
212− lit (case startchs of
213− "``" -> "“"
214− "`" -> "‘"
215− _ -> startchs)
216− else lit startchs
484+bracketed parser = try $ do
485+ symbol '['
486+ mconcat <$> manyTill parser (symbol ']')
217487
218−doubleQuote :: PandocMonad m => LP m Inlines
219−doubleQuote = do
220− quoted' doubleQuoted (try $ string "``") (void $ try $ string "''")
221− <|> quoted' doubleQuoted (string "“") (void $ char '”')
222− -- the following is used by babel for localized quotes:
223− <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'")
224− <|> quoted' doubleQuoted (string "\"") (void $ char '"')
488+dimenarg :: PandocMonad m => LP m Text
489+dimenarg = try $ do
490+ ch <- option False $ True <$ symbol '='
491+ Tok _ _ s <- satisfyTok isWordTok
492+ guard $ (T.take 2 (T.reverse s)) `elem`
493+ ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
494+ let num = T.take (T.length s - 2) s
495+ guard $ T.length num > 0
496+ guard $ T.all isDigit num
497+ return $ T.pack ['=' | ch] <> s
225498
226−singleQuote :: PandocMonad m => LP m Inlines
227−singleQuote = do
228− smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
229− if smart
230− then quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter)
231− <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter)
232− else str <$> many1 (oneOf "`\'‘’")
499+-- inline elements:
233500
234−inline :: PandocMonad m => LP m Inlines
235−inline = (mempty <$ comment)
236− <|> (space <$ whitespace)
237− <|> (softbreak <$ endline)
238− <|> inlineText
239− <|> inlineCommand
240− <|> inlineEnvironment
241− <|> inlineGroup
242− <|> (char '-' *> option (str "-")
243− (char '-' *> option (str "–") (str "—" <$ char '-')))
244− <|> doubleQuote
245− <|> singleQuote
246− <|> (str "”" <$ try (string "''"))
247− <|> (str "”" <$ char '”')
248− <|> (str "’" <$ char '\'')
249− <|> (str "’" <$ char '’')
250− <|> (str "\160" <$ char '~')
251− <|> mathDisplay (string "$$" *> mathChars <* string "$$")
252− <|> mathInline (char '$' *> mathChars <* char '$')
253− <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
254− <|> (str . (:[]) <$> tildeEscape)
255− <|> (do res <- oneOf "#&~^'`\"[]"
256− pos <- getPosition
257− report $ ParsingUnescaped [res] pos
258− return $ str [res])
501+word :: PandocMonad m => LP m Inlines
502+word = (str . T.unpack . untoken) <$> satisfyTok isWordTok
259503
260−inlines :: PandocMonad m => LP m Inlines
261−inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
504+regularSymbol :: PandocMonad m => LP m Inlines
505+regularSymbol = (str . T.unpack . untoken) <$> satisfyTok isRegularSymbol
506+ where isRegularSymbol (Tok _ Symbol t) = not $ T.any isSpecial t
507+ isRegularSymbol _ = False
508+ isSpecial c = c `Set.member` specialChars
509+
510+specialChars :: Set.Set Char
511+specialChars = Set.fromList "#$%&~_^\\{}"
512+
513+isWordTok :: Tok -> Bool
514+isWordTok (Tok _ Word _) = True
515+isWordTok _ = False
262516
263517inlineGroup :: PandocMonad m => LP m Inlines
264518inlineGroup = do
@@ -269,233 +523,571 @@ inlineGroup = do
269523 -- we need the span so we can detitlecase bibtex entries;
270524 -- we need to know when something is {C}apitalized
271525
272−block :: PandocMonad m => LP m Blocks
273−block = (mempty <$ comment)
274− <|> (mempty <$ ((spaceChar <|> newline) *> spaces))
275− <|> environment
276− <|> include
277− <|> macro
278− <|> blockCommand
279− <|> paragraph
280− <|> grouped block
281−
282−blocks :: PandocMonad m => LP m Blocks
283−blocks = mconcat <$> many block
284−
285−getRawCommand :: PandocMonad m => String -> LP m String
286−getRawCommand name' = do
287− rawargs <- withRaw (many (try (optional sp *> opt)) *>
288− option "" (try (optional sp *> dimenarg)) *>
289− many braced)
290− return $ '\\' : name' ++ snd rawargs
526+doLHSverb :: PandocMonad m => LP m Inlines
527+doLHSverb =
528+ (codeWith ("",["haskell"],[]) . T.unpack . untokenize)
529+ <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')
291530
292−lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
293−lookupListDefault d = (fromMaybe d .) . lookupList
294− where
295− lookupList l m = msum $ map (`M.lookup` m) l
531+mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines
532+mkImage options src = do
533+ let replaceTextwidth (k,v) =
534+ case numUnit v of
535+ Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
536+ _ -> (k, v)
537+ let kvs = map replaceTextwidth
538+ $ filter (\(k,_) -> k `elem` ["width", "height"]) options
539+ let attr = ("",[], kvs)
540+ let alt = str "image"
541+ case takeExtension src of
542+ "" -> do
543+ defaultExt <- getOption readerDefaultImageExtension
544+ return $ imageWith attr (addExtension src defaultExt) "" alt
545+ _ -> return $ imageWith attr src "" alt
296546
297−blockCommand :: PandocMonad m => LP m Blocks
298−blockCommand = try $ do
299− name <- anyControlSeq
300− guard $ name /= "begin" && name /= "end"
301− star <- option "" (string "*" <* optional sp)
302− let name' = name ++ star
303− let raw = do
304− rawcommand <- getRawCommand name'
305− transformed <- applyMacros' rawcommand
306− guard $ transformed /= rawcommand
307− notFollowedBy $ parseFromString' inlines transformed
308− parseFromString' blocks transformed
309− lookupListDefault raw [name',name] blockCommands
547+-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
548+dosiunitx :: PandocMonad m => LP m Inlines
549+dosiunitx = do
550+ skipopts
551+ value <- tok
552+ valueprefix <- option "" $ bracketed tok
553+ unit <- tok
554+ let emptyOr160 "" = ""
555+ emptyOr160 _ = "\160"
556+ return . mconcat $ [valueprefix,
557+ emptyOr160 valueprefix,
558+ value,
559+ emptyOr160 unit,
560+ unit]
310561
311−inBrackets :: Inlines -> Inlines
312−inBrackets x = str "[" <> x <> str "]"
562+lit :: String -> LP m Inlines
563+lit = pure . str
313564
314−-- eat an optional argument and one or more arguments in braces
315−ignoreInlines :: PandocMonad m => String -> (String, LP m Inlines)
316−ignoreInlines name = (name, p)
317− where
318− p = do oa <- optargs
319− let rawCommand = '\\':name ++ oa
320− let doraw = guardRaw >> return (rawInline "latex" rawCommand)
321− doraw <|> ignore rawCommand
565+removeDoubleQuotes :: Text -> Text
566+removeDoubleQuotes t =
567+ maybe t id $ T.stripPrefix "\"" t >>= T.stripSuffix "\""
322568
323−guardRaw :: PandocMonad m => LP m ()
324−guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
569+doubleQuote :: PandocMonad m => LP m Inlines
570+doubleQuote = do
571+ quoted' doubleQuoted (try $ count 2 $ symbol '`')
572+ (void $ try $ count 2 $ symbol '\'')
573+ <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')
574+ -- the following is used by babel for localized quotes:
575+ <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])
576+ (void $ try $ sequence [symbol '"', symbol '\''])
577+ <|> quoted' doubleQuoted ((:[]) <$> symbol '"')
578+ (void $ symbol '"')
325579
326−optargs :: PandocMonad m => LP m String
327−optargs = snd <$> withRaw (skipopts *> skipMany (try $ optional sp *> braced))
580+singleQuote :: PandocMonad m => LP m Inlines
581+singleQuote = do
582+ quoted' singleQuoted ((:[]) <$> symbol '`')
583+ (try $ symbol '\'' >>
584+ notFollowedBy (satisfyTok startsWithLetter))
585+ <|> quoted' singleQuoted ((:[]) <$> symbol '‘')
586+ (try $ symbol '’' >>
587+ notFollowedBy (satisfyTok startsWithLetter))
588+ where startsWithLetter (Tok _ Word t) =
589+ case T.uncons t of
590+ Just (c, _) | isLetter c -> True
591+ _ -> False
592+ startsWithLetter _ = False
593+
594+quoted' :: PandocMonad m
595+ => (Inlines -> Inlines)
596+ -> LP m [Tok]
597+ -> LP m ()
598+ -> LP m Inlines
599+quoted' f starter ender = do
600+ startchs <- (T.unpack . untokenize) <$> starter
601+ smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
602+ if smart
603+ then do
604+ ils <- many (notFollowedBy ender >> inline)
605+ (ender >> return (f (mconcat ils))) <|>
606+ (<> mconcat ils) <$>
607+ lit (case startchs of
608+ "``" -> "“"
609+ "`" -> "‘"
610+ cs -> cs)
611+ else lit startchs
328612
329−ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
330−ignore raw = do
331− pos <- getPosition
332− report $ SkippedContent raw pos
333− return mempty
613+enquote :: PandocMonad m => LP m Inlines
614+enquote = do
615+ skipopts
616+ quoteContext <- sQuoteContext <$> getState
617+ if quoteContext == InDoubleQuote
618+ then singleQuoted <$> withQuoteContext InSingleQuote tok
619+ else doubleQuoted <$> withQuoteContext InDoubleQuote tok
334620
335−ignoreBlocks :: PandocMonad m => String -> (String, LP m Blocks)
336−ignoreBlocks name = (name, p)
337− where
338− p = do oa <- optargs
339− let rawCommand = '\\':name ++ oa
340− let doraw = guardRaw >> return (rawBlock "latex" rawCommand)
341− doraw <|> ignore rawCommand
621+doverb :: PandocMonad m => LP m Inlines
622+doverb = do
623+ Tok _ Symbol t <- anySymbol
624+ marker <- case T.uncons t of
625+ Just (c, ts) | T.null ts -> return c
626+ _ -> mzero
627+ withVerbatimMode $
628+ (code . T.unpack . untokenize) <$>
629+ manyTill (verbTok marker) (symbol marker)
630+
631+verbTok :: PandocMonad m => Char -> LP m Tok
632+verbTok stopchar = do
633+ t@(Tok (lin, col) toktype txt) <- satisfyTok (not . isNewlineTok)
634+ case T.findIndex (== stopchar) txt of
635+ Nothing -> return t
636+ Just i -> do
637+ let (t1, t2) = T.splitAt i txt
638+ inp <- getInput
639+ setInput $ Tok (lin, col + i) Symbol (T.singleton stopchar)
640+ : (totoks (lin, col + i + 1) (T.drop 1 t2)) ++ inp
641+ return $ Tok (lin, col) toktype t1
342642
343−blockCommands :: PandocMonad m => M.Map String (LP m Blocks)
344−blockCommands = M.fromList $
345− [ ("par", mempty <$ skipopts)
346− , ("parbox", braced >> grouped blocks)
347− , ("title", mempty <$ (skipopts *>
348− (grouped inline >>= addMeta "title")
349− <|> (grouped block >>= addMeta "title")))
350− , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
351− , ("author", mempty <$ (skipopts *> authors))
352− -- -- in letter class, temp. store address & sig as title, author
353− , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
354− , ("signature", mempty <$ (skipopts *> authors))
355− , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
356− -- Koma-script metadata commands
357− , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
358− -- sectioning
359− , ("part", section nullAttr (-1))
360− , ("part*", section nullAttr (-1))
361− , ("chapter", section nullAttr 0)
362− , ("chapter*", section ("",["unnumbered"],[]) 0)
363− , ("section", section nullAttr 1)
364− , ("section*", section ("",["unnumbered"],[]) 1)
365− , ("subsection", section nullAttr 2)
366− , ("subsection*", section ("",["unnumbered"],[]) 2)
367− , ("subsubsection", section nullAttr 3)
368− , ("subsubsection*", section ("",["unnumbered"],[]) 3)
369− , ("paragraph", section nullAttr 4)
370− , ("paragraph*", section ("",["unnumbered"],[]) 4)
371− , ("subparagraph", section nullAttr 5)
372− , ("subparagraph*", section ("",["unnumbered"],[]) 5)
373− -- beamer slides
374− , ("frametitle", section nullAttr 3)
375− , ("framesubtitle", section nullAttr 4)
376− -- letters
377− , ("opening", (para . trimInlines) <$> (skipopts *> tok))
378− , ("closing", skipopts *> closing)
379− --
380− , ("hrule", pure horizontalRule)
381− , ("strut", pure mempty)
382− , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
383− , ("item", skipopts *> looseItem)
384− , ("documentclass", skipopts *> braced *> preamble)
385− , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
386− , ("caption", skipopts *> setCaption)
387− , ("bibliography", mempty <$ (skipopts *> braced >>=
388− addMeta "bibliography" . splitBibs))
389− , ("addbibresource", mempty <$ (skipopts *> braced >>=
390− addMeta "bibliography" . splitBibs))
391− -- includes
392− , ("lstinputlisting", inputListing)
393− , ("graphicspath", graphicsPath)
394− -- hyperlink
395− , ("hypertarget", braced >> grouped block)
396− ] ++ map ignoreBlocks
397− -- these commands will be ignored unless --parse-raw is specified,
398− -- in which case they will appear as raw latex blocks
399− [ "newcommand", "renewcommand", "newenvironment", "renewenvironment"
400− -- newcommand, etc. should be parsed by macro, but we need this
401− -- here so these aren't parsed as inline commands to ignore
402− , "special", "pdfannot", "pdfstringdef"
403− , "bibliographystyle"
404− , "maketitle", "makeindex", "makeglossary"
405− , "addcontentsline", "addtocontents", "addtocounter"
406− -- \ignore{} is used conventionally in literate haskell for definitions
407− -- that are to be processed by the compiler but not printed.
408− , "ignore"
409− , "hyperdef"
410− , "markboth", "markright", "markleft"
411− , "hspace", "vspace"
412− , "newpage"
413− , "clearpage"
414− , "pagebreak"
415− ]
643+dolstinline :: PandocMonad m => LP m Inlines
644+dolstinline = do
645+ options <- option [] keyvals
646+ let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
647+ Tok _ Symbol t <- anySymbol
648+ marker <- case T.uncons t of
649+ Just (c, ts) | T.null ts -> return c
650+ _ -> mzero
651+ let stopchar = if marker == '{' then '}' else marker
652+ withVerbatimMode $
653+ (codeWith ("",classes,[]) . T.unpack . untokenize) <$>
654+ manyTill (verbTok stopchar) (symbol stopchar)
416655
417−graphicsPath :: PandocMonad m => LP m Blocks
418−graphicsPath = do
419− ps <- bgroup *> (manyTill braced egroup)
420− getResourcePath >>= setResourcePath . (++ ps)
421− return mempty
656+keyval :: PandocMonad m => LP m (String, String)
657+keyval = try $ do
658+ Tok _ Word key <- satisfyTok isWordTok
659+ let isSpecSym (Tok _ Symbol t) = t `elem` [".",":","-","|","\\"]
660+ isSpecSym _ = False
661+ val <- option [] $ do
662+ symbol '='
663+ braced <|> (many1 (satisfyTok isWordTok <|> satisfyTok isSpecSym))
664+ optional sp
665+ optional (symbol ',')
666+ optional sp
667+ return (T.unpack key, T.unpack . untokenize $ val)
422668
423−addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
424−addMeta field val = updateState $ \st ->
425− st{ stateMeta = addMetaField field val $ stateMeta st }
669+keyvals :: PandocMonad m => LP m [(String, String)]
670+keyvals = try $ symbol '[' >> manyTill keyval (symbol ']')
426671
427−splitBibs :: String -> [Inlines]
428−splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')
672+accent :: (Char -> String) -> Inlines -> LP m Inlines
673+accent f ils =
674+ case toList ils of
675+ (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
676+ [] -> mzero
677+ _ -> return ils
429678
430−setCaption :: PandocMonad m => LP m Blocks
431−setCaption = do
432− ils <- tok
433− mblabel <- option Nothing $
434− try $ spaces' >> controlSeq "label" >> (Just <$> tok)
435− let ils' = case mblabel of
436− Just lab -> ils <> spanWith
437− ("",[],[("data-label", stringify lab)]) mempty
438− Nothing -> ils
439− updateState $ \st -> st{ stateCaption = Just ils' }
440− return mempty
679+grave :: Char -> String
680+grave 'A' = "À"
681+grave 'E' = "È"
682+grave 'I' = "Ì"
683+grave 'O' = "Ò"
684+grave 'U' = "Ù"
685+grave 'a' = "à"
686+grave 'e' = "è"
687+grave 'i' = "ì"
688+grave 'o' = "ò"
689+grave 'u' = "ù"
690+grave c = [c]
441691
442−resetCaption :: PandocMonad m => LP m ()
443−resetCaption = updateState $ \st -> st{ stateCaption = Nothing }
692+acute :: Char -> String
693+acute 'A' = "Á"
694+acute 'E' = "É"
695+acute 'I' = "Í"
696+acute 'O' = "Ó"
697+acute 'U' = "Ú"
698+acute 'Y' = "Ý"
699+acute 'a' = "á"
700+acute 'e' = "é"
701+acute 'i' = "í"
702+acute 'o' = "ó"
703+acute 'u' = "ú"
704+acute 'y' = "ý"
705+acute 'C' = "Ć"
706+acute 'c' = "ć"
707+acute 'L' = "Ĺ"
708+acute 'l' = "ĺ"
709+acute 'N' = "Ń"
710+acute 'n' = "ń"
711+acute 'R' = "Ŕ"
712+acute 'r' = "ŕ"
713+acute 'S' = "Ś"
714+acute 's' = "ś"
715+acute 'Z' = "Ź"
716+acute 'z' = "ź"
717+acute c = [c]
444718
445−authors :: PandocMonad m => LP m ()
446−authors = try $ do
447− bgroup
448− let oneAuthor = mconcat <$>
449− many1 (notFollowedBy' (controlSeq "and") >>
450− (inline <|> mempty <$ blockCommand))
451− -- skip e.g. \vspace{10pt}
452− auths <- sepBy oneAuthor (controlSeq "and")
453− egroup
454− addMeta "author" (map trimInlines auths)
719+circ :: Char -> String
720+circ 'A' = "Â"
721+circ 'E' = "Ê"
722+circ 'I' = "Î"
723+circ 'O' = "Ô"
724+circ 'U' = "Û"
725+circ 'a' = "â"
726+circ 'e' = "ê"
727+circ 'i' = "î"
728+circ 'o' = "ô"
729+circ 'u' = "û"
730+circ 'C' = "Ĉ"
731+circ 'c' = "ĉ"
732+circ 'G' = "Ĝ"
733+circ 'g' = "ĝ"
734+circ 'H' = "Ĥ"
735+circ 'h' = "ĥ"
736+circ 'J' = "Ĵ"
737+circ 'j' = "ĵ"
738+circ 'S' = "Ŝ"
739+circ 's' = "ŝ"
740+circ 'W' = "Ŵ"
741+circ 'w' = "ŵ"
742+circ 'Y' = "Ŷ"
743+circ 'y' = "ŷ"
744+circ c = [c]
455745
456−section :: PandocMonad m => Attr -> Int -> LP m Blocks
457−section (ident, classes, kvs) lvl = do
458− skipopts
459− contents <- grouped inline
460− lab <- option ident $ try (spaces' >> controlSeq "label" >> spaces' >> braced)
461− attr' <- registerHeader (lab, classes, kvs) contents
462− return $ headerWith attr' lvl contents
746+tilde :: Char -> String
747+tilde 'A' = "Ã"
748+tilde 'a' = "ã"
749+tilde 'O' = "Õ"
750+tilde 'o' = "õ"
751+tilde 'I' = "Ĩ"
752+tilde 'i' = "ĩ"
753+tilde 'U' = "Ũ"
754+tilde 'u' = "ũ"
755+tilde 'N' = "Ñ"
756+tilde 'n' = "ñ"
757+tilde c = [c]
463758
464−inlineCommand :: PandocMonad m => LP m Inlines
465−inlineCommand = try $ do
466− (name, raw') <- withRaw anyControlSeq
467− guard $ name /= "begin" && name /= "end"
468− star <- option "" (string "*")
469− let name' = name ++ star
759+umlaut :: Char -> String
760+umlaut 'A' = "Ä"
761+umlaut 'E' = "Ë"
762+umlaut 'I' = "Ï"
763+umlaut 'O' = "Ö"
764+umlaut 'U' = "Ü"
765+umlaut 'a' = "ä"
766+umlaut 'e' = "ë"
767+umlaut 'i' = "ï"
768+umlaut 'o' = "ö"
769+umlaut 'u' = "ü"
770+umlaut c = [c]
771+
772+hungarumlaut :: Char -> String
773+hungarumlaut 'A' = "A̋"
774+hungarumlaut 'E' = "E̋"
775+hungarumlaut 'I' = "I̋"
776+hungarumlaut 'O' = "Ő"
777+hungarumlaut 'U' = "Ű"
778+hungarumlaut 'Y' = "ӳ"
779+hungarumlaut 'a' = "a̋"
780+hungarumlaut 'e' = "e̋"
781+hungarumlaut 'i' = "i̋"
782+hungarumlaut 'o' = "ő"
783+hungarumlaut 'u' = "ű"
784+hungarumlaut 'y' = "ӳ"
785+hungarumlaut c = [c]
786+
787+dot :: Char -> String
788+dot 'C' = "Ċ"
789+dot 'c' = "ċ"
790+dot 'E' = "Ė"
791+dot 'e' = "ė"
792+dot 'G' = "Ġ"
793+dot 'g' = "ġ"
794+dot 'I' = "İ"
795+dot 'Z' = "Ż"
796+dot 'z' = "ż"
797+dot c = [c]
798+
799+macron :: Char -> String
800+macron 'A' = "Ā"
801+macron 'E' = "Ē"
802+macron 'I' = "Ī"
803+macron 'O' = "Ō"
804+macron 'U' = "Ū"
805+macron 'a' = "ā"
806+macron 'e' = "ē"
807+macron 'i' = "ī"
808+macron 'o' = "ō"
809+macron 'u' = "ū"
810+macron c = [c]
811+
812+cedilla :: Char -> String
813+cedilla 'c' = "ç"
814+cedilla 'C' = "Ç"
815+cedilla 's' = "ş"
816+cedilla 'S' = "Ş"
817+cedilla 't' = "ţ"
818+cedilla 'T' = "Ţ"
819+cedilla 'e' = "ȩ"
820+cedilla 'E' = "Ȩ"
821+cedilla 'h' = "ḩ"
822+cedilla 'H' = "Ḩ"
823+cedilla 'o' = "o̧"
824+cedilla 'O' = "O̧"
825+cedilla c = [c]
826+
827+hacek :: Char -> String
828+hacek 'A' = "Ǎ"
829+hacek 'a' = "ǎ"
830+hacek 'C' = "Č"
831+hacek 'c' = "č"
832+hacek 'D' = "Ď"
833+hacek 'd' = "ď"
834+hacek 'E' = "Ě"
835+hacek 'e' = "ě"
836+hacek 'G' = "Ǧ"
837+hacek 'g' = "ǧ"
838+hacek 'H' = "Ȟ"
839+hacek 'h' = "ȟ"
840+hacek 'I' = "Ǐ"
841+hacek 'i' = "ǐ"
842+hacek 'j' = "ǰ"
843+hacek 'K' = "Ǩ"
844+hacek 'k' = "ǩ"
845+hacek 'L' = "Ľ"
846+hacek 'l' = "ľ"
847+hacek 'N' = "Ň"
848+hacek 'n' = "ň"
849+hacek 'O' = "Ǒ"
850+hacek 'o' = "ǒ"
851+hacek 'R' = "Ř"
852+hacek 'r' = "ř"
853+hacek 'S' = "Š"
854+hacek 's' = "š"
855+hacek 'T' = "Ť"
856+hacek 't' = "ť"
857+hacek 'U' = "Ǔ"
858+hacek 'u' = "ǔ"
859+hacek 'Z' = "Ž"
860+hacek 'z' = "ž"
861+hacek c = [c]
862+
863+breve :: Char -> String
864+breve 'A' = "Ă"
865+breve 'a' = "ă"
866+breve 'E' = "Ĕ"
867+breve 'e' = "ĕ"
868+breve 'G' = "Ğ"
869+breve 'g' = "ğ"
870+breve 'I' = "Ĭ"
871+breve 'i' = "ĭ"
872+breve 'O' = "Ŏ"
873+breve 'o' = "ŏ"
874+breve 'U' = "Ŭ"
875+breve 'u' = "ŭ"
876+breve c = [c]
877+
878+toksToString :: [Tok] -> String
879+toksToString = T.unpack . untokenize
880+
881+mathDisplay :: String -> Inlines
882+mathDisplay = displayMath . trim
883+
884+mathInline :: String -> Inlines
885+mathInline = math . trim
886+
887+dollarsMath :: PandocMonad m => LP m Inlines
888+dollarsMath = do
889+ symbol '$'
890+ display <- option False (True <$ symbol '$')
891+ contents <- trim . toksToString <$>
892+ many (notFollowedBy (symbol '$') >> anyTok)
893+ if display
894+ then do
895+ mathDisplay contents <$ try (symbol '$' >> symbol '$')
896+ <|> (guard (null contents) >> return (mathInline ""))
897+ else mathInline contents <$ (symbol '$')
898+
899+-- citations
900+
901+addPrefix :: [Inline] -> [Citation] -> [Citation]
902+addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
903+addPrefix _ _ = []
904+
905+addSuffix :: [Inline] -> [Citation] -> [Citation]
906+addSuffix s ks@(_:_) =
907+ let k = last ks
908+ in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
909+addSuffix _ _ = []
910+
911+simpleCiteArgs :: PandocMonad m => LP m [Citation]
912+simpleCiteArgs = try $ do
913+ first <- optionMaybe $ toList <$> opt
914+ second <- optionMaybe $ toList <$> opt
915+ keys <- try $ bgroup *> (manyTill citationLabel egroup)
916+ let (pre, suf) = case (first , second ) of
917+ (Just s , Nothing) -> (mempty, s )
918+ (Just s , Just t ) -> (s , t )
919+ _ -> (mempty, mempty)
920+ conv k = Citation { citationId = k
921+ , citationPrefix = []
922+ , citationSuffix = []
923+ , citationMode = NormalCitation
924+ , citationHash = 0
925+ , citationNoteNum = 0
926+ }
927+ return $ addPrefix pre $ addSuffix suf $ map conv keys
928+
929+citationLabel :: PandocMonad m => LP m String
930+citationLabel = do
931+ optional sp
932+ toksToString <$>
933+ (many1 (satisfyTok isWordTok <|> symbolIn bibtexKeyChar)
934+ <* optional sp
935+ <* optional (symbol ',')
936+ <* optional sp)
937+ where bibtexKeyChar = ".:;?!`'()/*@_+=-[]" :: [Char]
938+
939+cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
940+cites mode multi = try $ do
941+ cits <- if multi
942+ then many1 simpleCiteArgs
943+ else count 1 simpleCiteArgs
944+ let cs = concat cits
945+ return $ case mode of
946+ AuthorInText -> case cs of
947+ (c:rest) -> c {citationMode = mode} : rest
948+ [] -> []
949+ _ -> map (\a -> a {citationMode = mode}) cs
950+
951+citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines
952+citation name mode multi = do
953+ (c,raw) <- withRaw $ cites mode multi
954+ return $ cite c (rawInline "latex" $ "\\" ++ name ++ (toksToString raw))
955+
956+handleCitationPart :: Inlines -> [Citation]
957+handleCitationPart ils =
958+ let isCite Cite{} = True
959+ isCite _ = False
960+ (pref, rest) = break isCite (toList ils)
961+ in case rest of
962+ (Cite cs _:suff) -> addPrefix pref $ addSuffix suff cs
963+ _ -> []
964+
965+complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
966+complexNatbibCitation mode = try $ do
967+ (cs, raw) <-
968+ withRaw $ concat <$> do
969+ bgroup
970+ items <- mconcat <$>
971+ many1 (notFollowedBy (symbol ';') >> inline)
972+ `sepBy1` (symbol ';')
973+ egroup
974+ return $ map handleCitationPart items
975+ case cs of
976+ [] -> mzero
977+ (c:cits) -> return $ cite (c{ citationMode = mode }:cits)
978+ (rawInline "latex" $ "\\citetext" ++ toksToString raw)
979+
980+inNote :: Inlines -> Inlines
981+inNote ils =
982+ note $ para $ ils <> str "."
983+
984+inlineCommand' :: PandocMonad m => LP m Inlines
985+inlineCommand' = try $ do
986+ Tok _ (CtrlSeq name) cmd <- anyControlSeq
987+ guard $ name /= "begin" && name /= "end"
988+ (star, rawstar) <- withRaw $ option "" ("*" <$ symbol '*' <* optional sp)
989+ let name' = name <> star
990+ let names = ordNub [name', name] -- check non-starred as fallback
470991 let raw = do
471− guard $ not (isBlockCommand name)
472− rawargs <- withRaw
473− (skipangles *> skipopts *> option "" dimenarg *> many braced)
474− let rawcommand = raw' ++ star ++ snd rawargs
475− transformed <- applyMacros' rawcommand
476− exts <- getOption readerExtensions
477− if transformed /= rawcommand
478− then parseFromString' inlines transformed
479− else if extensionEnabled Ext_raw_tex exts
480− then return $ rawInline "latex" rawcommand
481− else ignore rawcommand
482− (lookupListDefault raw [name',name] inlineCommands <*
483− optional (try (string "{}")))
484−
485−rawInlineOr :: PandocMonad m => String -> LP m Inlines -> LP m Inlines
486−rawInlineOr name' fallback = do
487− parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
488− if parseRaw
489− then rawInline "latex" <$> getRawCommand name'
490− else fallback
992+ guard $ not (isBlockCommand name)
993+ (_, rawargs) <- withRaw
994+ (skipangles *> skipopts *> option "" dimenarg *> many braced)
995+ let rawcommand = T.unpack $ cmd <> untokenize (rawstar ++ rawargs)
996+ (guardEnabled Ext_raw_tex >> return (rawInline "latex" rawcommand))
997+ <|> ignore rawcommand
998+ lookupListDefault raw names inlineCommands
999+
1000+tok :: PandocMonad m => LP m Inlines
1001+tok = grouped inline <|> inlineCommand' <|> singleChar
1002+ where singleChar = try $ do
1003+ Tok (lin,col) toktype t <- satisfyTok (tokTypeIn [Word, Symbol])
1004+ guard $ not $ toktype == Symbol &&
1005+ T.any (`Set.member` specialChars) t
1006+ if T.length t > 1
1007+ then do
1008+ let (t1, t2) = (T.take 1 t, T.drop 1 t)
1009+ inp <- getInput
1010+ setInput $ (Tok (lin, col + 1) toktype t2) : inp
1011+ return $ str (T.unpack t1)
1012+ else return $ str (T.unpack t)
1013+
1014+opt :: PandocMonad m => LP m Inlines
1015+opt = bracketed inline
1016+
1017+rawopt :: PandocMonad m => LP m Text
1018+rawopt = do
1019+ symbol '['
1020+ inner <- untokenize <$> manyTill anyTok (symbol ']')
1021+ optional sp
1022+ return $ "[" <> inner <> "]"
1023+
1024+skipopts :: PandocMonad m => LP m ()
1025+skipopts = skipMany rawopt
1026+
1027+guardRaw :: PandocMonad m => LP m ()
1028+guardRaw = getOption readerExtensions >>= guard . extensionEnabled Ext_raw_tex
1029+
1030+optargs :: PandocMonad m => LP m Text
1031+optargs = do
1032+ (_, raw) <- withRaw (skipopts *> skipMany (try $ optional sp *> braced))
1033+ return $ untokenize raw
1034+
1035+-- opts in angle brackets are used in beamer
1036+rawangle :: PandocMonad m => LP m ()
1037+rawangle = try $ do
1038+ symbol '<'
1039+ () <$ manyTill anyTok (symbol '>')
1040+
1041+skipangles :: PandocMonad m => LP m ()
1042+skipangles = skipMany rawangle
1043+
1044+ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a
1045+ignore raw = do
1046+ pos <- getPosition
1047+ report $ SkippedContent raw pos
1048+ return mempty
1049+
1050+withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
1051+withRaw parser = do
1052+ inp <- getInput
1053+ result <- parser
1054+ nxt <- option (Tok (0,0) Word "") (lookAhead anyTok)
1055+ let raw = takeWhile (/= nxt) inp
1056+ return (result, raw)
1057+
1058+inBrackets :: Inlines -> Inlines
1059+inBrackets x = str "[" <> x <> str "]"
1060+
1061+unescapeURL :: String -> String
1062+unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
1063+ where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String)
1064+unescapeURL (x:xs) = x:unescapeURL xs
1065+unescapeURL [] = ""
1066+
1067+mathEnvWith :: PandocMonad m
1068+ => (Inlines -> a) -> Maybe Text -> Text -> LP m a
1069+mathEnvWith f innerEnv name = f . mathDisplay . inner <$> mathEnv name
1070+ where inner x = case innerEnv of
1071+ Nothing -> x
1072+ Just y -> "\\begin{" ++ T.unpack y ++ "}\n" ++ x ++
1073+ "\\end{" ++ T.unpack y ++ "}"
4911074
492−isBlockCommand :: String -> Bool
493−isBlockCommand s = s `M.member` (blockCommands :: M.Map String (LP PandocPure Blocks))
1075+mathEnv :: PandocMonad m => Text -> LP m String
1076+mathEnv name = do
1077+ skipopts
1078+ optional blankline
1079+ res <- manyTill anyTok (end_ name)
1080+ return $ stripTrailingNewlines $ T.unpack $ untokenize res
4941081
1082+inlineEnvironment :: PandocMonad m => LP m Inlines
1083+inlineEnvironment = try $ do
1084+ controlSeq "begin"
1085+ name <- untokenize <$> braced
1086+ M.findWithDefault mzero name inlineEnvironments
4951087
496−inlineEnvironments :: PandocMonad m => M.Map String (LP m Inlines)
497−inlineEnvironments = M.fromList
498− [ ("displaymath", mathEnvWith id Nothing "displaymath")
1088+inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)
1089+inlineEnvironments = M.fromList [
1090+ ("displaymath", mathEnvWith id Nothing "displaymath")
4991091 , ("math", math <$> mathEnv "math")
5001092 , ("equation", mathEnvWith id Nothing "equation")
5011093 , ("equation*", mathEnvWith id Nothing "equation*")
@@ -511,7 +1103,7 @@ inlineEnvironments = M.fromList
5111103 , ("alignat*", mathEnvWith id (Just "aligned") "alignat*")
5121104 ]
5131105
514−inlineCommands :: PandocMonad m => M.Map String (LP m Inlines)
1106+inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
5151107inlineCommands = M.fromList $
5161108 [ ("emph", extractSpaces emph <$> tok)
5171109 , ("textit", extractSpaces emph <$> tok)
@@ -540,9 +1132,9 @@ inlineCommands = M.fromList $
5401132 , ("textgreek", tok)
5411133 , ("sep", lit ",")
5421134 , ("cref", rawInlineOr "cref" (inBrackets <$> tok)) -- from cleveref.sty
543− , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
544− , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
545− , ("ensuremath", mathInline braced)
1135+ , ("(", mathInline . toksToString <$> manyTill anyTok (controlSeq ")"))
1136+ , ("[", mathDisplay . toksToString <$> manyTill anyTok (controlSeq "]"))
1137+ , ("ensuremath", mathInline . toksToString <$> braced)
5461138 , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok)
5471139 , ("P", lit "¶")
5481140 , ("S", lit "§")
@@ -592,7 +1184,10 @@ inlineCommands = M.fromList $
5921184 , ("v", option (str "v") $ try $ tok >>= accent hacek)
5931185 , ("u", option (str "u") $ try $ tok >>= accent breve)
5941186 , ("i", lit "i")
595− , ("\\", linebreak <$ (optional (bracketed inline) *> spaces'))
1187+ , ("\\", linebreak <$ (do inTableCell <- sInTableCell <$> getState
1188+ guard $ not inTableCell
1189+ optional (bracketed inline)
1190+ spaces))
5961191 , (",", lit "\8198")
5971192 , ("@", pure mempty)
5981193 , (" ", lit "\160")
@@ -607,13 +1202,14 @@ inlineCommands = M.fromList $
6071202 , ("verb", doverb)
6081203 , ("lstinline", dolstinline)
6091204 , ("Verb", doverb)
610− , ("url", (unescapeURL <$> braced) >>= \url ->
611− pure (link url "" (str url)))
612− , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
613− tok >>= \lab ->
614− pure (link url "" lab))
1205+ , ("url", ((unescapeURL . T.unpack . untokenize) <$> braced) >>= \url ->
1206+ pure (link url "" (str url)))
1207+ , ("href", (unescapeURL . toksToString <$>
1208+ braced <* optional sp) >>= \url ->
1209+ tok >>= \lab -> pure (link url "" lab))
6151210 , ("includegraphics", do options <- option [] keyvals
616− src <- unescapeURL . removeDoubleQuotes <$> braced
1211+ src <- unescapeURL . T.unpack .
1212+ removeDoubleQuotes . untokenize <$> braced
6171213 mkImage options src)
6181214 , ("enquote", enquote)
6191215 , ("cite", citation "cite" NormalCitation False)
@@ -672,7 +1268,7 @@ inlineCommands = M.fromList $
6721268 , ("nocite", mempty <$ (citation "nocite" NormalCitation False >>=
6731269 addMeta "nocite"))
6741270 , ("hypertarget", braced >> tok)
675− -- siuntix
1271+-- -- siuntix
6761272 , ("SI", dosiunitx)
6771273 -- hyphenat
6781274 , ("bshyp", lit "\\\173")
@@ -686,362 +1282,473 @@ inlineCommands = M.fromList $
6861282 -- fontawesome
6871283 , ("faCheck", lit "\10003")
6881284 , ("faClose", lit "\10007")
689− ] ++ map ignoreInlines
1285+ ]
1286+
6901287 -- these commands will be ignored unless --parse-raw is specified,
6911288 -- in which case they will appear as raw latex blocks:
1289+ -- [ "index"
1290+ -- , "hspace"
1291+ -- , "vspace"
1292+ -- , "newpage"
1293+ -- , "clearpage"
1294+ -- , "pagebreak"
1295+ -- , "noindent"
1296+ -- ]
1297+
1298+ttfamily :: PandocMonad m => LP m Inlines
1299+ttfamily = (code . stringify . toList) <$> tok
1300+
1301+rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines
1302+rawInlineOr name' fallback = do
1303+ parseRaw <- extensionEnabled Ext_raw_tex <$> getOption readerExtensions
1304+ if parseRaw
1305+ then rawInline "latex" <$> getRawCommand name'
1306+ else fallback
1307+
1308+getRawCommand :: PandocMonad m => Text -> LP m String
1309+getRawCommand txt = do
1310+ (_, rawargs) <- withRaw
1311+ (many (try (optional sp *> opt)) *>
1312+ option "" (try (optional sp *> dimenarg)) *>
1313+ many braced)
1314+ return $ T.unpack (txt <> untokenize rawargs)
1315+
1316+isBlockCommand :: Text -> Bool
1317+isBlockCommand s =
1318+ s `M.member` (blockCommands :: M.Map Text (LP PandocPure Blocks))
1319+
1320+isInlineCommand :: Text -> Bool
1321+isInlineCommand s =
1322+ s `M.member` (inlineCommands :: M.Map Text (LP PandocPure Inlines))
1323+ || s `Set.member` treatAsRawInline
1324+
1325+treatAsRawInline :: Set.Set Text
1326+treatAsRawInline = Set.fromList
6921327 [ "index"
6931328 , "hspace"
6941329 , "vspace"
6951330 , "newpage"
6961331 , "clearpage"
6971332 , "pagebreak"
1333+ , "noindent"
6981334 ]
6991335
700−ttfamily :: PandocMonad m => LP m Inlines
701−ttfamily = (code . stringify . toList) <$> tok
1336+lookupListDefault :: (Show k, Ord k) => v -> [k] -> M.Map k v -> v
1337+lookupListDefault d = (fromMaybe d .) . lookupList
1338+ where lookupList l m = msum $ map (`M.lookup` m) l
7021339
703−mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines
704−mkImage options src = do
705− let replaceTextwidth (k,v) = case numUnit v of
706− Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")
707− _ -> (k, v)
708− let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options
709− let attr = ("",[], kvs)
710− let alt = str "image"
711− case takeExtension src of
712− "" -> do
713− defaultExt <- getOption readerDefaultImageExtension
714− return $ imageWith attr (addExtension src defaultExt) "" alt
715− _ -> return $ imageWith attr src "" alt
716−
717−inNote :: Inlines -> Inlines
718−inNote ils =
719− note $ para $ ils <> str "."
720−
721−unescapeURL :: String -> String
722−unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
723− where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String)
724−unescapeURL (x:xs) = x:unescapeURL xs
725−unescapeURL [] = ""
726−
727−enquote :: PandocMonad m => LP m Inlines
728−enquote = do
729− skipopts
730− context <- stateQuoteContext <$> getState
731− if context == InDoubleQuote
732− then singleQuoted <$> withQuoteContext InSingleQuote tok
733− else doubleQuoted <$> withQuoteContext InDoubleQuote tok
734−
735−doverb :: PandocMonad m => LP m Inlines
736−doverb = do
737− marker <- anyChar
738− code <$> manyTill (satisfy (/='\n')) (char marker)
739−
740−dolstinline :: PandocMonad m => LP m Inlines
741−dolstinline = do
742− options <- option [] keyvals
743− let classes = maybeToList $ lookup "language" options >>= fromListingsLanguage
744− marker <- char '{' <|> anyChar
745− codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)
746−
747−doLHSverb :: PandocMonad m => LP m Inlines
748−doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
749−
750−-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
751−dosiunitx :: PandocMonad m => LP m Inlines
752−dosiunitx = do
753− skipopts
754− value <- tok
755− valueprefix <- option "" $ char '[' >> (mconcat <$> manyTill tok (char ']'))
756− unit <- tok
757− let emptyOr160 "" = ""
758− emptyOr160 _ = "\160"
759− return . mconcat $ [valueprefix,
760− emptyOr160 valueprefix,
761− value,
762− emptyOr160 unit,
763− unit]
764−
765−lit :: String -> LP m Inlines
766−lit = pure . str
1340+inline :: PandocMonad m => LP m Inlines
1341+inline = (mempty <$ comment)
1342+ <|> (space <$ whitespace)
1343+ <|> (softbreak <$ endline)
1344+ <|> word
1345+ <|> inlineCommand'
1346+ <|> inlineEnvironment
1347+ <|> inlineGroup
1348+ <|> (symbol '-' *>
1349+ option (str "-") (symbol '-' *>
1350+ option (str "–") (str "—" <$ symbol '-')))
1351+ <|> doubleQuote
1352+ <|> singleQuote
1353+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
1354+ <|> (str "”" <$ symbol '”')
1355+ <|> (str "’" <$ symbol '\'')
1356+ <|> (str "’" <$ symbol '’')
1357+ <|> (str "\160" <$ symbol '~')
1358+ <|> dollarsMath
1359+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
1360+ <|> (str . (:[]) <$> primEscape)
1361+ <|> regularSymbol
1362+ <|> (do res <- symbolIn "#^'`\"[]"
1363+ pos <- getPosition
1364+ let s = T.unpack (untoken res)
1365+ report $ ParsingUnescaped s pos
1366+ return $ str s)
7671367
768−accent :: (Char -> String) -> Inlines -> LP m Inlines
769−accent f ils =
770− case toList ils of
771− (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)
772− [] -> mzero
773− _ -> return ils
1368+inlines :: PandocMonad m => LP m Inlines
1369+inlines = mconcat <$> many inline
7741370
775−grave :: Char -> String
776−grave 'A' = "À"
777−grave 'E' = "È"
778−grave 'I' = "Ì"
779−grave 'O' = "Ò"
780−grave 'U' = "Ù"
781−grave 'a' = "à"
782−grave 'e' = "è"
783−grave 'i' = "ì"
784−grave 'o' = "ò"
785−grave 'u' = "ù"
786−grave c = [c]
1371+-- block elements:
7871372
788−acute :: Char -> String
789−acute 'A' = "Á"
790−acute 'E' = "É"
791−acute 'I' = "Í"
792−acute 'O' = "Ó"
793−acute 'U' = "Ú"
794−acute 'Y' = "Ý"
795−acute 'a' = "á"
796−acute 'e' = "é"
797−acute 'i' = "í"
798−acute 'o' = "ó"
799−acute 'u' = "ú"
800−acute 'y' = "ý"
801−acute 'C' = "Ć"
802−acute 'c' = "ć"
803−acute 'L' = "Ĺ"
804−acute 'l' = "ĺ"
805−acute 'N' = "Ń"
806−acute 'n' = "ń"
807−acute 'R' = "Ŕ"
808−acute 'r' = "ŕ"
809−acute 'S' = "Ś"
810−acute 's' = "ś"
811−acute 'Z' = "Ź"
812−acute 'z' = "ź"
813−acute c = [c]
814−
815−circ :: Char -> String
816−circ 'A' = "Â"
817−circ 'E' = "Ê"
818−circ 'I' = "Î"
819−circ 'O' = "Ô"
820−circ 'U' = "Û"
821−circ 'a' = "â"
822−circ 'e' = "ê"
823−circ 'i' = "î"
824−circ 'o' = "ô"
825−circ 'u' = "û"
826−circ 'C' = "Ĉ"
827−circ 'c' = "ĉ"
828−circ 'G' = "Ĝ"
829−circ 'g' = "ĝ"
830−circ 'H' = "Ĥ"
831−circ 'h' = "ĥ"
832−circ 'J' = "Ĵ"
833−circ 'j' = "ĵ"
834−circ 'S' = "Ŝ"
835−circ 's' = "ŝ"
836−circ 'W' = "Ŵ"
837−circ 'w' = "ŵ"
838−circ 'Y' = "Ŷ"
839−circ 'y' = "ŷ"
840−circ c = [c]
1373+begin_ :: PandocMonad m => Text -> LP m ()
1374+begin_ t = (try $ do
1375+ controlSeq "begin"
1376+ spaces
1377+ symbol '{'
1378+ spaces
1379+ Tok _ Word txt <- satisfyTok isWordTok
1380+ spaces
1381+ symbol '}'
1382+ guard (t == txt)) <?> ("\\begin{" ++ T.unpack t ++ "}")
8411383
842−tilde :: Char -> String
843−tilde 'A' = "Ã"
844−tilde 'a' = "ã"
845−tilde 'O' = "Õ"
846−tilde 'o' = "õ"
847−tilde 'I' = "Ĩ"
848−tilde 'i' = "ĩ"
849−tilde 'U' = "Ũ"
850−tilde 'u' = "ũ"
851−tilde 'N' = "Ñ"
852−tilde 'n' = "ñ"
853−tilde c = [c]
1384+end_ :: PandocMonad m => Text -> LP m ()
1385+end_ t = (try $ do
1386+ controlSeq "end"
1387+ spaces
1388+ symbol '{'
1389+ spaces
1390+ Tok _ Word txt <- satisfyTok isWordTok
1391+ spaces
1392+ symbol '}'
1393+ guard $ t == txt) <?> ("\\end{" ++ T.unpack t ++ "}")
8541394
855−umlaut :: Char -> String
856−umlaut 'A' = "Ä"
857−umlaut 'E' = "Ë"
858−umlaut 'I' = "Ï"
859−umlaut 'O' = "Ö"
860−umlaut 'U' = "Ü"
861−umlaut 'a' = "ä"
862−umlaut 'e' = "ë"
863−umlaut 'i' = "ï"
864−umlaut 'o' = "ö"
865−umlaut 'u' = "ü"
866−umlaut c = [c]
1395+preamble :: PandocMonad m => LP m Blocks
1396+preamble = mempty <$ many preambleBlock
1397+ where preambleBlock = spaces1
1398+ <|> void include
1399+ <|> void macroDef
1400+ <|> void blockCommand
1401+ <|> void braced
1402+ <|> (notFollowedBy (begin_ "document") >> void anyTok)
8671403
868−hungarumlaut :: Char -> String
869−hungarumlaut 'A' = "A̋"
870−hungarumlaut 'E' = "E̋"
871−hungarumlaut 'I' = "I̋"
872−hungarumlaut 'O' = "Ő"
873−hungarumlaut 'U' = "Ű"
874−hungarumlaut 'Y' = "ӳ"
875−hungarumlaut 'a' = "a̋"
876−hungarumlaut 'e' = "e̋"
877−hungarumlaut 'i' = "i̋"
878−hungarumlaut 'o' = "ő"
879−hungarumlaut 'u' = "ű"
880−hungarumlaut 'y' = "ӳ"
881−hungarumlaut c = [c]
1404+paragraph :: PandocMonad m => LP m Blocks
1405+paragraph = do
1406+ x <- trimInlines . mconcat <$> many1 inline
1407+ if x == mempty
1408+ then return mempty
1409+ else return $ para x
8821410
883−dot :: Char -> String
884−dot 'C' = "Ċ"
885−dot 'c' = "ċ"
886−dot 'E' = "Ė"
887−dot 'e' = "ė"
888−dot 'G' = "Ġ"
889−dot 'g' = "ġ"
890−dot 'I' = "İ"
891−dot 'Z' = "Ż"
892−dot 'z' = "ż"
893−dot c = [c]
1411+include :: PandocMonad m => LP m Blocks
1412+include = do
1413+ (Tok _ (CtrlSeq name) _) <-
1414+ controlSeq "include" <|> controlSeq "input" <|>
1415+ controlSeq "subfile" <|> controlSeq "usepackage"
1416+ skipMany $ bracketed inline -- skip options
1417+ fs <- (map trim . splitBy (==',') . T.unpack . untokenize) <$> braced
1418+ let fs' = if name == "usepackage"
1419+ then map (maybeAddExtension ".sty") fs
1420+ else map (maybeAddExtension ".tex") fs
1421+ dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1422+ mconcat <$> mapM (insertIncludedFile blocks (tokenize . T.pack) dirs) fs'
8941423
895−macron :: Char -> String
896−macron 'A' = "Ā"
897−macron 'E' = "Ē"
898−macron 'I' = "Ī"
899−macron 'O' = "Ō"
900−macron 'U' = "Ū"
901−macron 'a' = "ā"
902−macron 'e' = "ē"
903−macron 'i' = "ī"
904−macron 'o' = "ō"
905−macron 'u' = "ū"
906−macron c = [c]
1424+maybeAddExtension :: String -> FilePath -> FilePath
1425+maybeAddExtension ext fp =
1426+ if null (takeExtension fp)
1427+ then addExtension fp ext
1428+ else fp
9071429
908−cedilla :: Char -> String
909−cedilla 'c' = "ç"
910−cedilla 'C' = "Ç"
911−cedilla 's' = "ş"
912−cedilla 'S' = "Ş"
913−cedilla 't' = "ţ"
914−cedilla 'T' = "Ţ"
915−cedilla 'e' = "ȩ"
916−cedilla 'E' = "Ȩ"
917−cedilla 'h' = "ḩ"
918−cedilla 'H' = "Ḩ"
919−cedilla 'o' = "o̧"
920−cedilla 'O' = "O̧"
921−cedilla c = [c]
1430+ignoreBlocks :: PandocMonad m => Text -> (Text, LP m Blocks)
1431+ignoreBlocks name = (name, p)
1432+ where
1433+ p = do oa <- optargs
1434+ let rawCommand = T.unpack ("\\" <> name <> oa)
1435+ let doraw = guardRaw >> return (rawBlock "latex" rawCommand)
1436+ doraw <|> ignore rawCommand
9221437
923−hacek :: Char -> String
924−hacek 'A' = "Ǎ"
925−hacek 'a' = "ǎ"
926−hacek 'C' = "Č"
927−hacek 'c' = "č"
928−hacek 'D' = "Ď"
929−hacek 'd' = "ď"
930−hacek 'E' = "Ě"
931−hacek 'e' = "ě"
932−hacek 'G' = "Ǧ"
933−hacek 'g' = "ǧ"
934−hacek 'H' = "Ȟ"
935−hacek 'h' = "ȟ"
936−hacek 'I' = "Ǐ"
937−hacek 'i' = "ǐ"
938−hacek 'j' = "ǰ"
939−hacek 'K' = "Ǩ"
940−hacek 'k' = "ǩ"
941−hacek 'L' = "Ľ"
942−hacek 'l' = "ľ"
943−hacek 'N' = "Ň"
944−hacek 'n' = "ň"
945−hacek 'O' = "Ǒ"
946−hacek 'o' = "ǒ"
947−hacek 'R' = "Ř"
948−hacek 'r' = "ř"
949−hacek 'S' = "Š"
950−hacek 's' = "š"
951−hacek 'T' = "Ť"
952−hacek 't' = "ť"
953−hacek 'U' = "Ǔ"
954−hacek 'u' = "ǔ"
955−hacek 'Z' = "Ž"
956−hacek 'z' = "ž"
957−hacek c = [c]
1438+addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()
1439+addMeta field val = updateState $ \st ->
1440+ st{ sMeta = addMetaField field val $ sMeta st }
9581441
959−breve :: Char -> String
960−breve 'A' = "Ă"
961−breve 'a' = "ă"
962−breve 'E' = "Ĕ"
963−breve 'e' = "ĕ"
964−breve 'G' = "Ğ"
965−breve 'g' = "ğ"
966−breve 'I' = "Ĭ"
967−breve 'i' = "ĭ"
968−breve 'O' = "Ŏ"
969−breve 'o' = "ŏ"
970−breve 'U' = "Ŭ"
971−breve 'u' = "ŭ"
972−breve c = [c]
1442+authors :: PandocMonad m => LP m ()
1443+authors = try $ do
1444+ bgroup
1445+ let oneAuthor = mconcat <$>
1446+ many1 (notFollowedBy' (controlSeq "and") >>
1447+ (inline <|> mempty <$ blockCommand))
1448+ -- skip e.g. \vspace{10pt}
1449+ auths <- sepBy oneAuthor (controlSeq "and")
1450+ egroup
1451+ addMeta "author" (map trimInlines auths)
9731452
974−tok :: PandocMonad m => LP m Inlines
975−tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar
1453+macroDef :: PandocMonad m => LP m Blocks
1454+macroDef = mempty <$ ((commandDef <|> environmentDef) <* doMacros 0)
1455+ where commandDef = do
1456+ (name, macro) <- newcommand
1457+ updateState $ \s -> s{ sMacros = M.insert name macro (sMacros s) }
1458+ environmentDef = do
1459+ (name, macro1, macro2) <- newenvironment
1460+ updateState $ \s -> s{ sMacros =
1461+ M.insert name macro1 (sMacros s) }
1462+ updateState $ \s -> s{ sMacros =
1463+ M.insert ("end" <> name) macro2 (sMacros s) }
1464+ -- @\newenvironment{envname}[n-args][default]{begin}{end}@
1465+ -- is equivalent to
1466+ -- @\newcommand{\envname}[n-args][default]{begin}@
1467+ -- @\newcommand{\endenvname}@
1468+
1469+newcommand :: PandocMonad m => LP m (Text, Macro)
1470+newcommand = do
1471+ pos <- getPosition
1472+ Tok _ (CtrlSeq mtype) _ <- controlSeq "newcommand" <|>
1473+ controlSeq "renewcommand" <|>
1474+ controlSeq "providecommand"
1475+ optional $ symbol '*'
1476+ symbol '{'
1477+ spaces
1478+ Tok _ (CtrlSeq name) txt <- withVerbatimMode anyControlSeq
1479+ spaces
1480+ symbol '}'
1481+ spaces
1482+ numargs <- option 0 $ try bracketedNum
1483+ spaces
1484+ optarg <- option Nothing $ Just <$> try bracketedToks
1485+ spaces
1486+ contents <- braced
1487+ when (mtype == "newcommand") $ do
1488+ macros <- sMacros <$> getState
1489+ case M.lookup name macros of
1490+ Just _ -> report $ MacroAlreadyDefined (T.unpack txt) pos
1491+ Nothing -> return ()
1492+ return (name, Macro numargs optarg contents)
1493+
1494+newenvironment :: PandocMonad m => LP m (Text, Macro, Macro)
1495+newenvironment = do
1496+ pos <- getPosition
1497+ Tok _ (CtrlSeq mtype) _ <- controlSeq "newenvironment" <|>
1498+ controlSeq "renewenvironment" <|>
1499+ controlSeq "provideenvironment"
1500+ optional $ symbol '*'
1501+ symbol '{'
1502+ spaces
1503+ Tok _ Word name <- satisfyTok isWordTok
1504+ spaces
1505+ symbol '}'
1506+ spaces
1507+ numargs <- option 0 $ try bracketedNum
1508+ spaces
1509+ optarg <- option Nothing $ Just <$> try bracketedToks
1510+ spaces
1511+ startcontents <- braced
1512+ spaces
1513+ endcontents <- braced
1514+ when (mtype == "newenvironment") $ do
1515+ macros <- sMacros <$> getState
1516+ case M.lookup name macros of
1517+ Just _ -> report $ MacroAlreadyDefined (T.unpack name) pos
1518+ Nothing -> return ()
1519+ return (name, Macro numargs optarg startcontents,
1520+ Macro 0 Nothing endcontents)
1521+
1522+bracketedToks :: PandocMonad m => LP m [Tok]
1523+bracketedToks = do
1524+ symbol '['
1525+ manyTill anyTok (symbol ']')
1526+
1527+bracketedNum :: PandocMonad m => LP m Int
1528+bracketedNum = do
1529+ ds <- untokenize <$> bracketedToks
1530+ case safeRead (T.unpack ds) of
1531+ Just i -> return i
1532+ _ -> return 0
9761533
977−opt :: PandocMonad m => LP m Inlines
978−opt = bracketed inline
1534+setCaption :: PandocMonad m => LP m Blocks
1535+setCaption = do
1536+ ils <- tok
1537+ mblabel <- option Nothing $
1538+ try $ spaces >> controlSeq "label" >> (Just <$> tok)
1539+ let ils' = case mblabel of
1540+ Just lab -> ils <> spanWith
1541+ ("",[],[("data-label", stringify lab)]) mempty
1542+ Nothing -> ils
1543+ updateState $ \st -> st{ sCaption = Just ils' }
1544+ return mempty
9791545
980−rawopt :: PandocMonad m => LP m String
981−rawopt = do
982− contents <- bracketed (many1 (noneOf "[]") <|> try (string "\\]") <|>
983− try (string "\\[") <|> rawopt)
984− optional sp
985− return $ "[" ++ contents ++ "]"
1546+looseItem :: PandocMonad m => LP m Blocks
1547+looseItem = do
1548+ inListItem <- sInListItem <$> getState
1549+ guard $ not inListItem
1550+ skipopts
1551+ return mempty
9861552
987−skipopts :: PandocMonad m => LP m ()
988−skipopts = skipMany rawopt
1553+resetCaption :: PandocMonad m => LP m ()
1554+resetCaption = updateState $ \st -> st{ sCaption = Nothing }
9891555
990−-- opts in angle brackets are used in beamer
991−rawangle :: PandocMonad m => LP m ()
992−rawangle = try $ do
993− char '<'
994− skipMany (noneOf ">")
995− char '>'
996− return ()
1556+section :: PandocMonad m => Attr -> Int -> LP m Blocks
1557+section (ident, classes, kvs) lvl = do
1558+ skipopts
1559+ contents <- grouped inline
1560+ lab <- option ident $
1561+ try (spaces >> controlSeq "label"
1562+ >> spaces >> toksToString <$> braced)
1563+ attr' <- registerHeader (lab, classes, kvs) contents
1564+ return $ headerWith attr' lvl contents
9971565
998−skipangles :: PandocMonad m => LP m ()
999−skipangles = skipMany rawangle
1566+blockCommand :: PandocMonad m => LP m Blocks
1567+blockCommand = try $ do
1568+ Tok _ (CtrlSeq name) txt <- anyControlSeq
1569+ guard $ name /= "begin" && name /= "end"
1570+ star <- option "" ("*" <$ symbol '*' <* optional sp)
1571+ let name' = name <> star
1572+ let names = ordNub [name', name]
1573+ let raw = do
1574+ guard $ not (isInlineCommand name)
1575+ rawBlock "latex" <$> getRawCommand txt
1576+ lookupListDefault raw names blockCommands
10001577
1001−inlineText :: PandocMonad m => LP m Inlines
1002−inlineText = str <$> many1 inlineChar
1578+closing :: PandocMonad m => LP m Blocks
1579+closing = do
1580+ contents <- tok
1581+ st <- getState
1582+ let extractInlines (MetaBlocks [Plain ys]) = ys
1583+ extractInlines (MetaBlocks [Para ys ]) = ys
1584+ extractInlines _ = []
1585+ let sigs = case lookupMeta "author" (sMeta st) of
1586+ Just (MetaList xs) ->
1587+ para $ trimInlines $ fromList $
1588+ intercalate [LineBreak] $ map extractInlines xs
1589+ _ -> mempty
1590+ return $ para (trimInlines contents) <> sigs
10031591
1004−inlineChar :: PandocMonad m => LP m Char
1005−inlineChar = noneOf "\\$%&~#{}^'`\"‘’“”-[] \t\n"
1592+blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
1593+blockCommands = M.fromList $
1594+ [ ("par", mempty <$ skipopts)
1595+ , ("parbox", braced >> grouped blocks)
1596+ , ("title", mempty <$ (skipopts *>
1597+ (grouped inline >>= addMeta "title")
1598+ <|> (grouped block >>= addMeta "title")))
1599+ , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
1600+ , ("author", mempty <$ (skipopts *> authors))
1601+ -- -- in letter class, temp. store address & sig as title, author
1602+ , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
1603+ , ("signature", mempty <$ (skipopts *> authors))
1604+ , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
1605+ -- Koma-script metadata commands
1606+ , ("dedication", mempty <$ (skipopts *> tok >>= addMeta "dedication"))
1607+ -- sectioning
1608+ , ("part", section nullAttr (-1))
1609+ , ("part*", section nullAttr (-1))
1610+ , ("chapter", section nullAttr 0)
1611+ , ("chapter*", section ("",["unnumbered"],[]) 0)
1612+ , ("section", section nullAttr 1)
1613+ , ("section*", section ("",["unnumbered"],[]) 1)
1614+ , ("subsection", section nullAttr 2)
1615+ , ("subsection*", section ("",["unnumbered"],[]) 2)
1616+ , ("subsubsection", section nullAttr 3)
1617+ , ("subsubsection*", section ("",["unnumbered"],[]) 3)
1618+ , ("paragraph", section nullAttr 4)
1619+ , ("paragraph*", section ("",["unnumbered"],[]) 4)
1620+ , ("subparagraph", section nullAttr 5)
1621+ , ("subparagraph*", section ("",["unnumbered"],[]) 5)
1622+ -- beamer slides
1623+ , ("frametitle", section nullAttr 3)
1624+ , ("framesubtitle", section nullAttr 4)
1625+ -- letters
1626+ , ("opening", (para . trimInlines) <$> (skipopts *> tok))
1627+ , ("closing", skipopts *> closing)
1628+ --
1629+ , ("hrule", pure horizontalRule)
1630+ , ("strut", pure mempty)
1631+ , ("rule", skipopts *> tok *> tok *> pure horizontalRule)
1632+ , ("item", looseItem)
1633+ , ("documentclass", skipopts *> braced *> preamble)
1634+ , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
1635+ , ("caption", skipopts *> setCaption)
1636+ , ("bibliography", mempty <$ (skipopts *> braced >>=
1637+ addMeta "bibliography" . splitBibs . toksToString))
1638+ , ("addbibresource", mempty <$ (skipopts *> braced >>=
1639+ addMeta "bibliography" . splitBibs . toksToString))
1640+ -- includes
1641+ , ("lstinputlisting", inputListing)
1642+ , ("graphicspath", graphicsPath)
1643+ -- hyperlink
1644+ , ("hypertarget", try $ braced >> grouped block)
1645+ ] ++ map ignoreBlocks
1646+ -- these commands will be ignored unless --parse-raw is specified,
1647+ -- in which case they will appear as raw latex blocks
1648+ [ "newcommand", "renewcommand"
1649+ , "newenvironment", "renewenvironment"
1650+ , "providecommand", "provideenvironment"
1651+ -- newcommand, etc. should be parsed by macroDef, but we need this
1652+ -- here so these aren't parsed as inline commands to ignore
1653+ , "special", "pdfannot", "pdfstringdef"
1654+ , "bibliographystyle"
1655+ , "maketitle", "makeindex", "makeglossary"
1656+ , "addcontentsline", "addtocontents", "addtocounter"
1657+ -- \ignore{} is used conventionally in literate haskell for definitions
1658+ -- that are to be processed by the compiler but not printed.
1659+ , "ignore"
1660+ , "hyperdef"
1661+ , "markboth", "markright", "markleft"
1662+ , "hspace", "vspace"
1663+ , "newpage"
1664+ , "clearpage"
1665+ , "pagebreak"
1666+ ]
1667+
1668+environments :: PandocMonad m => M.Map Text (LP m Blocks)
1669+environments = M.fromList
1670+ [ ("document", env "document" blocks)
1671+ , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
1672+ , ("letter", env "letter" letterContents)
1673+ , ("minipage", env "minipage" $
1674+ skipopts *> spaces *> optional braced *> spaces *> blocks)
1675+ , ("figure", env "figure" $ skipopts *> figure)
1676+ , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
1677+ , ("center", env "center" blocks)
1678+ , ("longtable", env "longtable" $
1679+ resetCaption *> simpTable "longtable" False >>= addTableCaption)
1680+ , ("table", env "table" $
1681+ resetCaption *> skipopts *> blocks >>= addTableCaption)
1682+ , ("tabular*", env "tabular" $ simpTable "tabular*" True)
1683+ , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1684+ , ("tabular", env "tabular" $ simpTable "tabular" False)
1685+ , ("quote", blockQuote <$> env "quote" blocks)
1686+ , ("quotation", blockQuote <$> env "quotation" blocks)
1687+ , ("verse", blockQuote <$> env "verse" blocks)
1688+ , ("itemize", bulletList <$> listenv "itemize" (many item))
1689+ , ("description", definitionList <$> listenv "description" (many descItem))
1690+ , ("enumerate", orderedList')
1691+ , ("alltt", alltt <$> env "alltt" blocks)
1692+ , ("code", guardEnabled Ext_literate_haskell *>
1693+ (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
1694+ verbEnv "code"))
1695+ , ("comment", mempty <$ verbEnv "comment")
1696+ , ("verbatim", codeBlock <$> verbEnv "verbatim")
1697+ , ("Verbatim", fancyverbEnv "Verbatim")
1698+ , ("BVerbatim", fancyverbEnv "BVerbatim")
1699+ , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals
1700+ codeBlockWith attr <$> verbEnv "lstlisting")
1701+ , ("minted", minted)
1702+ , ("obeylines", obeylines)
1703+ , ("displaymath", mathEnvWith para Nothing "displaymath")
1704+ , ("equation", mathEnvWith para Nothing "equation")
1705+ , ("equation*", mathEnvWith para Nothing "equation*")
1706+ , ("gather", mathEnvWith para (Just "gathered") "gather")
1707+ , ("gather*", mathEnvWith para (Just "gathered") "gather*")
1708+ , ("multline", mathEnvWith para (Just "gathered") "multline")
1709+ , ("multline*", mathEnvWith para (Just "gathered") "multline*")
1710+ , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray")
1711+ , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*")
1712+ , ("align", mathEnvWith para (Just "aligned") "align")
1713+ , ("align*", mathEnvWith para (Just "aligned") "align*")
1714+ , ("alignat", mathEnvWith para (Just "aligned") "alignat")
1715+ , ("alignat*", mathEnvWith para (Just "aligned") "alignat*")
1716+ , ("tikzpicture", rawVerbEnv "tikzpicture")
1717+ ]
10061718
10071719environment :: PandocMonad m => LP m Blocks
10081720environment = do
10091721 controlSeq "begin"
1010− name <- braced
1722+ name <- untokenize <$> braced
10111723 M.findWithDefault mzero name environments
10121724 <|> rawEnv name
10131725
1014−inlineEnvironment :: PandocMonad m => LP m Inlines
1015−inlineEnvironment = try $ do
1016− controlSeq "begin"
1017− name <- braced
1018− M.findWithDefault mzero name inlineEnvironments
1726+env :: PandocMonad m => Text -> LP m a -> LP m a
1727+env name p = p <* end_ name
10191728
1020−rawEnv :: PandocMonad m => String -> LP m Blocks
1729+rawEnv :: PandocMonad m => Text -> LP m Blocks
10211730rawEnv name = do
10221731 exts <- getOption readerExtensions
10231732 let parseRaw = extensionEnabled Ext_raw_tex exts
10241733 rawOptions <- mconcat <$> many rawopt
1025− let beginCommand = "\\begin{" ++ name ++ "}" ++ rawOptions
1734+ let beginCommand = "\\begin{" <> name <> "}" <> rawOptions
10261735 pos1 <- getPosition
10271736 (bs, raw) <- withRaw $ env name blocks
1028− raw' <- applyMacros' $ beginCommand ++ raw
1029− if raw' /= beginCommand ++ raw
1030− then parseFromString' blocks raw'
1031− else if parseRaw
1032− then return $ rawBlock "latex" $ beginCommand ++ raw'
1033− else do
1034− unless parseRaw $ do
1035− report $ SkippedContent beginCommand pos1
1036− pos2 <- getPosition
1037− report $ SkippedContent ("\\end{" ++ name ++ "}") pos2
1038− return bs
1039−
1040−rawVerbEnv :: PandocMonad m => String -> LP m Blocks
1737+ if parseRaw
1738+ then return $ rawBlock "latex"
1739+ $ T.unpack $ beginCommand <> untokenize raw
1740+ else do
1741+ unless parseRaw $ do
1742+ report $ SkippedContent (T.unpack beginCommand) pos1
1743+ pos2 <- getPosition
1744+ report $ SkippedContent ("\\end{" ++ T.unpack name ++ "}") pos2
1745+ return bs
1746+
1747+rawVerbEnv :: PandocMonad m => Text -> LP m Blocks
10411748rawVerbEnv name = do
10421749 pos <- getPosition
10431750 (_, raw) <- withRaw $ verbEnv name
1044− let raw' = "\\begin{tikzpicture}" ++ raw
1751+ let raw' = "\\begin{tikzpicture}" ++ toksToString raw
10451752 exts <- getOption readerExtensions
10461753 let parseRaw = extensionEnabled Ext_raw_tex exts
10471754 if parseRaw
@@ -1050,36 +1757,106 @@ rawVerbEnv name = do
10501757 report $ SkippedContent raw' pos
10511758 return mempty
10521759
1053−----
1760+verbEnv :: PandocMonad m => Text -> LP m String
1761+verbEnv name = withVerbatimMode $ do
1762+ skipopts
1763+ optional blankline
1764+ res <- manyTill anyTok (end_ name)
1765+ return $ stripTrailingNewlines $ toksToString res
1766+
1767+fancyverbEnv :: PandocMonad m => Text -> LP m Blocks
1768+fancyverbEnv name = do
1769+ options <- option [] keyvals
1770+ let kvs = [ (if k == "firstnumber"
1771+ then "startFrom"
1772+ else k, v) | (k,v) <- options ]
1773+ let classes = [ "numberLines" |
1774+ lookup "numbers" options == Just "left" ]
1775+ let attr = ("",classes,kvs)
1776+ codeBlockWith attr <$> verbEnv name
1777+
1778+obeylines :: PandocMonad m => LP m Blocks
1779+obeylines = do
1780+ para . fromList . removeLeadingTrailingBreaks .
1781+ walk softBreakToHard . toList <$> env "obeylines" inlines
1782+ where softBreakToHard SoftBreak = LineBreak
1783+ softBreakToHard x = x
1784+ removeLeadingTrailingBreaks = reverse . dropWhile isLineBreak .
1785+ reverse . dropWhile isLineBreak
1786+ isLineBreak LineBreak = True
1787+ isLineBreak _ = False
1788+
1789+minted :: PandocMonad m => LP m Blocks
1790+minted = do
1791+ options <- option [] keyvals
1792+ lang <- toksToString <$> braced
1793+ let kvs = [ (if k == "firstnumber"
1794+ then "startFrom"
1795+ else k, v) | (k,v) <- options ]
1796+ let classes = [ lang | not (null lang) ] ++
1797+ [ "numberLines" |
1798+ lookup "linenos" options == Just "true" ]
1799+ let attr = ("",classes,kvs)
1800+ codeBlockWith attr <$> verbEnv "minted"
1801+
1802+letterContents :: PandocMonad m => LP m Blocks
1803+letterContents = do
1804+ bs <- blocks
1805+ st <- getState
1806+ -- add signature (author) and address (title)
1807+ let addr = case lookupMeta "address" (sMeta st) of
1808+ Just (MetaBlocks [Plain xs]) ->
1809+ para $ trimInlines $ fromList xs
1810+ _ -> mempty
1811+ return $ addr <> bs -- sig added by \closing
1812+
1813+figure :: PandocMonad m => LP m Blocks
1814+figure = try $ do
1815+ resetCaption
1816+ blocks >>= addImageCaption
1817+
1818+addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
1819+addImageCaption = walkM go
1820+ where go (Image attr alt (src,tit))
1821+ | not ("fig:" `isPrefixOf` tit) = do
1822+ mbcapt <- sCaption <$> getState
1823+ return $ case mbcapt of
1824+ Just ils -> Image attr (toList ils) (src, "fig:" ++ tit)
1825+ Nothing -> Image attr alt (src,tit)
1826+ go x = return x
10541827
1055−maybeAddExtension :: String -> FilePath -> FilePath
1056−maybeAddExtension ext fp =
1057− if null (takeExtension fp)
1058− then addExtension fp ext
1059− else fp
1828+graphicsPath :: PandocMonad m => LP m Blocks
1829+graphicsPath = do
1830+ ps <- map toksToString <$> (bgroup *> manyTill braced egroup)
1831+ getResourcePath >>= setResourcePath . (++ ps)
1832+ return mempty
10601833
1061−include :: PandocMonad m => LP m Blocks
1062−include = do
1063− fs' <- try $ do
1064− char '\\'
1065− name <- try (string "include")
1066− <|> try (string "input")
1067− <|> try (string "subfile")
1068− <|> string "usepackage"
1069− -- skip options
1070− skipMany $ try $ char '[' *> manyTill anyChar (char ']')
1071− fs <- (map trim . splitBy (==',')) <$> braced
1072− return $ if name == "usepackage"
1073− then map (maybeAddExtension ".sty") fs
1074− else map (maybeAddExtension ".tex") fs
1075− dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
1076− mconcat <$> mapM (insertIncludedFile blocks dirs) fs'
1834+splitBibs :: String -> [Inlines]
1835+splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')
1836+
1837+alltt :: Blocks -> Blocks
1838+alltt = walk strToCode
1839+ where strToCode (Str s) = Code nullAttr s
1840+ strToCode Space = RawInline (Format "latex") "\\ "
1841+ strToCode SoftBreak = LineBreak
1842+ strToCode x = x
1843+
1844+parseListingsOptions :: [(String, String)] -> Attr
1845+parseListingsOptions options =
1846+ let kvs = [ (if k == "firstnumber"
1847+ then "startFrom"
1848+ else k, v) | (k,v) <- options ]
1849+ classes = [ "numberLines" |
1850+ lookup "numbers" options == Just "left" ]
1851+ ++ maybeToList (lookup "language" options
1852+ >>= fromListingsLanguage)
1853+ in (fromMaybe "" (lookup "label" options), classes, kvs)
10771854
10781855inputListing :: PandocMonad m => LP m Blocks
10791856inputListing = do
10801857 pos <- getPosition
10811858 options <- option [] keyvals
1082− f <- filter (/='"') <$> braced
1859+ f <- filter (/='"') . toksToString <$> braced
10831860 dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS"
10841861 mbCode <- readFileFromDirs dirs f
10851862 codeLines <- case mbCode of
@@ -1098,169 +1875,10 @@ inputListing = do
10981875 drop (firstline - 1) codeLines
10991876 return $ codeBlockWith (ident,ordNub (classes ++ language),kvs) codeContents
11001877
1101−parseListingsOptions :: [(String, String)] -> Attr
1102−parseListingsOptions options =
1103− let kvs = [ (if k == "firstnumber"
1104− then "startFrom"
1105− else k, v) | (k,v) <- options ]
1106− classes = [ "numberLines" |
1107− lookup "numbers" options == Just "left" ]
1108− ++ maybeToList (lookup "language" options
1109− >>= fromListingsLanguage)
1110− in (fromMaybe "" (lookup "label" options), classes, kvs)
1111−
1112−----
1113−
1114−keyval :: PandocMonad m => LP m (String, String)
1115−keyval = try $ do
1116− key <- many1 alphaNum
1117− val <- option "" $ char '=' >> braced <|> (many1 (alphaNum <|> oneOf ".:-|\\"))
1118− skipMany spaceChar
1119− optional (char ',')
1120− skipMany spaceChar
1121− return (key, val)
1122−
1123−
1124−keyvals :: PandocMonad m => LP m [(String, String)]
1125−keyvals = try $ char '[' *> manyTill keyval (char ']')
1126−
1127−alltt :: PandocMonad m => String -> LP m Blocks
1128−alltt t = walk strToCode <$> parseFromString' blocks
1129− (substitute " " "\\ " $ substitute "%" "\\%" $
1130− intercalate "\\\\\n" $ lines t)
1131− where strToCode (Str s) = Code nullAttr s
1132− strToCode x = x
1133−
1134−rawLaTeXBlock :: PandocMonad m => LP m String
1135−rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
1136−
1137−rawLaTeXInline :: PandocMonad m => LP m Inline
1138−rawLaTeXInline = do
1139− raw <- (snd <$> withRaw inlineCommand)
1140− <|> (snd <$> withRaw inlineEnvironment)
1141− <|> (snd <$> withRaw blockCommand)
1142− RawInline "latex" <$> applyMacros' raw
1143−
1144−addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
1145−addImageCaption = walkM go
1146− where go (Image attr alt (src,tit))
1147− | not ("fig:" `isPrefixOf` tit) = do
1148− mbcapt <- stateCaption <$> getState
1149− return $ case mbcapt of
1150− Just ils -> Image attr (toList ils) (src, "fig:" ++ tit)
1151− Nothing -> Image attr alt (src,tit)
1152− go x = return x
1153−
1154−addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
1155−addTableCaption = walkM go
1156− where go (Table c als ws hs rs) = do
1157− mbcapt <- stateCaption <$> getState
1158− return $ case mbcapt of
1159− Just ils -> Table (toList ils) als ws hs rs
1160− Nothing -> Table c als ws hs rs
1161− go x = return x
1162−
1163−environments :: PandocMonad m => M.Map String (LP m Blocks)
1164−environments = M.fromList
1165− [ ("document", env "document" blocks <* skipMany anyChar)
1166− , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))
1167− , ("letter", env "letter" letterContents)
1168− , ("minipage", env "minipage" $
1169− skipopts *> spaces' *> optional braced *> spaces' *> blocks)
1170− , ("figure", env "figure" $ skipopts *> figure)
1171− , ("subfigure", env "subfigure" $ skipopts *> tok *> figure)
1172− , ("center", env "center" blocks)
1173− , ("longtable", env "longtable" $
1174− resetCaption *> simpTable "longtable" False >>= addTableCaption)
1175− , ("table", env "table" $
1176− resetCaption *> skipopts *> blocks >>= addTableCaption)
1177− , ("tabular*", env "tabular" $ simpTable "tabular*" True)
1178− , ("tabularx", env "tabularx" $ simpTable "tabularx" True)
1179− , ("tabular", env "tabular" $ simpTable "tabular" False)
1180− , ("quote", blockQuote <$> env "quote" blocks)
1181− , ("quotation", blockQuote <$> env "quotation" blocks)
1182− , ("verse", blockQuote <$> env "verse" blocks)
1183− , ("itemize", bulletList <$> listenv "itemize" (many item))
1184− , ("description", definitionList <$> listenv "description" (many descItem))
1185− , ("enumerate", orderedList')
1186− , ("alltt", alltt =<< verbEnv "alltt")
1187− , ("code", guardEnabled Ext_literate_haskell *>
1188− (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
1189− verbEnv "code"))
1190− , ("comment", mempty <$ verbEnv "comment")
1191− , ("verbatim", codeBlock <$> verbEnv "verbatim")
1192− , ("Verbatim", fancyverbEnv "Verbatim")
1193− , ("BVerbatim", fancyverbEnv "BVerbatim")
1194− , ("lstlisting", do attr <- parseListingsOptions <$> option [] keyvals
1195− codeBlockWith attr <$> verbEnv "lstlisting")
1196− , ("minted", do options <- option [] keyvals
1197− lang <- grouped (many1 $ satisfy (/='}'))
1198− let kvs = [ (if k == "firstnumber"
1199− then "startFrom"
1200− else k, v) | (k,v) <- options ]
1201− let classes = [ lang | not (null lang) ] ++
1202− [ "numberLines" |
1203− lookup "linenos" options == Just "true" ]
1204− let attr = ("",classes,kvs)
1205− codeBlockWith attr <$> verbEnv "minted")
1206− , ("obeylines", parseFromString
1207− (para . trimInlines . mconcat <$> many inline) =<<
1208− intercalate "\\\\\n" . lines <$> verbEnv "obeylines")
1209− , ("displaymath", mathEnvWith para Nothing "displaymath")
1210− , ("equation", mathEnvWith para Nothing "equation")
1211− , ("equation*", mathEnvWith para Nothing "equation*")
1212− , ("gather", mathEnvWith para (Just "gathered") "gather")
1213− , ("gather*", mathEnvWith para (Just "gathered") "gather*")
1214− , ("multline", mathEnvWith para (Just "gathered") "multline")
1215− , ("multline*", mathEnvWith para (Just "gathered") "multline*")
1216− , ("eqnarray", mathEnvWith para (Just "aligned") "eqnarray")
1217− , ("eqnarray*", mathEnvWith para (Just "aligned") "eqnarray*")
1218− , ("align", mathEnvWith para (Just "aligned") "align")
1219− , ("align*", mathEnvWith para (Just "aligned") "align*")
1220− , ("alignat", mathEnvWith para (Just "aligned") "alignat")
1221− , ("alignat*", mathEnvWith para (Just "aligned") "alignat*")
1222− , ("tikzpicture", rawVerbEnv "tikzpicture")
1223− ]
1224−
1225−figure :: PandocMonad m => LP m Blocks
1226−figure = try $ do
1227− resetCaption
1228− blocks >>= addImageCaption
1229−
1230−letterContents :: PandocMonad m => LP m Blocks
1231−letterContents = do
1232− bs <- blocks
1233− st <- getState
1234− -- add signature (author) and address (title)
1235− let addr = case lookupMeta "address" (stateMeta st) of
1236− Just (MetaBlocks [Plain xs]) ->
1237− para $ trimInlines $ fromList xs
1238− _ -> mempty
1239− return $ addr <> bs -- sig added by \closing
1240−
1241−closing :: PandocMonad m => LP m Blocks
1242−closing = do
1243− contents <- tok
1244− st <- getState
1245− let extractInlines (MetaBlocks [Plain ys]) = ys
1246− extractInlines (MetaBlocks [Para ys ]) = ys
1247− extractInlines _ = []
1248− let sigs = case lookupMeta "author" (stateMeta st) of
1249− Just (MetaList xs) ->
1250− para $ trimInlines $ fromList $
1251− intercalate [LineBreak] $ map extractInlines xs
1252− _ -> mempty
1253− return $ para (trimInlines contents) <> sigs
1878+-- lists
12541879
12551880item :: PandocMonad m => LP m Blocks
1256−item = blocks *> controlSeq "item" *> skipopts *> blocks
1257−
1258−looseItem :: PandocMonad m => LP m Blocks
1259−looseItem = do
1260− ctx <- stateParserContext `fmap` getState
1261− if ctx == ListItemState
1262− then mzero
1263− else return mempty
1881+item = void blocks *> controlSeq "item" *> skipopts *> blocks
12641882
12651883descItem :: PandocMonad m => LP m (Inlines, [Blocks])
12661884descItem = do
@@ -1271,302 +1889,210 @@ descItem = do
12711889 bs <- blocks
12721890 return (ils, [bs])
12731891
1274−env :: PandocMonad m => String -> LP m a -> LP m a
1275−env name p = p <*
1276− (try (controlSeq "end" *> braced >>= guard . (== name))
1277− <?> ("\\end{" ++ name ++ "}"))
1278−
1279−listenv :: PandocMonad m => String -> LP m a -> LP m a
1892+listenv :: PandocMonad m => Text -> LP m a -> LP m a
12801893listenv name p = try $ do
1281− oldCtx <- stateParserContext `fmap` getState
1282− updateState $ \st -> st{ stateParserContext = ListItemState }
1894+ oldInListItem <- sInListItem `fmap` getState
1895+ updateState $ \st -> st{ sInListItem = True }
12831896 res <- env name p
1284− updateState $ \st -> st{ stateParserContext = oldCtx }
1897+ updateState $ \st -> st{ sInListItem = oldInListItem }
12851898 return res
12861899
1287−mathEnvWith :: PandocMonad m
1288− => (Inlines -> a) -> Maybe String -> String -> LP m a
1289−mathEnvWith f innerEnv name = f <$> mathDisplay (inner <$> mathEnv name)
1290− where inner x = case innerEnv of
1291− Nothing -> x
1292− Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
1293− "\\end{" ++ y ++ "}"
1294−
1295−mathEnv :: PandocMonad m => String -> LP m String
1296−mathEnv name = do
1297− skipopts
1298− optional blankline
1299− let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
1300− charMuncher = skipMany comment *>
1301− (many1 (noneOf "\\%") <|> try (string "\\%")
1302− <|> try (string "\\\\") <|> count 1 anyChar)
1303− res <- concat <$> manyTill charMuncher endEnv
1304− return $ stripTrailingNewlines res
1305−
1306−verbEnv :: PandocMonad m => String -> LP m String
1307−verbEnv name = do
1308− skipopts
1309− optional blankline
1310− let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
1311− charMuncher = anyChar
1312− res <- manyTill charMuncher endEnv
1313− return $ stripTrailingNewlines res
1314−
1315−fancyverbEnv :: PandocMonad m => String -> LP m Blocks
1316−fancyverbEnv name = do
1317− options <- option [] keyvals
1318− let kvs = [ (if k == "firstnumber"
1319− then "startFrom"
1320− else k, v) | (k,v) <- options ]
1321− let classes = [ "numberLines" |
1322− lookup "numbers" options == Just "left" ]
1323− let attr = ("",classes,kvs)
1324− codeBlockWith attr <$> verbEnv name
1325−
13261900orderedList' :: PandocMonad m => LP m Blocks
13271901orderedList' = try $ do
1328− optional sp
1329− (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
1330− try $ char '[' *> anyOrderedListMarker <* char ']'
13311902 spaces
1332− optional $ try $ controlSeq "setlength" *> grouped (controlSeq "itemindent") *> braced
1903+ let markerSpec = do
1904+ symbol '['
1905+ ts <- toksToString <$> manyTill anyTok (symbol ']')
1906+ case runParser anyOrderedListMarker def "option" ts of
1907+ Right r -> return r
1908+ Left _ -> do
1909+ pos <- getPosition
1910+ report $ SkippedContent ("[" ++ ts ++ "]") pos
1911+ return (1, DefaultStyle, DefaultDelim)
1912+ (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) markerSpec
13331913 spaces
1334− start <- option 1 $ try $ do controlSeq "setcounter"
1335− grouped (string "enum" *> many1 (oneOf "iv"))
1914+ optional $ try $ controlSeq "setlength"
1915+ *> grouped (count 1 $ controlSeq "itemindent")
1916+ *> braced
1917+ spaces
1918+ start <- option 1 $ try $ do pos <- getPosition
1919+ controlSeq "setcounter"
1920+ ctr <- toksToString <$> braced
1921+ guard $ "enum" `isPrefixOf` ctr
1922+ guard $ all (`elem` ['i','v']) (drop 4 ctr)
13361923 optional sp
1337− num <- grouped (many1 digit)
1338− spaces
1339− return (read num + 1 :: Int)
1924+ num <- toksToString <$> braced
1925+ case safeRead num of
1926+ Just i -> return (i + 1 :: Int)
1927+ Nothing -> do
1928+ report $ SkippedContent
1929+ ("\\setcounter{" ++ ctr ++
1930+ "}{" ++ num ++ "}") pos
1931+ return 1
13401932 bs <- listenv "enumerate" (many item)
13411933 return $ orderedListWith (start, style, delim) bs
13421934
1343−paragraph :: PandocMonad m => LP m Blocks
1344−paragraph = do
1345− x <- trimInlines . mconcat <$> many1 inline
1346− if x == mempty
1347− then return mempty
1348− else return $ para x
1349−
1350−preamble :: PandocMonad m => LP m Blocks
1351−preamble = mempty <$> manyTill preambleBlock beginDoc
1352− where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}"
1353− preambleBlock = void comment
1354− <|> void sp
1355− <|> void blanklines
1356− <|> void include
1357− <|> void macro
1358− <|> void blockCommand
1359− <|> void anyControlSeq
1360− <|> void braced
1361− <|> void anyChar
1362−
1363−-------
1364−
1365−-- citations
1366−
1367−addPrefix :: [Inline] -> [Citation] -> [Citation]
1368−addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
1369−addPrefix _ _ = []
1370−
1371−addSuffix :: [Inline] -> [Citation] -> [Citation]
1372−addSuffix s ks@(_:_) =
1373− let k = last ks
1374− in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
1375−addSuffix _ _ = []
1376−
1377−simpleCiteArgs :: PandocMonad m => LP m [Citation]
1378−simpleCiteArgs = try $ do
1379− first <- optionMaybe $ toList <$> opt
1380− second <- optionMaybe $ toList <$> opt
1381− keys <- try $ bgroup *> (manyTill citationLabel egroup)
1382− let (pre, suf) = case (first , second ) of
1383− (Just s , Nothing) -> (mempty, s )
1384− (Just s , Just t ) -> (s , t )
1385− _ -> (mempty, mempty)
1386− conv k = Citation { citationId = k
1387− , citationPrefix = []
1388− , citationSuffix = []
1389− , citationMode = NormalCitation
1390− , citationHash = 0
1391− , citationNoteNum = 0
1392− }
1393− return $ addPrefix pre $ addSuffix suf $ map conv keys
1394−
1395−citationLabel :: PandocMonad m => LP m String
1396−citationLabel = optional sp *>
1397− (many1 (satisfy isBibtexKeyChar)
1398− <* optional sp
1399− <* optional (char ',')
1400− <* optional sp)
1401− where isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]" :: String)
1935+-- tables
14021936
1403−cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
1404−cites mode multi = try $ do
1405− cits <- if multi
1406− then many1 simpleCiteArgs
1407− else count 1 simpleCiteArgs
1408− let cs = concat cits
1409− return $ case mode of
1410− AuthorInText -> case cs of
1411− (c:rest) -> c {citationMode = mode} : rest
1412− [] -> []
1413− _ -> map (\a -> a {citationMode = mode}) cs
1937+hline :: PandocMonad m => LP m ()
1938+hline = try $ do
1939+ spaces
1940+ controlSeq "hline" <|>
1941+ -- booktabs rules:
1942+ controlSeq "toprule" <|>
1943+ controlSeq "bottomrule" <|>
1944+ controlSeq "midrule" <|>
1945+ controlSeq "endhead" <|>
1946+ controlSeq "endfirsthead"
1947+ spaces
1948+ optional $ bracketed inline
1949+ return ()
14141950
1415−citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines
1416−citation name mode multi = do
1417− (c,raw) <- withRaw $ cites mode multi
1418− return $ cite c (rawInline "latex" $ "\\" ++ name ++ raw)
1951+lbreak :: PandocMonad m => LP m Tok
1952+lbreak = (controlSeq "\\" <|> controlSeq "tabularnewline") <* spaces
14191953
1420−complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
1421−complexNatbibCitation mode = try $ do
1422− let ils = (toList . trimInlines . mconcat) <$>
1423− many (notFollowedBy (oneOf "\\};") >> inline)
1424− let parseOne = try $ do
1425− skipSpaces
1426− pref <- ils
1427− cit' <- inline -- expect a citation
1428− let citlist = toList cit'
1429− cits' <- case citlist of
1430− [Cite cs _] -> return cs
1431− _ -> mzero
1432− suff <- ils
1433− skipSpaces
1434− optional $ char ';'
1435− return $ addPrefix pref $ addSuffix suff cits'
1436− (c:cits, raw) <- withRaw $ grouped parseOne
1437− return $ cite (c{ citationMode = mode }:cits)
1438− (rawInline "latex" $ "\\citetext" ++ raw)
1954+amp :: PandocMonad m => LP m Tok
1955+amp = symbol '&'
14391956
1440−-- tables
1957+-- Split a Word into individual Symbols (for parseAligns)
1958+splitWordTok :: PandocMonad m => LP m ()
1959+splitWordTok = do
1960+ inp <- getInput
1961+ case inp of
1962+ (Tok spos Word t : rest) -> do
1963+ setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) ++ rest
1964+ _ -> return ()
14411965
1442−parseAligns :: PandocMonad m => LP m [(Alignment, Double, (String, String))]
1966+parseAligns :: PandocMonad m => LP m [(Alignment, Double, ([Tok], [Tok]))]
14431967parseAligns = try $ do
1444− bgroup
1445− let maybeBar = skipMany $ sp <|> () <$ char '|' <|> () <$ (char '@' >> braced)
1446− maybeBar
1447− let cAlign = AlignCenter <$ char 'c'
1448− let lAlign = AlignLeft <$ char 'l'
1449− let rAlign = AlignRight <$ char 'r'
1450− let parAlign = AlignLeft <$ char 'p'
1451− -- algins from tabularx
1452− let xAlign = AlignLeft <$ char 'X'
1453− let mAlign = AlignLeft <$ char 'm'
1454− let bAlign = AlignLeft <$ char 'b'
1455− let alignChar = cAlign <|> lAlign <|> rAlign <|> parAlign
1456− <|> xAlign <|> mAlign <|> bAlign
1457− let alignPrefix = char '>' >> braced
1458− let alignSuffix = char '<' >> braced
1968+ let maybeBar = skipMany $
1969+ sp <|> () <$ symbol '|' <|> () <$ (symbol '@' >> braced)
1970+ let cAlign = AlignCenter <$ symbol 'c'
1971+ let lAlign = AlignLeft <$ symbol 'l'
1972+ let rAlign = AlignRight <$ symbol 'r'
1973+ let parAlign = AlignLeft <$ symbol 'p'
1974+ -- aligns from tabularx
1975+ let xAlign = AlignLeft <$ symbol 'X'
1976+ let mAlign = AlignLeft <$ symbol 'm'
1977+ let bAlign = AlignLeft <$ symbol 'b'
1978+ let alignChar = splitWordTok *> ( cAlign <|> lAlign <|> rAlign <|> parAlign
1979+ <|> xAlign <|> mAlign <|> bAlign )
1980+ let alignPrefix = symbol '>' >> braced
1981+ let alignSuffix = symbol '<' >> braced
14591982 let colWidth = try $ do
1460− char '{'
1461− ds <- many1 (oneOf "0123456789.")
1983+ symbol '{'
1984+ ds <- trim . toksToString <$> manyTill anyTok (controlSeq "linewidth")
14621985 spaces
1463− string "\\linewidth"
1464− char '}'
1986+ symbol '}'
14651987 case safeRead ds of
14661988 Just w -> return w
14671989 Nothing -> return 0.0
1468− let alignSpec = do
1990+ let alignSpec = try $ do
14691991 spaces
1470− pref <- option "" alignPrefix
1992+ pref <- option [] alignPrefix
14711993 spaces
14721994 al <- alignChar
1473− width <- colWidth <|> option 0.0 (do s <- braced
1995+ width <- colWidth <|> option 0.0 (do s <- toksToString <$> braced
14741996 pos <- getPosition
14751997 report $ SkippedContent s pos
14761998 return 0.0)
14771999 spaces
1478− suff <- option "" alignSuffix
2000+ suff <- option [] alignSuffix
14792001 return (al, width, (pref, suff))
1480− aligns' <- sepEndBy alignSpec maybeBar
2002+ bgroup
2003+ spaces
2004+ maybeBar
2005+ aligns' <- many (alignSpec <* maybeBar)
14812006 spaces
14822007 egroup
14832008 spaces
1484− return $ aligns'
1485−
1486−hline :: PandocMonad m => LP m ()
1487−hline = try $ do
1488− spaces'
1489− controlSeq "hline" <|>
1490− -- booktabs rules:
1491− controlSeq "toprule" <|>
1492− controlSeq "bottomrule" <|>
1493− controlSeq "midrule" <|>
1494− controlSeq "endhead" <|>
1495− controlSeq "endfirsthead"
1496− spaces'
1497− optional $ bracketed (many1 (satisfy (/=']')))
1498− return ()
1499−
1500−lbreak :: PandocMonad m => LP m ()
1501−lbreak = () <$ try (spaces' *>
1502− (controlSeq "\\" <|> controlSeq "tabularnewline") <*
1503− spaces')
1504−
1505−amp :: PandocMonad m => LP m ()
1506−amp = () <$ try (spaces' *> char '&' <* spaces')
2009+ return aligns'
15072010
15082011parseTableRow :: PandocMonad m
1509− => String -- ^ table environment name
1510− -> [(String, String)] -- ^ pref/suffixes
2012+ => Text -- ^ table environment name
2013+ -> [([Tok], [Tok])] -- ^ pref/suffixes
15112014 -> LP m [Blocks]
1512−parseTableRow envname prefsufs = try $ do
2015+parseTableRow envname prefsufs = do
2016+ notFollowedBy (spaces *> end_ envname)
15132017 let cols = length prefsufs
1514− let tableCellRaw = concat <$> many
1515− (do notFollowedBy amp
1516− notFollowedBy lbreak
1517− notFollowedBy $ () <$ try (string ("\\end{" ++ envname ++ "}"))
1518− many1 (noneOf "&%\n\r\\")
1519− <|> try (string "\\&")
1520− <|> count 1 anyChar)
1521− let plainify bs = case toList bs of
1522− [Para ils] -> plain (fromList ils)
1523− _ -> bs
1524− rawcells <- sepBy1 tableCellRaw amp
1525− guard $ length rawcells == cols
1526− let rawcells' = zipWith (\c (p, s) -> p ++ trim c ++ s) rawcells prefsufs
1527− let tableCell = plainify <$> blocks
1528− cells' <- mapM (parseFromString' tableCell) rawcells'
1529− let numcells = length cells'
2018+ -- add prefixes and suffixes in token stream:
2019+ let celltoks (pref, suff) = do
2020+ prefpos <- getPosition
2021+ contents <- many (notFollowedBy
2022+ (() <$ amp <|> () <$ lbreak <|> end_ envname)
2023+ >> anyTok)
2024+ suffpos <- getPosition
2025+ option [] (count 1 amp)
2026+ return $ map (setpos (sourceLine prefpos, sourceColumn prefpos)) pref
2027+ ++ contents ++
2028+ map (setpos (sourceLine suffpos, sourceColumn suffpos)) suff
2029+ rawcells <- sequence (map celltoks prefsufs)
2030+ oldInput <- getInput
2031+ cells <- sequence $ map (\ts -> setInput ts >> parseTableCell) rawcells
2032+ setInput oldInput
2033+ spaces
2034+ let numcells = length cells
15302035 guard $ numcells <= cols && numcells >= 1
1531− guard $ cells' /= [mempty]
2036+ guard $ cells /= [mempty]
15322037 -- note: a & b in a three-column table leaves an empty 3rd cell:
1533− let cells'' = cells' ++ replicate (cols - numcells) mempty
1534− spaces'
1535− return cells''
2038+ return $ cells ++ replicate (cols - numcells) mempty
15362039
1537−spaces' :: PandocMonad m => LP m ()
1538−spaces' = spaces *> skipMany (comment *> spaces)
2040+parseTableCell :: PandocMonad m => LP m Blocks
2041+parseTableCell = do
2042+ let plainify bs = case toList bs of
2043+ [Para ils] -> plain (fromList ils)
2044+ _ -> bs
2045+ updateState $ \st -> st{ sInTableCell = True }
2046+ cells <- plainify <$> blocks
2047+ updateState $ \st -> st{ sInTableCell = False }
2048+ return cells
15392049
1540−simpTable :: PandocMonad m => String -> Bool -> LP m Blocks
2050+simpTable :: PandocMonad m => Text -> Bool -> LP m Blocks
15412051simpTable envname hasWidthParameter = try $ do
1542− when hasWidthParameter $ () <$ (spaces' >> tok)
2052+ when hasWidthParameter $ () <$ (spaces >> tok)
15432053 skipopts
15442054 colspecs <- parseAligns
15452055 let (aligns, widths, prefsufs) = unzip3 colspecs
15462056 let cols = length colspecs
15472057 optional $ controlSeq "caption" *> skipopts *> setCaption
15482058 optional lbreak
1549− spaces'
2059+ spaces
15502060 skipMany hline
1551− spaces'
2061+ spaces
15522062 header' <- option [] $ try (parseTableRow envname prefsufs <*
15532063 lbreak <* many1 hline)
1554− spaces'
2064+ spaces
15552065 rows <- sepEndBy (parseTableRow envname prefsufs)
15562066 (lbreak <* optional (skipMany hline))
1557− spaces'
2067+ spaces
15582068 optional $ controlSeq "caption" *> skipopts *> setCaption
15592069 optional lbreak
1560− spaces'
2070+ spaces
15612071 let header'' = if null header'
15622072 then replicate cols mempty
15632073 else header'
15642074 lookAhead $ controlSeq "end" -- make sure we're at end
15652075 return $ table mempty (zip aligns widths) header'' rows
15662076
1567−removeDoubleQuotes :: String -> String
1568−removeDoubleQuotes ('"':xs) =
1569− case reverse xs of
1570− '"':ys -> reverse ys
1571− _ -> '"':xs
1572−removeDoubleQuotes xs = xs
2077+addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
2078+addTableCaption = walkM go
2079+ where go (Table c als ws hs rs) = do
2080+ mbcapt <- sCaption <$> getState
2081+ return $ case mbcapt of
2082+ Just ils -> Table (toList ils) als ws hs rs
2083+ Nothing -> Table c als ws hs rs
2084+ go x = return x
2085+
2086+
2087+block :: PandocMonad m => LP m Blocks
2088+block = (mempty <$ spaces1)
2089+ <|> environment
2090+ <|> include
2091+ <|> macroDef
2092+ <|> paragraph
2093+ <|> blockCommand
2094+ <|> grouped block
2095+
2096+blocks :: PandocMonad m => LP m Blocks
2097+blocks = mconcat <$> many block
2098+