@@ -1,5 +1,5 @@
11{-
2−Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
2+Copyright (C) 2006-2012 John MacFarlane <jgm@berkeley.edu>
33
44This program is free software; you can redistribute it and/or modify
55it under the terms of the GNU General Public License as published by
@@ -18,8 +18,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
1818
1919{- |
2020 Module : Text.Pandoc.Readers.LaTeX
21− Copyright : Copyright (C) 2006-2010 John MacFarlane
22− License : GNU GPL, version 2 or above
21+ Copyright : Copyright (C) 2006-2012 John MacFarlane
22+ License : GNU GPL, version 2 or above
2323
2424 Maintainer : John MacFarlane <jgm@berkeley.edu>
2525 Stability : alpha
@@ -27,20 +27,24 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2727
2828Conversion of LaTeX to 'Pandoc' document.
2929-}
30−module Text.Pandoc.Readers.LaTeX (
31− readLaTeX,
32− rawLaTeXInline,
33− rawLaTeXEnvironment'
30+module Text.Pandoc.Readers.LaTeX ( readLaTeX,
31+ rawLaTeXInline,
32+ rawLaTeXBlock,
33+ handleIncludes
3434 ) where
3535
36−import Text.ParserCombinators.Parsec
36+import Text.ParserCombinators.Parsec hiding ((<|>), space, many, optional)
3737import Text.Pandoc.Definition
3838import Text.Pandoc.Shared
3939import Text.Pandoc.Parsing
40−import Data.Maybe ( fromMaybe )
41−import Data.Char ( chr, toUpper )
42−import Data.List ( intercalate, isPrefixOf, isSuffixOf )
40+import Data.Char ( chr, ord )
4341import Control.Monad
42+import Text.Pandoc.Builder
43+import Data.Char (isLetter)
44+import Control.Applicative
45+import Data.Monoid
46+import System.FilePath (replaceExtension)
47+import qualified Data.Map as M
4448
4549-- | Parse LaTeX from string and return 'Pandoc' document.
4650readLaTeX :: ParserState -- ^ Parser state, including options for parser
@@ -48,1002 +52,757 @@ readLaTeX :: ParserState -- ^ Parser state, including options for parser
4852 -> Pandoc
4953readLaTeX = readWith parseLaTeX
5054
51−-- characters with special meaning
52−specialChars :: [Char]
53−specialChars = "\\`$%^&_~#{}[]\n \t|<>'\"-"
54−
55−--
56−-- utility functions
57−--
58−
59−-- | Returns text between brackets and its matching pair.
60−bracketedText :: Char -> Char -> GenParser Char st [Char]
61−bracketedText openB closeB = do
62− result <- charsInBalanced openB closeB anyChar
63− return $ [openB] ++ result ++ [closeB]
64−
65−-- | Returns an option or argument of a LaTeX command.
66−optOrArg :: GenParser Char st [Char]
67−optOrArg = try $ spaces >> (bracketedText '{' '}' <|> bracketedText '[' ']')
68−
69−-- | True if the string begins with '{'.
70−isArg :: [Char] -> Bool
71−isArg ('{':_) = True
72−isArg _ = False
55+parseLaTeX :: LP Pandoc
56+parseLaTeX = do
57+ bs <- blocks
58+ eof
59+ st <- getState
60+ let title' = stateTitle st
61+ let authors' = stateAuthors st
62+ let date' = stateDate st
63+ return $ Pandoc (Meta title' authors' date') $ toList bs
7364
74−-- | Returns list of options and arguments of a LaTeX command.
75−commandArgs :: GenParser Char st [[Char]]
76−commandArgs = many optOrArg
65+type LP = GenParser Char ParserState
7766
78−-- | Parses LaTeX command, returns (name, star, list of options or arguments).
79−command :: GenParser Char st ([Char], [Char], [[Char]])
80−command = do
67+anyControlSeq :: LP String
68+anyControlSeq = do
8169 char '\\'
82− name <- many1 letter
83− star <- option "" (string "*") -- some commands have starred versions
84− args <- commandArgs
85− return (name, star, args)
86−
87−begin :: [Char] -> GenParser Char st [Char]
88−begin name = try $ do
89− string "\\begin"
90− spaces
91− char '{'
92− string name
93− char '}'
94− optional commandArgs
95− spaces
70+ next <- option '\n' anyChar
71+ name <- case next of
72+ '\n' -> return ""
73+ c | isLetter c -> (c:) <$> (many letter <* optional sp)
74+ | otherwise -> return [c]
9675 return name
9776
98−end :: [Char] -> GenParser Char st [Char]
99−end name = try $ do
100− string "\\end"
101− spaces
102− char '{'
103− string name
104− char '}'
77+controlSeq :: String -> LP String
78+controlSeq name = try $ do
79+ char '\\'
80+ case name of
81+ "" -> mzero
82+ [c] | not (isLetter c) -> string [c]
83+ cs -> string cs <* optional sp
10584 return name
10685
107−-- | Returns a list of block elements containing the contents of an
108−-- environment.
109−environment :: [Char] -> GenParser Char ParserState [Block]
110−environment name = try $ begin name >> spaces >> manyTill block (end name) >>~ spaces
111−
112−anyEnvironment :: GenParser Char ParserState Block
113−anyEnvironment = try $ do
114− string "\\begin"
115− spaces
86+sp :: LP ()
87+sp = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
88+ <|> (try $ newline >>~ lookAhead anyChar >>~ notFollowedBy blankline)
89+
90+isLowerHex :: Char -> Bool
91+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
92+
93+tildeEscape :: LP Char
94+tildeEscape = try $ do
95+ string "^^"
96+ c <- satisfy (\x -> x >= '\0' && x <= '\128')
97+ d <- if isLowerHex c
98+ then option "" $ count 1 (satisfy isLowerHex)
99+ else return ""
100+ if null d
101+ then case ord c of
102+ x | x >= 64 && x <= 127 -> return $ chr (x - 64)
103+ | otherwise -> return $ chr (x + 64)
104+ else return $ chr $ read ('0':'x':c:d)
105+
106+comment :: LP ()
107+comment = do
108+ char '%'
109+ skipMany (satisfy (/='\n'))
110+ newline
111+ return ()
112+
113+grouped :: Monoid a => LP a -> LP a
114+grouped parser = try $ char '{' *> (mconcat <$> manyTill parser (char '}'))
115+
116+braced :: LP String
117+braced = char '{' *> (concat <$> manyTill
118+ ( many1 (satisfy (\c -> c /= '\\' && c /= '}' && c /= '{'))
119+ <|> try (string "\\}")
120+ <|> try (string "\\{")
121+ <|> ((\x -> "{" ++ x ++ "}") <$> braced)
122+ <|> count 1 anyChar
123+ ) (char '}'))
124+
125+bracketed :: Monoid a => LP a -> LP a
126+bracketed parser = try $ char '[' *> (mconcat <$> manyTill parser (char ']'))
127+
128+trim :: String -> String
129+trim = removeLeadingTrailingSpace
130+
131+mathDisplay :: LP String -> LP Inlines
132+mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
133+
134+mathInline :: LP String -> LP Inlines
135+mathInline p = math <$> (try p >>= applyMacros')
136+
137+double_quote :: LP Inlines
138+double_quote = (doubleQuoted . mconcat) <$>
139+ (try $ string "``" *> manyTill inline (try $ string "''"))
140+
141+single_quote :: LP Inlines
142+single_quote = (singleQuoted . mconcat) <$>
143+ (try $ char '`' *> manyTill inline (try $ char '\'' >> notFollowedBy letter))
144+
145+inline :: LP Inlines
146+inline = (mempty <$ comment)
147+ <|> (space <$ sp)
148+ <|> inlineText
149+ <|> inlineCommand
150+ <|> grouped inline
151+ <|> (char '-' *> option (str "-")
152+ ((char '-') *> option (str "–") (str "—" <$ char '-')))
153+ <|> double_quote
154+ <|> single_quote
155+ <|> (str "’" <$ char '\'')
156+ <|> (str "\160" <$ char '~')
157+ <|> (mathDisplay $ string "$$" *> manyTill anyChar (try $ string "$$"))
158+ <|> (mathInline $ char '$' *> manyTill anyChar (char '$'))
159+ <|> (superscript <$> (char '^' *> tok))
160+ <|> (subscript <$> (char '_' *> tok))
161+ <|> (failUnlessLHS *> char '|' *> doLHSverb)
162+ <|> (str <$> count 1 tildeEscape)
163+ <|> (str <$> string "]")
164+ <|> (str <$> count 1 (satisfy (\c -> c /= '\\' && c /='\n' && c /='}' && c /='{'))) -- eat random leftover characters
165+
166+inlines :: LP Inlines
167+inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
168+
169+block :: LP Blocks
170+block = (mempty <$ comment)
171+ <|> (mempty <$ ((spaceChar <|> blankline) *> spaces))
172+ <|> environment
173+ <|> mempty <$ macro -- TODO improve macros, make them work everywhere
174+ <|> blockCommand
175+ <|> grouped block
176+ <|> paragraph
177+
178+
179+blocks :: LP Blocks
180+blocks = mconcat <$> many block
181+
182+blockCommand :: LP Blocks
183+blockCommand = try $ do
184+ name <- anyControlSeq
185+ star <- option "" (string "*" <* optional sp)
186+ let name' = name ++ star
187+ case M.lookup name' blockCommands of
188+ Just p -> p
189+ Nothing -> case M.lookup name blockCommands of
190+ Just p -> p
191+ Nothing -> mzero
192+
193+inBrackets :: Inlines -> Inlines
194+inBrackets x = (str "[") <> x <> (str "]")
195+
196+blockCommands :: M.Map String (LP Blocks)
197+blockCommands = M.fromList
198+ [ ("par", pure mempty)
199+ , ("title", mempty <$ (tok >>= addTitle))
200+ , ("subtitle", mempty <$ (tok >>= addSubtitle))
201+ , ("author", mempty <$ authors)
202+ , ("date", mempty <$ (tok >>= addDate))
203+ , ("maketitle", pure mempty)
204+ -- \ignore{} is used conventionally in literate haskell for definitions
205+ -- that are to be processed by the compiler but not printed.
206+ , ("ignore", mempty <$ tok)
207+ , ("hyperdef", mempty <$ (tok *> tok))
208+ , ("chapter", updateState (\s -> s{ stateHasChapters = True }) *> section 0)
209+ , ("section", section 1)
210+ , ("subsection", section 2)
211+ , ("subsubsection", section 3)
212+ , ("paragraph", section 4)
213+ , ("subparagraph", section 5)
214+ , ("opening", (para . trimInlines) <$> tok)
215+ , ("closing", (para . trimInlines) <$> tok)
216+ , ("rule", optional opt *> tok *> tok *> pure horizontalRule)
217+ , ("begin", mzero) -- these are here so they won't be interpreted as inline
218+ , ("end", mzero)
219+ , ("item", loose_item)
220+ , ("documentclass", optional opt *> braced *> preamble)
221+ -- should be parsed by macro, but we need this
222+ -- here so these aren't parsed as inline
223+ , ("newcommand", mempty <$ (tok *> optional opt *> tok))
224+ , ("renewcommand", mempty <$ (tok *> optional opt *> tok))
225+ , ("newenvironment", mempty <$ (tok *> tok *> tok))
226+ , ("renewenvironment", mempty <$ (tok *> tok *> tok))
227+ , ("special", pure mempty)
228+ , ("pdfannot", pure mempty)
229+ , ("pdfstringdef", pure mempty)
230+ , ("index", pure mempty)
231+ , ("bibliography", pure mempty)
232+ ]
233+
234+addTitle :: Inlines -> LP ()
235+addTitle tit = updateState (\s -> s{ stateTitle = toList tit })
236+
237+addSubtitle :: Inlines -> LP ()
238+addSubtitle tit = updateState (\s -> s{ stateTitle = stateTitle s ++
239+ toList (str ":" <> linebreak <> tit) })
240+
241+authors :: LP ()
242+authors = try $ do
116243 char '{'
117− name <- many letter
118− star <- option "" (string "*") -- some environments have starred variants
119− char '}'
120− optional commandArgs
121− spaces
122− contents <- manyTill block (end (name ++ star))
123− spaces
124− return $ BlockQuote contents
125−
126−--
127−-- parsing documents
128−--
244+ let oneAuthor = mconcat <$> many1 (notFollowedBy' (controlSeq "and") >> inline)
245+ auths <- sepBy oneAuthor (controlSeq "and")
246+ updateState (\s -> s { stateAuthors = map (normalizeSpaces . toList) auths })
247+
248+addDate :: Inlines -> LP ()
249+addDate dat = updateState (\s -> s{ stateDate = toList dat })
250+
251+section :: Int -> LP Blocks
252+section lvl = do
253+ hasChapters <- stateHasChapters `fmap` getState
254+ let lvl' = if hasChapters then lvl + 1 else lvl
255+ optional sp
256+ optional opt
257+ contents <- grouped inline
258+ return $ header lvl' contents
259+
260+inlineCommand :: LP Inlines
261+inlineCommand = try $ do
262+ name <- anyControlSeq
263+ guard $ not $ isBlockCommand name
264+ parseRaw <- stateParseRaw `fmap` getState
265+ star <- option "" (string "*")
266+ let name' = name ++ star
267+ case M.lookup name' inlineCommands of
268+ Just p -> p
269+ Nothing -> case M.lookup name inlineCommands of
270+ Just p -> p
271+ Nothing
272+ | parseRaw ->
273+ (rawInline "latex" . (('\\':name') ++)) <$>
274+ (withRaw (optional opt *> many braced)
275+ >>= applyMacros' . snd)
276+ | otherwise -> return mempty
277+
278+isBlockCommand :: String -> Bool
279+isBlockCommand s = maybe False (const True) $ M.lookup s blockCommands
280+
281+inlineCommands :: M.Map String (LP Inlines)
282+inlineCommands = M.fromList
283+ [ ("emph", emph <$> tok)
284+ , ("textit", emph <$> tok)
285+ , ("textsc", smallcaps <$> tok)
286+ , ("sout", strikeout <$> tok)
287+ , ("textsuperscript", superscript <$> tok)
288+ , ("textsubscript", subscript <$> tok)
289+ , ("textbackslash", lit "\\")
290+ , ("backslash", lit "\\")
291+ , ("textbf", strong <$> tok)
292+ , ("ldots", lit "…")
293+ , ("dots", lit "…")
294+ , ("mdots", lit "…")
295+ , ("sim", lit "~")
296+ , ("label", inBrackets <$> tok)
297+ , ("ref", inBrackets <$> tok)
298+ , ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
299+ , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
300+ , ("ensuremath", mathInline $ braced)
301+ , ("$", lit "$")
302+ , ("%", lit "%")
303+ , ("&", lit "&")
304+ , ("#", lit "#")
305+ , ("_", lit "_")
306+ , ("{", lit "{")
307+ , ("}", lit "}")
308+ -- old TeX commands
309+ , ("em", emph <$> inlines)
310+ , ("it", emph <$> inlines)
311+ , ("sl", emph <$> inlines)
312+ , ("bf", strong <$> inlines)
313+ , ("rm", inlines)
314+ , ("itshape", emph <$> inlines)
315+ , ("slshape", emph <$> inlines)
316+ , ("scshape", smallcaps <$> inlines)
317+ , ("bfseries", strong <$> inlines)
318+ , ("/", pure mempty) -- italic correction
319+ , ("cc", lit "ç")
320+ , ("cC", lit "Ç")
321+ , ("aa", lit "å")
322+ , ("AA", lit "Å")
323+ , ("ss", lit "ß")
324+ , ("o", lit "ø")
325+ , ("O", lit "Ø")
326+ , ("L", lit "Ł")
327+ , ("l", lit "ł")
328+ , ("ae", lit "æ")
329+ , ("AE", lit "Æ")
330+ , ("pounds", lit "£")
331+ , ("euro", lit "€")
332+ , ("copyright", lit "©")
333+ , ("sect", lit "§")
334+ , ("`", option (str "`") $ try $ tok >>= accent grave)
335+ , ("'", option (str "'") $ try $ tok >>= accent acute)
336+ , ("^", option (str "^") $ try $ tok >>= accent hat)
337+ , ("~", option (str "~") $ try $ tok >>= accent circ)
338+ , ("\"", option (str "\"") $ try $ tok >>= accent umlaut)
339+ , ("i", lit "i")
340+ , ("\\", linebreak <$ optional (bracketed inline *> optional sp))
341+ , (",", pure mempty)
342+ , ("@", pure mempty)
343+ , (" ", lit "\160")
344+ , ("bar", lit "|")
345+ , ("textless", lit "<")
346+ , ("textgreater", lit ">")
347+ , ("thanks", (note . mconcat) <$> (char '{' *> manyTill block (char '}')))
348+ , ("footnote", (note . mconcat) <$> (char '{' *> manyTill block (char '}')))
349+ , ("verb", doverb)
350+ , ("lstinline", doverb)
351+ , ("texttt", (code . stringify . toList) <$> tok)
352+ , ("url", (unescapeURL <$> braced) >>= \url ->
353+ pure (link url "" (codeWith ("",["url"],[]) url)))
354+ , ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
355+ tok >>= \lab ->
356+ pure (link url "" lab))
357+ , ("includegraphics", optional opt *> (unescapeURL <$> braced) >>=
358+ (\src -> pure (image src "" (str "image"))))
359+ , ("cite", citation NormalCitation False)
360+ , ("citep", citation NormalCitation False)
361+ , ("citep*", citation NormalCitation False)
362+ , ("citeal", citation NormalCitation False)
363+ , ("citealp", citation NormalCitation False)
364+ , ("citealp*", citation NormalCitation False)
365+ , ("autocite", citation NormalCitation False)
366+ , ("footcite", citation NormalCitation False)
367+ , ("parencite", citation NormalCitation False)
368+ , ("supercite", citation NormalCitation False)
369+ , ("footcitetext", citation NormalCitation False)
370+ , ("citeyearpar", citation SuppressAuthor False)
371+ , ("citeyear", citation SuppressAuthor False)
372+ , ("autocite*", citation SuppressAuthor False)
373+ , ("cite*", citation SuppressAuthor False)
374+ , ("parencite*", citation SuppressAuthor False)
375+ , ("textcite", citation AuthorInText False)
376+ , ("citet", citation AuthorInText False)
377+ , ("citet*", citation AuthorInText False)
378+ , ("citealt", citation AuthorInText False)
379+ , ("citealt*", citation AuthorInText False)
380+ , ("textcites", citation AuthorInText True)
381+ , ("cites", citation NormalCitation True)
382+ , ("autocites", citation NormalCitation True)
383+ , ("footcites", citation NormalCitation True)
384+ , ("parencites", citation NormalCitation True)
385+ , ("supercites", citation NormalCitation True)
386+ , ("footcitetexts", citation NormalCitation True)
387+ , ("Autocite", citation NormalCitation False)
388+ , ("Footcite", citation NormalCitation False)
389+ , ("Parencite", citation NormalCitation False)
390+ , ("Supercite", citation NormalCitation False)
391+ , ("Footcitetext", citation NormalCitation False)
392+ , ("Citeyearpar", citation SuppressAuthor False)
393+ , ("Citeyear", citation SuppressAuthor False)
394+ , ("Autocite*", citation SuppressAuthor False)
395+ , ("Cite*", citation SuppressAuthor False)
396+ , ("Parencite*", citation SuppressAuthor False)
397+ , ("Textcite", citation AuthorInText False)
398+ , ("Textcites", citation AuthorInText True)
399+ , ("Cites", citation NormalCitation True)
400+ , ("Autocites", citation NormalCitation True)
401+ , ("Footcites", citation NormalCitation True)
402+ , ("Parencites", citation NormalCitation True)
403+ , ("Supercites", citation NormalCitation True)
404+ , ("Footcitetexts", citation NormalCitation True)
405+ , ("citetext", complexNatbibCitation NormalCitation)
406+ , ("citeauthor", (try (tok *> optional sp *> controlSeq "citetext") *>
407+ complexNatbibCitation AuthorInText)
408+ <|> citation AuthorInText False)
409+ ]
410+
411+unescapeURL :: String -> String
412+unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
413+ where isEscapable '%' = True
414+ isEscapable '#' = True
415+ isEscapable _ = False
416+unescapeURL (x:xs) = x:unescapeURL xs
417+unescapeURL [] = ""
418+
419+doverb :: LP Inlines
420+doverb = do
421+ marker <- anyChar
422+ code <$> manyTill (satisfy (/='\n')) (char marker)
423+
424+doLHSverb :: LP Inlines
425+doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
426+
427+lit :: String -> LP Inlines
428+lit = pure . str
429+
430+accent :: (Char -> Char) -> Inlines -> LP Inlines
431+accent f ils =
432+ case toList ils of
433+ (Str (x:xs) : ys) -> return $ fromList $ (Str (f x : xs) : ys)
434+ [] -> mzero
435+ _ -> return ils
436+
437+grave :: Char -> Char
438+grave 'A' = 'À'
439+grave 'E' = 'È'
440+grave 'I' = 'Ì'
441+grave 'O' = 'Ò'
442+grave 'U' = 'Ù'
443+grave 'a' = 'à'
444+grave 'e' = 'è'
445+grave 'i' = 'ì'
446+grave 'o' = 'ò'
447+grave 'u' = 'ù'
448+grave c = c
449+
450+acute :: Char -> Char
451+acute 'A' = 'Á'
452+acute 'E' = 'É'
453+acute 'I' = 'Í'
454+acute 'O' = 'Ó'
455+acute 'U' = 'Ú'
456+acute 'a' = 'á'
457+acute 'e' = 'é'
458+acute 'i' = 'í'
459+acute 'o' = 'ó'
460+acute 'u' = 'ú'
461+acute c = c
462+
463+hat :: Char -> Char
464+hat 'A' = 'Â'
465+hat 'E' = 'Ê'
466+hat 'I' = 'Î'
467+hat 'O' = 'Ô'
468+hat 'U' = 'Û'
469+hat 'a' = 'ã'
470+hat 'e' = 'ê'
471+hat 'i' = 'î'
472+hat 'o' = 'ô'
473+hat 'u' = 'û'
474+hat c = c
475+
476+circ :: Char -> Char
477+circ 'A' = 'Ã'
478+circ 'O' = 'Õ'
479+circ 'o' = 'õ'
480+circ 'N' = 'Ñ'
481+circ 'n' = 'ñ'
482+circ c = c
483+
484+umlaut :: Char -> Char
485+umlaut 'A' = 'Ä'
486+umlaut 'E' = 'Ë'
487+umlaut 'I' = 'Ï'
488+umlaut 'O' = 'Ö'
489+umlaut 'U' = 'Ü'
490+umlaut 'a' = 'ä'
491+umlaut 'e' = 'ë'
492+umlaut 'i' = 'ï'
493+umlaut 'o' = 'ö'
494+umlaut 'u' = 'ü'
495+umlaut c = c
496+
497+tok :: LP Inlines
498+tok = try $ grouped inline <|> inlineCommand <|> str <$> (count 1 $ inlineChar)
499+
500+opt :: LP Inlines
501+opt = bracketed inline <* optional sp
502+
503+inlineText :: LP Inlines
504+inlineText = str <$> many1 inlineChar
505+
506+inlineChar :: LP Char
507+inlineChar = satisfy $ \c ->
508+ not (c == '\\' || c == '$' || c == '%' || c == '^' || c == '_' ||
509+ c == '&' || c == '~' || c == '#' || c == '{' || c == '}' ||
510+ c == '^' || c == '\'' || c == '`' || c == '-' || c == ']' ||
511+ c == ' ' || c == '\t' || c == '\n' )
512+
513+environment :: LP Blocks
514+environment = do
515+ controlSeq "begin"
516+ name <- braced
517+ parseRaw <- stateParseRaw `fmap` getState
518+ let addBegin x = "\\begin{" ++ name ++ "}" ++ x
519+ case M.lookup name environments of
520+ Just p -> p
521+ Nothing -> if parseRaw
522+ then (rawBlock "latex" . addBegin) <$>
523+ (withRaw (env name blocks) >>= applyMacros' . snd)
524+ else env name blocks
525+
526+-- | Replace "include" commands with file contents.
527+handleIncludes :: String -> IO String
528+handleIncludes [] = return []
529+handleIncludes ('\\':xs) =
530+ case runParser include defaultParserState "input" ('\\':xs) of
531+ Right (f, rest) -> do ys <- catch (readFile (replaceExtension f ".tex"))
532+ (\e -> warn
533+ ("could not open included file `" ++
534+ f ++ "': " ++ show e) >> return "")
535+ (ys ++) `fmap` handleIncludes rest
536+ _ -> case runParser verbatimEnv defaultParserState "input" ('\\':xs) of
537+ Right (r, rest) -> (r ++) `fmap` handleIncludes rest
538+ _ -> ('\\':) `fmap` handleIncludes xs
539+handleIncludes (x:xs) = (x:) `fmap` handleIncludes xs
540+
541+include :: LP (FilePath, String)
542+include = do
543+ controlSeq "include"
544+ f <- braced
545+ rest <- getInput
546+ return (f, rest)
547+
548+verbatimEnv :: LP (String, String)
549+verbatimEnv = do
550+ (_,r) <- withRaw $ do
551+ controlSeq "begin"
552+ name <- braced
553+ guard $ name == "verbatim" || name == "Verbatim" ||
554+ name == "lstlisting"
555+ verbEnv name
556+ rest <- getInput
557+ return (r,rest)
129558
130−-- | Process LaTeX preamble, extracting metadata.
131−processLaTeXPreamble :: GenParser Char ParserState ()
132−processLaTeXPreamble = do
133− try $ string "\\documentclass"
134− skipMany $ bibliographic <|> macro <|> commentBlock <|> skipChar
559+-- | Parse any LaTeX environment and return a string containing
560+-- the whole literal environment as raw TeX.
561+rawLaTeXBlock :: GenParser Char ParserState String
562+rawLaTeXBlock =
563+ (rawLaTeXEnvironment <|> (snd <$> withRaw blockCommand)) >>= applyMacros'
135564
136−-- | Parse LaTeX and return 'Pandoc'.
137−parseLaTeX :: GenParser Char ParserState Pandoc
138−parseLaTeX = do
139− spaces
140− skipMany $ comment >> spaces
141− blocks <- try (processLaTeXPreamble >> environment "document")
142− <|> (many block >>~ (spaces >> eof))
143− state <- getState
144− let blocks' = filter (/= Null) blocks
145− let title' = stateTitle state
146− let authors' = stateAuthors state
147− let date' = stateDate state
148− return $ Pandoc (Meta title' authors' date') blocks'
149−
150−--
151−-- parsing blocks
152−--
153−
154−parseBlocks :: GenParser Char ParserState [Block]
155−parseBlocks = spaces >> many block
156−
157−block :: GenParser Char ParserState Block
158−block = choice [ hrule
159− , codeBlock
160− , header
161− , list
162− , blockQuote
163− , simpleTable
164− , commentBlock
165− , macro
166− , bibliographic
167− , para
168− , itemBlock
169− , unknownEnvironment
170− , ignore
171− , unknownCommand
172− ] <?> "block"
173−
174−--
175−-- header blocks
176−--
177−
178−header :: GenParser Char ParserState Block
179−header = section <|> chapter
180−
181−chapter :: GenParser Char ParserState Block
182−chapter = try $ do
183− string "\\chapter"
184− result <- headerWithLevel 1
185− updateState $ \s -> s{ stateHasChapters = True }
186− return result
187−
188−section :: GenParser Char ParserState Block
189−section = try $ do
190− char '\\'
191− subs <- many (try (string "sub"))
192− base <- try (string "section" >> return 1) <|> (string "paragraph" >> return 4)
193− st <- getState
194− let lev = if stateHasChapters st
195− then length subs + base + 1
196− else length subs + base
197− headerWithLevel lev
565+rawLaTeXEnvironment :: GenParser Char ParserState String
566+rawLaTeXEnvironment = try $ do
567+ controlSeq "begin"
568+ name <- braced
569+ let addBegin x = "\\begin{" ++ name ++ "}" ++ x
570+ addBegin <$> (withRaw (env name blocks) >>= applyMacros' . snd)
198571
199−headerWithLevel :: Int -> GenParser Char ParserState Block
200−headerWithLevel lev = try $ do
201− spaces
202− optional (char '*')
203− spaces
204− optional $ bracketedText '[' ']' -- alt title
572+rawLaTeXInline :: GenParser Char ParserState Inline
573+rawLaTeXInline = do
574+ (res, raw) <- withRaw inlineCommand
575+ if res == mempty
576+ then return (Str "")
577+ else RawInline "latex" <$> (applyMacros' raw)
578+
579+environments :: M.Map String (LP Blocks)
580+environments = M.fromList
581+ [ ("document", env "document" blocks)
582+ , ("letter", env "letter" blocks)
583+ , ("center", env "center" blocks)
584+ , ("tabular", env "tabular" simpTable)
585+ , ("quote", blockQuote <$> env "quote" blocks)
586+ , ("quotation", blockQuote <$> env "quotation" blocks)
587+ , ("itemize", bulletList <$> listenv "itemize" (many item))
588+ , ("description", definitionList <$> listenv "description" (many descItem))
589+ , ("enumerate", ordered_list)
590+ , ("code", failUnlessLHS *>
591+ (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$> verbEnv "code"))
592+ , ("verbatim", codeBlock <$> (verbEnv "verbatim"))
593+ , ("Verbatim", codeBlock <$> (verbEnv "Verbatim"))
594+ , ("lstlisting", codeBlock <$> (verbEnv "listlisting"))
595+ , ("displaymath", mathEnv Nothing "displaymath")
596+ , ("equation", mathEnv Nothing "equation")
597+ , ("equation*", mathEnv Nothing "equation*")
598+ , ("gather", mathEnv (Just "gathered") "gather")
599+ , ("gather*", mathEnv (Just "gathered") "gather*")
600+ , ("multiline", mathEnv (Just "gathered") "multiline")
601+ , ("multiline*", mathEnv (Just "gathered") "multiline*")
602+ , ("eqnarray", mathEnv (Just "aligned*") "eqnarray")
603+ , ("eqnarray*", mathEnv (Just "aligned*") "eqnarray*")
604+ , ("align", mathEnv (Just "aligned*") "align")
605+ , ("align*", mathEnv (Just "aligned*") "align*")
606+ , ("alignat", mathEnv (Just "aligned*") "alignat")
607+ , ("alignat*", mathEnv (Just "aligned*") "alignat*")
608+ ]
609+
610+item :: LP Blocks
611+item = blocks *> controlSeq "item" *> optional opt *> blocks
612+
613+loose_item :: LP Blocks
614+loose_item = do
615+ ctx <- stateParserContext `fmap` getState
616+ if ctx == ListItemState
617+ then mzero
618+ else return mempty
619+
620+descItem :: LP (Inlines, [Blocks])
621+descItem = do
622+ blocks -- skip blocks before item
623+ controlSeq "item"
624+ optional sp
625+ ils <- opt
626+ bs <- blocks
627+ return (ils, [bs])
628+
629+env :: String -> LP a -> LP a
630+env name p = p <* (controlSeq "end" *> braced >>= guard . (== name))
631+
632+listenv :: String -> LP a -> LP a
633+listenv name p = try $ do
634+ oldCtx <- stateParserContext `fmap` getState
635+ updateState $ \st -> st{ stateParserContext = ListItemState }
636+ res <- env name p
637+ updateState $ \st -> st{ stateParserContext = oldCtx }
638+ return res
639+
640+mathEnv :: Maybe String -> String -> LP Blocks
641+mathEnv innerEnv name = para <$> mathDisplay (inner <$> verbEnv name)
642+ where inner x = case innerEnv of
643+ Nothing -> x
644+ Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
645+ "\\end{" ++ y ++ "}"
646+
647+verbEnv :: String -> LP String
648+verbEnv name = do
649+ optional opt
650+ optional blankline
651+ let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
652+ res <- manyTill anyChar endEnv
653+ return $ stripTrailingNewlines res
654+
655+ordered_list :: LP Blocks
656+ordered_list = do
657+ optional sp
658+ (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
659+ try $ char '[' *> anyOrderedListMarker <* char ']'
205660 spaces
206− char '{'
207− title' <- manyTill inline (char '}')
661+ optional $ try $ controlSeq "setlength" *> grouped (controlSeq "itemindent") *> braced
208662 spaces
209− return $ Header lev (normalizeSpaces title')
663+ start <- option 1 $ try $ do controlSeq "setcounter"
664+ grouped (string "enum" *> many1 (oneOf "iv"))
665+ optional sp
666+ num <- grouped (many1 digit)
667+ spaces
668+ return $ (read num + 1 :: Int)
669+ bs <- listenv "enumerate" (many item)
670+ return $ orderedListWith (start, style, delim) bs
671+
672+paragraph :: LP Blocks
673+paragraph = do
674+ x <- mconcat <$> many1 inline
675+ if x == mempty
676+ then return mempty
677+ else return $ para $ trimInlines x
678+
679+preamble :: LP Blocks
680+preamble = mempty <$> manyTill preambleBlock beginDoc
681+ where beginDoc = lookAhead $ controlSeq "begin" *> string "{document}"
682+ preambleBlock = (mempty <$ comment)
683+ <|> (mempty <$ sp)
684+ <|> (mempty <$ blanklines)
685+ <|> (mempty <$ macro)
686+ <|> blockCommand
687+ <|> (mempty <$ anyControlSeq)
688+ <|> (mempty <$ braced)
689+ <|> (mempty <$ anyChar)
690+
691+-------
692+
693+-- citations
694+
695+addPrefix :: Inlines -> [Citation] -> [Citation]
696+addPrefix p (k:ks) = k {citationPrefix = toList p ++ citationPrefix k} : ks
697+addPrefix _ _ = []
210698
211−--
212−-- hrule block
213−--
699+addSuffix :: Inlines -> [Citation] -> [Citation]
700+addSuffix s ks@(_:_) =
701+ let k = last ks
702+ in init ks ++ [k {citationSuffix = citationSuffix k ++ toList s}]
703+addSuffix _ _ = []
704+
705+simpleCiteArgs :: LP [Citation]
706+simpleCiteArgs = try $ do
707+ first <- optionMaybe opt
708+ second <- optionMaybe opt
709+ char '{'
710+ keys <- manyTill citationLabel (char '}')
711+ let (pre, suf) = case (first , second ) of
712+ (Just s , Nothing) -> (mempty, s )
713+ (Just s , Just t ) -> (s , t )
714+ _ -> (mempty, mempty)
715+ conv k = Citation { citationId = k
716+ , citationPrefix = []
717+ , citationSuffix = []
718+ , citationMode = NormalCitation
719+ , citationHash = 0
720+ , citationNoteNum = 0
721+ }
722+ return $ addPrefix pre $ addSuffix suf $ map conv keys
214723
215−hrule :: GenParser Char st Block
216−hrule = oneOfStrings [ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n",
217− "\\newpage" ] >> spaces >> return HorizontalRule
724+citationLabel :: LP String
725+citationLabel = trim <$>
726+ (many1 (satisfy $ \c -> c /=',' && c /='}') <* optional (char ',') <* optional sp)
218727
219−-- tables
728+cites :: CitationMode -> Bool -> LP [Citation]
729+cites mode multi = try $ do
730+ cits <- if multi
731+ then many1 simpleCiteArgs
732+ else count 1 simpleCiteArgs
733+ let (c:cs) = concat cits
734+ return $ case mode of
735+ AuthorInText -> c {citationMode = mode} : cs
736+ _ -> map (\a -> a {citationMode = mode}) (c:cs)
220737
221−simpleTable :: GenParser Char ParserState Block
222−simpleTable = try $ do
223− string "\\begin"
224− spaces
225− string "{tabular}"
226− spaces
227− aligns <- parseAligns
228− let cols = length aligns
229− optional hline
230− header' <- option [] $ parseTableHeader cols
231− rows <- many (parseTableRow cols >>~ optional hline)
232− spaces
233− end "tabular"
234− spaces
235− let header'' = if null header'
236− then replicate cols []
237− else header'
238− return $ Table [] aligns (replicate cols 0) header'' rows
738+citation :: CitationMode -> Bool -> LP Inlines
739+citation mode multi = (flip cite mempty) <$> cites mode multi
740+
741+complexNatbibCitation :: CitationMode -> LP Inlines
742+complexNatbibCitation mode = try $ do
743+ let ils = (trimInlines . mconcat) <$>
744+ many (notFollowedBy (oneOf "\\};") >> inline)
745+ let parseOne = try $ do
746+ skipSpaces
747+ pref <- ils
748+ cit' <- inline -- expect a citation
749+ let citlist = toList cit'
750+ cits' <- case citlist of
751+ [Cite cs _] -> return cs
752+ _ -> mzero
753+ suff <- ils
754+ skipSpaces
755+ optional $ char ';'
756+ return $ addPrefix pref $ addSuffix suff $ cits'
757+ (c:cits) <- grouped parseOne
758+ return $ cite (c{ citationMode = mode }:cits) mempty
239759
240−hline :: GenParser Char st ()
241−hline = try $ spaces >> string "\\hline" >> return ()
760+-- tables
242761
243−parseAligns :: GenParser Char ParserState [Alignment]
762+parseAligns :: LP [Alignment]
244763parseAligns = try $ do
245764 char '{'
246765 optional $ char '|'
247766 let cAlign = char 'c' >> return AlignCenter
248767 let lAlign = char 'l' >> return AlignLeft
249768 let rAlign = char 'r' >> return AlignRight
250− let alignChar = cAlign <|> lAlign <|> rAlign
769+ let alignChar = optional sp *> (cAlign <|> lAlign <|> rAlign)
251770 aligns' <- sepEndBy alignChar (optional $ char '|')
771+ spaces
252772 char '}'
253773 spaces
254774 return aligns'
255775
256−parseTableHeader :: Int -- ^ number of columns
257− -> GenParser Char ParserState [TableCell]
258−parseTableHeader cols = try $ do
259− cells' <- parseTableRow cols
260− hline
261− return cells'
776+hline :: LP ()
777+hline = () <$ (try $ spaces >> controlSeq "hline")
262778
263779parseTableRow :: Int -- ^ number of columns
264− -> GenParser Char ParserState [TableCell]
780+ -> LP [Blocks]
265781parseTableRow cols = try $ do
266− let tableCellInline = notFollowedBy (char '&' <|>
267− (try $ char '\\' >> char '\\')) >> inline
268− cells' <- sepBy (spaces >> liftM ((:[]) . Plain . normalizeSpaces)
269− (many tableCellInline)) (char '&')
782+ let amp = try $ spaces *> string "&"
783+ let tableCellInline = notFollowedBy (amp <|> controlSeq "\\") >> inline
784+ cells' <- sepBy (spaces *> ((plain . trimInlines . mconcat) <$>
785+ many tableCellInline)) amp
270786 guard $ length cells' == cols
271787 spaces
272− (try $ string "\\\\" >> spaces) <|>
273− (lookAhead (end "tabular") >> return ())
788+ try $ controlSeq "\\" <|> lookAhead (try $ controlSeq "end" >> string "{tabular}")
274789 return cells'
275790
276−--
277−-- code blocks
278−--
279−
280−codeBlock :: GenParser Char ParserState Block
281−codeBlock = codeBlockWith "verbatim" <|> codeBlockWith "Verbatim" <|> codeBlockWith "lstlisting" <|> lhsCodeBlock
282−-- Note: Verbatim is from fancyvrb.
283−
284−codeBlockWith :: String -> GenParser Char st Block
285−codeBlockWith env = try $ do
286− string "\\begin"
287− spaces -- don't use begin function because it
288− string $ "{" ++ env ++ "}" -- gobbles whitespace; we want to gobble
289− optional blanklines -- blank lines, but not leading space
290− contents <- manyTill anyChar (try (string $ "\\end{" ++ env ++ "}"))
291− spaces
292− let classes = if env == "code" then ["haskell"] else []
293− return $ CodeBlock ("",classes,[]) (stripTrailingNewlines contents)
294−
295−lhsCodeBlock :: GenParser Char ParserState Block
296−lhsCodeBlock = do
297− failUnlessLHS
298− (CodeBlock (_,_,_) cont) <- codeBlockWith "code"
299− return $ CodeBlock ("", ["sourceCode","literate","haskell"], []) cont
300−
301−--
302−-- block quotes
303−--
304−
305−blockQuote :: GenParser Char ParserState Block
306−blockQuote = (environment "quote" <|> environment "quotation") >>~ spaces >>=
307− return . BlockQuote
308−
309−--
310−-- list blocks
311−--
312−
313−list :: GenParser Char ParserState Block
314−list = bulletList <|> orderedList <|> definitionList <?> "list"
315−
316−listItem :: GenParser Char ParserState ([Inline], [Block])
317−listItem = try $ do
318− ("item", _, args) <- command
319− spaces
320− state <- getState
321− let oldParserContext = stateParserContext state
322− updateState (\s -> s {stateParserContext = ListItemState})
323− blocks <- many block
324− updateState (\s -> s {stateParserContext = oldParserContext})
325− opt <- case args of
326− ([x]) | "[" `isPrefixOf` x && "]" `isSuffixOf` x ->
327− parseFromString (many inline) $ tail $ init x
328− _ -> return []
329− return (opt, blocks)
330−
331−orderedList :: GenParser Char ParserState Block
332−orderedList = try $ do
333− string "\\begin"
334− spaces
335− string "{enumerate}"
336− spaces
337− (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
338− try $ do failIfStrict
339− char '['
340− res <- anyOrderedListMarker
341− char ']'
342− return res
343− spaces
344− option "" $ try $ do string "\\setlength{\\itemindent}"
345− char '{'
346− manyTill anyChar (char '}')
347− spaces
348− start <- option 1 $ try $ do failIfStrict
349− string "\\setcounter{enum"
350− many1 (oneOf "iv")
351− string "}{"
352− num <- many1 digit
353− char '}'
354− spaces
355− return $ (read num) + 1
356− items <- many listItem
357− end "enumerate"
358− spaces
359− return $ OrderedList (start, style, delim) $ map snd items
360−
361−bulletList :: GenParser Char ParserState Block
362−bulletList = try $ do
363− begin "itemize"
364− items <- many listItem
365− end "itemize"
366− spaces
367− return (BulletList $ map snd items)
368−
369−definitionList :: GenParser Char ParserState Block
370−definitionList = try $ do
371− begin "description"
372− items <- many listItem
373− end "description"
374− spaces
375− return $ DefinitionList $ map (\(t,d) -> (t,[d])) items
376−
377−--
378−-- paragraph block
379−--
380−
381−para :: GenParser Char ParserState Block
382−para = do
383− res <- many1 inline
384− spaces
385− return $ if null (filter (`notElem` [Str "", Space]) res)
386− then Null
387− else Para $ normalizeSpaces res
388−
389−--
390−-- title authors date
391−--
392−
393−bibliographic :: GenParser Char ParserState Block
394−bibliographic = choice [ maketitle, title, subtitle, authors, date ]
395−
396−maketitle :: GenParser Char st Block
397−maketitle = try (string "\\maketitle") >> spaces >> return Null
398−
399−title :: GenParser Char ParserState Block
400−title = try $ do
401− string "\\title{"
402− tit <- manyTill inline (char '}')
403− spaces
404− updateState (\state -> state { stateTitle = tit })
405− return Null
406−
407−subtitle :: GenParser Char ParserState Block
408−subtitle = try $ do
409− string "\\subtitle{"
410− tit <- manyTill inline (char '}')
411− spaces
412− updateState (\state -> state { stateTitle = stateTitle state ++
413− Str ":" : LineBreak : tit })
414− return Null
415−
416−authors :: GenParser Char ParserState Block
417−authors = try $ do
418− string "\\author{"
419− let andsep = try $ string "\\and" >> notFollowedBy letter >>
420− spaces >> return '&'
421− raw <- sepBy (many $ notFollowedBy (char '}' <|> andsep) >> inline) andsep
422− let authors' = map normalizeSpaces raw
423− char '}'
424− spaces
425− updateState (\s -> s { stateAuthors = authors' })
426− return Null
427−
428−date :: GenParser Char ParserState Block
429−date = try $ do
430− string "\\date{"
431− date' <- manyTill inline (char '}')
432− spaces
433− updateState (\state -> state { stateDate = normalizeSpaces date' })
434− return Null
435−
436−--
437−-- item block
438−-- for use in unknown environments that aren't being parsed as raw latex
439−--
440−
441−-- this forces items to be parsed in different blocks
442−itemBlock :: GenParser Char ParserState Block
443−itemBlock = try $ do
444− ("item", _, args) <- command
445− state <- getState
446− if stateParserContext state == ListItemState
447− then fail "item should be handled by list block"
448− else if null args
449− then return Null
450− else return $ Plain [Str (stripFirstAndLast (head args))]
451−
452−--
453−-- raw LaTeX
454−--
455−
456−-- | Parse any LaTeX environment and return a Para block containing
457−-- the whole literal environment as raw TeX.
458−rawLaTeXEnvironment :: GenParser Char st Block
459−rawLaTeXEnvironment = do
460− contents <- rawLaTeXEnvironment'
461− spaces
462− return $ RawBlock "latex" contents
463−
464−-- | Parse any LaTeX environment and return a string containing
465−-- the whole literal environment as raw TeX.
466−rawLaTeXEnvironment' :: GenParser Char st String
467−rawLaTeXEnvironment' = try $ do
468− string "\\begin"
469− spaces
470− char '{'
471− name <- many1 letter
472− star <- option "" (string "*") -- for starred variants
473− let name' = name ++ star
474− char '}'
475− args <- option [] commandArgs
476− let argStr = concat args
477− contents <- manyTill (choice [ (many1 (noneOf "\\")),
478− rawLaTeXEnvironment',
479− string "\\" ])
480− (end name')
481− return $ "\\begin{" ++ name' ++ "}" ++ argStr ++
482− concat contents ++ "\\end{" ++ name' ++ "}"
483−
484−unknownEnvironment :: GenParser Char ParserState Block
485−unknownEnvironment = try $ do
486− state <- getState
487− result <- if stateParseRaw state -- check whether we should include raw TeX
488− then rawLaTeXEnvironment -- if so, get whole raw environment
489− else anyEnvironment -- otherwise just the contents
490− return result
491−
492−-- \ignore{} is used conventionally in literate haskell for definitions
493−-- that are to be processed by the compiler but not printed.
494−ignore :: GenParser Char ParserState Block
495−ignore = try $ do
496− ("ignore", _, _) <- command
497− spaces
498− return Null
499−
500−demacro :: (String, String, [String]) -> GenParser Char ParserState Inline
501−demacro (n,st,args) = try $ do
502− let raw = "\\" ++ n ++ st ++ concat args
503− s' <- applyMacros' raw
504− if raw == s'
505− then return $ RawInline "latex" raw
506− else do
507− inp <- getInput
508− setInput $ s' ++ inp
509− return $ Str ""
510−
511−unknownCommand :: GenParser Char ParserState Block
512−unknownCommand = try $ do
513− spaces
514− notFollowedBy' $ oneOfStrings ["\\begin","\\end","\\item"] >>
515− notFollowedBy letter
516− state <- getState
517− when (stateParserContext state == ListItemState) $
518− notFollowedBy' (string "\\item")
519− if stateParseRaw state
520− then command >>= demacro >>= return . Plain . (:[])
521− else do
522− (name, _, args) <- command
523− spaces
524− unless (name `elem` commandsToIgnore) $ do
525− -- put arguments back in input to be parsed
526− inp <- getInput
527− setInput $ intercalate " " args ++ inp
528− return Null
529−
530−commandsToIgnore :: [String]
531−commandsToIgnore = ["special","pdfannot","pdfstringdef", "index","bibliography"]
532−
533−skipChar :: GenParser Char ParserState Block
534−skipChar = do
535− satisfy (/='\\') <|>
536− (notFollowedBy' (try $
537− string "\\begin" >> spaces >> string "{document}") >>
538− anyChar)
539− spaces
540− return Null
541−
542−commentBlock :: GenParser Char st Block
543−commentBlock = many1 (comment >> spaces) >> return Null
544−
545−--
546−-- inline
547−--
548−
549−inline :: GenParser Char ParserState Inline
550−inline = choice [ str
551− , endline
552− , whitespace
553− , quoted
554− , apostrophe
555− , strong
556− , math
557− , ellipses
558− , emDash
559− , enDash
560− , hyphen
561− , emph
562− , strikeout
563− , superscript
564− , subscript
565− , code
566− , url
567− , link
568− , image
569− , footnote
570− , linebreak
571− , accentedChar
572− , nonbreakingSpace
573− , cite
574− , specialChar
575− , ensureMath
576− , rawLaTeXInline'
577− , escapedChar
578− , emptyGroup
579− , unescapedChar
580− , comment
581− ] <?> "inline"
582−
583−
584−-- latex comment
585−comment :: GenParser Char st Inline
586−comment = try $ char '%' >> manyTill anyChar newline >> spaces >> return (Str "")
587−
588−accentedChar :: GenParser Char st Inline
589−accentedChar = normalAccentedChar <|> specialAccentedChar
590−
591−normalAccentedChar :: GenParser Char st Inline
592−normalAccentedChar = try $ do
593− char '\\'
594− accent <- oneOf "'`^\"~"
595− character <- (try $ char '{' >> letter >>~ char '}') <|> letter
596− let table = fromMaybe [] $ lookup character accentTable
597− let result = case lookup accent table of
598− Just num -> chr num
599− Nothing -> '?'
600− return $ Str [result]
601−
602−-- an association list of letters and association list of accents
603−-- and decimal character numbers.
604−accentTable :: [(Char, [(Char, Int)])]
605−accentTable =
606− [ ('A', [('`', 192), ('\'', 193), ('^', 194), ('~', 195), ('"', 196)]),
607− ('E', [('`', 200), ('\'', 201), ('^', 202), ('"', 203)]),
608− ('I', [('`', 204), ('\'', 205), ('^', 206), ('"', 207)]),
609− ('N', [('~', 209)]),
610− ('O', [('`', 210), ('\'', 211), ('^', 212), ('~', 213), ('"', 214)]),
611− ('U', [('`', 217), ('\'', 218), ('^', 219), ('"', 220)]),
612− ('a', [('`', 224), ('\'', 225), ('^', 227), ('"', 228)]),
613− ('e', [('`', 232), ('\'', 233), ('^', 234), ('"', 235)]),
614− ('i', [('`', 236), ('\'', 237), ('^', 238), ('"', 239)]),
615− ('n', [('~', 241)]),
616− ('o', [('`', 242), ('\'', 243), ('^', 244), ('~', 245), ('"', 246)]),
617− ('u', [('`', 249), ('\'', 250), ('^', 251), ('"', 252)]) ]
618−
619−specialAccentedChar :: GenParser Char st Inline
620−specialAccentedChar = choice [ ccedil, aring, iuml, szlig, aelig, lslash,
621− oslash, pound, euro, copyright, sect ]
622−
623−ccedil :: GenParser Char st Inline
624−ccedil = try $ do
625− char '\\'
626− letter' <- oneOfStrings ["cc", "cC"]
627− notFollowedBy letter
628− let num = if letter' == "cc" then 231 else 199
629− return $ Str [chr num]
630−
631−aring :: GenParser Char st Inline
632−aring = try $ do
633− char '\\'
634− letter' <- oneOfStrings ["aa", "AA"]
635− notFollowedBy letter
636− let num = if letter' == "aa" then 229 else 197
637− return $ Str [chr num]
638−
639−iuml :: GenParser Char st Inline
640−iuml = try (string "\\\"") >> oneOfStrings ["\\i", "{\\i}"] >>
641− return (Str [chr 239])
642−
643−szlig :: GenParser Char st Inline
644−szlig = try (string "\\ss") >> notFollowedBy letter >> return (Str [chr 223])
645−
646−oslash :: GenParser Char st Inline
647−oslash = try $ do
648− char '\\'
649− letter' <- choice [char 'o', char 'O']
650− notFollowedBy letter
651− let num = if letter' == 'o' then 248 else 216
652− return $ Str [chr num]
653−
654−lslash :: GenParser Char st Inline
655−lslash = try $ do
656− cmd <- oneOfStrings ["{\\L}","{\\l}"]
657− <|> (oneOfStrings ["\\L ","\\l "] >>~ notFollowedBy letter)
658− return $ if 'l' `elem` cmd
659− then Str "\x142"
660− else Str "\x141"
661−
662−aelig :: GenParser Char st Inline
663−aelig = try $ do
664− char '\\'
665− letter' <- oneOfStrings ["ae", "AE"]
666− notFollowedBy letter
667− let num = if letter' == "ae" then 230 else 198
668− return $ Str [chr num]
669−
670−pound :: GenParser Char st Inline
671−pound = try (string "\\pounds" >> notFollowedBy letter) >> return (Str [chr 163])
672−
673−euro :: GenParser Char st Inline
674−euro = try (string "\\euro" >> notFollowedBy letter) >> return (Str [chr 8364])
675−
676−copyright :: GenParser Char st Inline
677−copyright = try (string "\\copyright" >> notFollowedBy letter) >> return (Str [chr 169])
678−
679−sect :: GenParser Char st Inline
680−sect = try (string "\\S" >> notFollowedBy letter) >> return (Str [chr 167])
681−
682−escapedChar :: GenParser Char st Inline
683−escapedChar = do
684− result <- escaped (oneOf specialChars)
685− return $ if result == '\n' then Str " " else Str [result]
791+parseTableHeader :: Int -- ^ number of columns
792+ -> LP [Blocks]
793+parseTableHeader cols = try $ parseTableRow cols <* hline
686794
687−emptyGroup :: GenParser Char st Inline
688−emptyGroup = try $ do
689− char '{'
795+simpTable :: LP Blocks
796+simpTable = try $ do
690797 spaces
691− char '}'
692− return $ Str ""
693−
694−-- nonescaped special characters
695−unescapedChar :: GenParser Char st Inline
696−unescapedChar = oneOf "`$^&_#{}[]|<>" >>= return . (\c -> Str [c])
697−
698−specialChar :: GenParser Char st Inline
699−specialChar = choice [ spacer, interwordSpace, sentenceEnd,
700− backslash, tilde, caret,
701− bar, lt, gt, doubleQuote ]
702−
703−spacer :: GenParser Char st Inline
704−spacer = try (string "\\,") >> return (Str "")
705−
706−sentenceEnd :: GenParser Char st Inline
707−sentenceEnd = try (string "\\@") >> return (Str "")
708−
709−interwordSpace :: GenParser Char st Inline
710−interwordSpace = try (string "\\ ") >> return (Str "\160")
711−
712−backslash :: GenParser Char st Inline
713−backslash = try (string "\\textbackslash") >> optional (try $ string "{}") >> return (Str "\\")
714−
715−tilde :: GenParser Char st Inline
716−tilde = try (string "\\ensuremath{\\sim}") >> return (Str "~")
717−
718−caret :: GenParser Char st Inline
719−caret = try (string "\\^{}") >> return (Str "^")
720−
721−bar :: GenParser Char st Inline
722−bar = try (string "\\textbar") >> optional (try $ string "{}") >> return (Str "\\")
723−
724−lt :: GenParser Char st Inline
725−lt = try (string "\\textless") >> optional (try $ string "{}") >> return (Str "<")
726−
727−gt :: GenParser Char st Inline
728−gt = try (string "\\textgreater") >> optional (try $ string "{}") >> return (Str ">")
729−
730−doubleQuote :: GenParser Char st Inline
731−doubleQuote = char '"' >> return (Str "\"")
732−
733−code :: GenParser Char ParserState Inline
734−code = code1 <|> code2 <|> code3 <|> lhsInlineCode
735−
736−code1 :: GenParser Char st Inline
737−code1 = try $ do
738− string "\\verb"
739− marker <- anyChar
740− result <- manyTill anyChar (char marker)
741− return $ Code nullAttr $ removeLeadingTrailingSpace result
742−
743−code2 :: GenParser Char st Inline
744−code2 = try $ do
745− string "\\texttt{"
746− result <- manyTill (noneOf "\\\n~$%^&{}") (char '}')
747− return $ Code nullAttr result
748−
749−code3 :: GenParser Char st Inline
750−code3 = try $ do
751− string "\\lstinline"
752− marker <- anyChar
753− result <- manyTill anyChar (char marker)
754− return $ Code nullAttr $ removeLeadingTrailingSpace result
755−
756−lhsInlineCode :: GenParser Char ParserState Inline
757−lhsInlineCode = try $ do
758− failUnlessLHS
759− char '|'
760− result <- manyTill (noneOf "|\n") (char '|')
761− return $ Code ("",["haskell"],[]) result
762−
763−emph :: GenParser Char ParserState Inline
764−emph = try $ oneOfStrings [ "\\emph{", "\\textit{" ] >>
765− manyTill inline (char '}') >>= return . Emph
766−
767−strikeout :: GenParser Char ParserState Inline
768−strikeout = try $ string "\\sout{" >> manyTill inline (char '}') >>=
769− return . Strikeout
770−
771−superscript :: GenParser Char ParserState Inline
772−superscript = try $ string "\\textsuperscript{" >>
773− manyTill inline (char '}') >>= return . Superscript
774−
775−-- note: \textsubscript isn't a standard latex command, but we use
776−-- a defined version in pandoc.
777−subscript :: GenParser Char ParserState Inline
778−subscript = try $ string "\\textsubscript{" >> manyTill inline (char '}') >>=
779− return . Subscript
780−
781−apostrophe :: GenParser Char ParserState Inline
782−apostrophe = char '\'' >> return (Str "\x2019")
783−
784−quoted :: GenParser Char ParserState Inline
785−quoted = doubleQuoted <|> singleQuoted
786−
787−singleQuoted :: GenParser Char ParserState Inline
788−singleQuoted = enclosed singleQuoteStart singleQuoteEnd inline >>=
789− return . Quoted SingleQuote . normalizeSpaces
790−
791−doubleQuoted :: GenParser Char ParserState Inline
792−doubleQuoted = enclosed doubleQuoteStart doubleQuoteEnd inline >>=
793− return . Quoted DoubleQuote . normalizeSpaces
794−
795−singleQuoteStart :: GenParser Char st Char
796−singleQuoteStart = char '`'
797−
798−singleQuoteEnd :: GenParser Char st ()
799−singleQuoteEnd = try $ char '\'' >> notFollowedBy alphaNum
800−
801−doubleQuoteStart :: CharParser st String
802−doubleQuoteStart = string "``"
803−
804−doubleQuoteEnd :: CharParser st String
805−doubleQuoteEnd = try $ string "''"
806−
807−ellipses :: GenParser Char st Inline
808−ellipses = try $ do
809− char '\\'
810− optional $ char 'l'
811− string "dots"
812− optional $ try $ string "{}"
813− return (Str "…")
814−
815−enDash :: GenParser Char st Inline
816−enDash = try (string "--") >> return (Str "-")
817−
818−emDash :: GenParser Char st Inline
819−emDash = try (string "---") >> return (Str "—")
820−
821−hyphen :: GenParser Char st Inline
822−hyphen = char '-' >> return (Str "-")
823−
824−strong :: GenParser Char ParserState Inline
825−strong = try (string "\\textbf{") >> manyTill inline (char '}') >>=
826− return . Strong
827−
828−whitespace :: GenParser Char st Inline
829−whitespace = many1 (oneOf " \t") >> return Space
830−
831−nonbreakingSpace :: GenParser Char st Inline
832−nonbreakingSpace = char '~' >> return (Str "\160")
833−
834−-- hard line break
835−linebreak :: GenParser Char st Inline
836−linebreak = try $ do
837− string "\\\\"
838− optional $ bracketedText '[' ']' -- e.g. \\[10pt]
798+ aligns <- parseAligns
799+ let cols = length aligns
800+ optional hline
801+ header' <- option [] $ parseTableHeader cols
802+ rows <- many (parseTableRow cols <* optional hline)
839803 spaces
840− return LineBreak
841−
842−str :: GenParser Char st Inline
843−str = many1 (noneOf specialChars) >>= return . Str
844−
845−-- endline internal to paragraph
846−endline :: GenParser Char st Inline
847−endline = try $ newline >> notFollowedBy blankline >> return Space
848−
849−-- math
850−math :: GenParser Char ParserState Inline
851−math = (math3 >>= applyMacros' >>= return . Math DisplayMath)
852− <|> (math1 >>= applyMacros' >>= return . Math InlineMath)
853− <|> (math2 >>= applyMacros' >>= return . Math InlineMath)
854− <|> (math4 >>= applyMacros' >>= return . Math DisplayMath)
855− <|> (math5 >>= applyMacros' >>= return . Math DisplayMath)
856− <|> (math6 >>= applyMacros' >>= return . Math DisplayMath)
857− <?> "math"
858−
859−math1 :: GenParser Char st String
860−math1 = try $ char '$' >> manyTill anyChar (char '$')
861−
862−math2 :: GenParser Char st String
863−math2 = try $ string "\\(" >> manyTill anyChar (try $ string "\\)")
864−
865−math3 :: GenParser Char st String
866−math3 = try $ char '$' >> math1 >>~ char '$'
867−
868−math4 :: GenParser Char st String
869−math4 = try $ do
870− name <- begin "displaymath" <|> begin "equation" <|> begin "equation*" <|>
871− begin "gather" <|> begin "gather*" <|> begin "gathered" <|>
872− begin "multline" <|> begin "multline*"
873− manyTill anyChar (end name)
874−
875−math5 :: GenParser Char st String
876−math5 = try $ (string "\\[") >> spaces >> manyTill anyChar (try $ string "\\]")
877−
878−math6 :: GenParser Char st String
879−math6 = try $ do
880− name <- begin "eqnarray" <|> begin "eqnarray*" <|> begin "align" <|>
881− begin "align*" <|> begin "alignat" <|> begin "alignat*" <|>
882− begin "split" <|> begin "aligned" <|> begin "alignedat"
883− res <- manyTill anyChar (end name)
884− return $ filter (/= '&') res -- remove alignment codes
885−
886−ensureMath :: GenParser Char st Inline
887−ensureMath = try $ do
888− (n, _, args) <- command
889− guard $ n == "ensuremath" && not (null args)
890− return $ Math InlineMath $ tail $ init $ head args
891−
892−--
893−-- links and images
894−--
895−
896−url :: GenParser Char ParserState Inline
897−url = try $ do
898− string "\\url"
899− url' <- charsInBalanced '{' '}' anyChar
900− return $ Link [Code ("",["url"],[]) url'] (escapeURI url', "")
901−
902−link :: GenParser Char ParserState Inline
903−link = try $ do
904− string "\\href{"
905− url' <- manyTill anyChar (char '}')
906− char '{'
907− label' <- manyTill inline (char '}')
908− return $ Link (normalizeSpaces label') (escapeURI url', "")
909−
910−image :: GenParser Char ParserState Inline
911−image = try $ do
912− ("includegraphics", _, args) <- command
913− let args' = filter isArg args -- filter out options
914− let (src,tit) = case args' of
915− [] -> ("", "")
916− (x:_) -> (stripFirstAndLast x, "")
917− return $ Image [Str "image"] (escapeURI src, tit)
918−
919−footnote :: GenParser Char ParserState Inline
920−footnote = try $ do
921− (name, _, (contents:[])) <- command
922− if ((name == "footnote") || (name == "thanks"))
923− then string ""
924− else fail "not a footnote or thanks command"
925− let contents' = stripFirstAndLast contents
926− -- parse the extracted block, which may contain various block elements:
927− rest <- getInput
928− setInput $ contents'
929− blocks <- parseBlocks
930− setInput rest
931− return $ Note blocks
932−
933−-- | citations
934−cite :: GenParser Char ParserState Inline
935−cite = simpleCite <|> complexNatbibCites
936−
937−simpleCiteArgs :: GenParser Char ParserState [Citation]
938−simpleCiteArgs = try $ do
939− first <- optionMaybe $ (char '[') >> manyTill inline (char ']')
940− second <- optionMaybe $ (char '[') >> manyTill inline (char ']')
941− char '{'
942− keys <- many1Till citationLabel (char '}')
943− let (pre, suf) = case (first , second ) of
944− (Just s , Nothing) -> ([], s )
945− (Just s , Just t ) -> (s , t )
946− _ -> ([], [])
947− conv k = Citation { citationId = k
948− , citationPrefix = []
949− , citationSuffix = []
950− , citationMode = NormalCitation
951− , citationHash = 0
952− , citationNoteNum = 0
953− }
954− return $ addPrefix pre $ addSuffix suf $ map conv keys
955−
956−
957−simpleCite :: GenParser Char ParserState Inline
958−simpleCite = try $ do
959− char '\\'
960− let biblatex = [a ++ "cite" | a <- ["auto", "foot", "paren", "super", ""]]
961− ++ ["footcitetext"]
962− normal = ["cite" ++ a ++ b | a <- ["al", ""], b <- ["p", "p*", ""]]
963− ++ biblatex
964− supress = ["citeyearpar", "citeyear", "autocite*", "cite*", "parencite*"]
965− intext = ["textcite"] ++ ["cite" ++ a ++ b | a <- ["al", ""], b <- ["t", "t*"]]
966− mintext = ["textcites"]
967− mnormal = map (++ "s") biblatex
968− cmdend = notFollowedBy (letter <|> char '*')
969− capit [] = []
970− capit (x:xs) = toUpper x : xs
971− addUpper xs = xs ++ map capit xs
972− toparser l t = try $ oneOfStrings (addUpper l) >> cmdend >> return t
973− (mode, multi) <- toparser normal (NormalCitation, False)
974− <|> toparser supress (SuppressAuthor, False)
975− <|> toparser intext (AuthorInText , False)
976− <|> toparser mnormal (NormalCitation, True )
977− <|> toparser mintext (AuthorInText , True )
978− cits <- if multi then
979− many1 simpleCiteArgs
980− else
981− simpleCiteArgs >>= \c -> return [c]
982− let (c:cs) = concat cits
983− cits' = case mode of
984− AuthorInText -> c {citationMode = mode} : cs
985− _ -> map (\a -> a {citationMode = mode}) (c:cs)
986− return $ Cite cits' []
987−
988−complexNatbibCites :: GenParser Char ParserState Inline
989−complexNatbibCites = complexNatbibTextual <|> complexNatbibParenthetical
990−
991−complexNatbibTextual :: GenParser Char ParserState Inline
992−complexNatbibTextual = try $ do
993− string "\\citeauthor{"
994− manyTill (noneOf "}") (char '}')
995− skipSpaces
996− Cite (c:cs) _ <- complexNatbibParenthetical
997− return $ Cite (c {citationMode = AuthorInText} : cs) []
998−
999−
1000−complexNatbibParenthetical :: GenParser Char ParserState Inline
1001−complexNatbibParenthetical = try $ do
1002− string "\\citetext{"
1003− cits <- many1Till parseOne (char '}')
1004− return $ Cite (concat cits) []
1005− where
1006− parseOne = do
1007− skipSpaces
1008− pref <- many (notFollowedBy (oneOf "\\}") >> inline)
1009− (Cite cites _) <- simpleCite
1010− suff <- many (notFollowedBy (oneOf "\\};") >> inline)
1011− skipSpaces
1012− optional $ char ';'
1013− return $ addPrefix pref $ addSuffix suff $ cites
1014−
1015−addPrefix :: [Inline] -> [Citation] -> [Citation]
1016−addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
1017−addPrefix _ _ = []
1018−
1019−addSuffix :: [Inline] -> [Citation] -> [Citation]
1020−addSuffix s ks@(_:_) = let k = last ks
1021− in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]
1022−addSuffix _ _ = []
1023−
1024−citationLabel :: GenParser Char ParserState String
1025−citationLabel = do
1026− res <- many1 $ noneOf ",}"
1027− optional $ char ','
1028− return $ removeLeadingTrailingSpace res
1029−
1030−-- | Parse any LaTeX inline command and return it in a raw TeX inline element.
1031−rawLaTeXInline' :: GenParser Char ParserState Inline
1032−rawLaTeXInline' = do
1033− notFollowedBy' $ oneOfStrings ["\\begin", "\\end", "\\item", "\\ignore",
1034− "\\section"]
1035− rawLaTeXInline
804+ let header'' = if null header'
805+ then replicate cols mempty
806+ else header'
807+ return $ table mempty (zip aligns (repeat 0)) header'' rows
1036808
1037−-- | Parse any LaTeX command and return it in a raw TeX inline element.
1038−rawLaTeXInline :: GenParser Char ParserState Inline
1039−rawLaTeXInline = try $ do
1040− state <- getState
1041− if stateParseRaw state
1042− then command >>= demacro
1043− else do
1044− (name,st,args) <- command
1045− x <- demacro (name,st,args)
1046− unless (x == Str "" || name `elem` commandsToIgnore) $ do
1047− inp <- getInput
1048− setInput $ intercalate " " args ++ inp
1049− return $ Str ""