diff options
Diffstat (limited to 'src/Text/Pandoc/Readers/LaTeX.hs')
-rw-r--r-- | src/Text/Pandoc/Readers/LaTeX.hs | 536 |
1 files changed, 231 insertions, 305 deletions
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 73a3e4a8f..4b91b528c 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -34,7 +34,6 @@ module Text.Pandoc.Readers.LaTeX ( ) where import Text.ParserCombinators.Parsec -import Text.Pandoc.ParserCombinators import Text.Pandoc.Definition import Text.Pandoc.Shared import Data.Maybe ( fromMaybe ) @@ -47,9 +46,6 @@ readLaTeX :: ParserState -- ^ Parser state, including options for parser -> Pandoc readLaTeX = readWith parseLaTeX --- for testing -testString = testStringWith parseLaTeX - -- characters with special meaning specialChars = "\\$%&^&_~#{}\n \t|<>'\"-" @@ -58,12 +54,12 @@ specialChars = "\\$%&^&_~#{}\n \t|<>'\"-" -- -- | Returns text between brackets and its matching pair. -bracketedText openB closeB = try (do +bracketedText openB closeB = do result <- charsInBalanced' openB closeB - return ([openB] ++ result ++ [closeB])) + return $ [openB] ++ result ++ [closeB] -- | Returns an option or argument of a LaTeX command. -optOrArg = choice [ (bracketedText '{' '}'), (bracketedText '[' ']') ] +optOrArg = bracketedText '{' '}' <|> bracketedText '[' ']' -- | True if the string begins with '{'. isArg ('{':rest) = True @@ -73,62 +69,55 @@ isArg other = False commandArgs = many optOrArg -- | Parses LaTeX command, returns (name, star, list of options or arguments). -command = try (do +command = try $ do char '\\' name <- many1 alphaNum star <- option "" (string "*") -- some commands have starred versions args <- commandArgs - return (name, star, args)) + return (name, star, args) -begin name = try (do - string "\\begin{" - string name - char '}' - option [] commandArgs +begin name = try $ do + string $ "\\begin{" ++ name ++ "}" + optional commandArgs spaces - return name) + return name -end name = try (do - string "\\end{" - string name - char '}' +end name = try $ do + string $ "\\end{" ++ name ++ "}" spaces - return name) + return name -- | Returns a list of block elements containing the contents of an -- environment. -environment name = try (do - begin name - spaces - contents <- manyTill block (end name) - return contents) +environment name = try $ begin name >> spaces >> manyTill block (end name) -anyEnvironment = try (do +anyEnvironment = try $ do string "\\begin{" name <- many alphaNum star <- option "" (string "*") -- some environments have starred variants char '}' - option [] commandArgs + optional commandArgs spaces contents <- manyTill block (end (name ++ star)) - return (BlockQuote contents)) + return $ BlockQuote contents -- -- parsing documents -- -- | Process LaTeX preamble, extracting metadata. -processLaTeXPreamble = try (do - manyTill (choice [bibliographic, comment, unknownCommand, nullBlock]) - (try (string "\\begin{document}")) - spaces) +processLaTeXPreamble = try $ manyTill + (choice [bibliographic, comment, unknownCommand, nullBlock]) + (try (string "\\begin{document}")) >> + spaces -- | Parse LaTeX and return 'Pandoc'. parseLaTeX = do - option () processLaTeXPreamble -- preamble might not be present (fragment) + optional processLaTeXPreamble -- preamble might not be present (fragment) + spaces blocks <- parseBlocks spaces - option "" (try (string "\\end{document}")) -- might not be present (in fragment) + optional $ try (string "\\end{document}") -- might not be present (fragment) spaces eof state <- getState @@ -136,21 +125,27 @@ parseLaTeX = do let title' = stateTitle state let authors' = stateAuthors state let date' = stateDate state - return (Pandoc (Meta title' authors' date') blocks') + return $ Pandoc (Meta title' authors' date') blocks' -- -- parsing blocks -- -parseBlocks = do - spaces - result <- many block - return result - -block = choice [ hrule, codeBlock, header, list, blockQuote, mathBlock, - comment, bibliographic, para, specialEnvironment, - itemBlock, unknownEnvironment, unknownCommand ] <?> - "block" +parseBlocks = spaces >> many block + +block = choice [ hrule + , codeBlock + , header + , list + , blockQuote + , mathBlock + , comment + , bibliographic + , para + , specialEnvironment + , itemBlock + , unknownEnvironment + , unknownCommand ] <?> "block" -- -- header blocks @@ -158,24 +153,21 @@ block = choice [ hrule, codeBlock, header, list, blockQuote, mathBlock, header = choice (map headerLevel (enumFromTo 1 5)) <?> "header" -headerLevel n = try (do +headerLevel n = try $ do let subs = concat $ replicate (n - 1) "sub" string ("\\" ++ subs ++ "section") - option ' ' (char '*') + optional (char '*') char '{' title <- manyTill inline (char '}') spaces - return (Header n (normalizeSpaces title))) + return $ Header n (normalizeSpaces title) -- -- hrule block -- -hrule = try (do - oneOfStrings [ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n", - "\\newpage" ] - spaces - return HorizontalRule) +hrule = oneOfStrings [ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n", + "\\newpage" ] >> spaces >> return HorizontalRule -- -- code blocks @@ -183,37 +175,28 @@ hrule = try (do codeBlock = codeBlock1 <|> codeBlock2 -codeBlock1 = try (do +codeBlock1 = try $ do string "\\begin{verbatim}" -- don't use begin function because it -- gobbles whitespace - option "" blanklines -- we want to gobble blank lines, but not + optional blanklines -- we want to gobble blank lines, but not -- leading space contents <- manyTill anyChar (try (string "\\end{verbatim}")) spaces - return (CodeBlock (stripTrailingNewlines contents))) + return $ CodeBlock (stripTrailingNewlines contents) -codeBlock2 = try (do - string "\\begin{Verbatim}" -- used by fancyverb package +codeBlock2 = try $ do + string "\\begin{Verbatim}" -- used by fancyvrb package option "" blanklines contents <- manyTill anyChar (try (string "\\end{Verbatim}")) spaces - return (CodeBlock (stripTrailingNewlines contents))) + return $ CodeBlock (stripTrailingNewlines contents) -- -- block quotes -- -blockQuote = choice [ blockQuote1, blockQuote2 ] <?> "blockquote" - -blockQuote1 = try (do - blocks <- environment "quote" - spaces - return (BlockQuote blocks)) - -blockQuote2 = try (do - blocks <- environment "quotation" - spaces - return (BlockQuote blocks)) +blockQuote = (environment "quote" <|> environment "quotation") >>~ spaces >>= + return . BlockQuote -- -- math block @@ -223,12 +206,12 @@ mathBlock = mathBlockWith (begin "equation") (end "equation") <|> mathBlockWith (begin "displaymath") (end "displaymath") <|> mathBlockWith (string "\\[") (string "\\]") <?> "math block" -mathBlockWith start end = try (do +mathBlockWith start end = try $ do start spaces result <- manyTill anyChar end spaces - return (BlockQuote [Para [TeX ("$" ++ result ++ "$")]])) + return $ BlockQuote [Para [TeX ("$" ++ result ++ "$")]] -- -- list blocks @@ -237,69 +220,66 @@ mathBlockWith start end = try (do list = bulletList <|> orderedList <|> definitionList <?> "list" listItem = try $ do - ("item", _, args) <- command - spaces - state <- getState - let oldParserContext = stateParserContext state - updateState (\state -> state {stateParserContext = ListItemState}) - blocks <- many block - updateState (\state -> state {stateParserContext = oldParserContext}) - opt <- case args of - ([x]) | "[" `isPrefixOf` x && "]" `isSuffixOf` x -> - parseFromString (many inline) $ tail $ init x - _ -> return [] - return (opt, blocks) + ("item", _, args) <- command + spaces + state <- getState + let oldParserContext = stateParserContext state + updateState (\state -> state {stateParserContext = ListItemState}) + blocks <- many block + updateState (\state -> state {stateParserContext = oldParserContext}) + opt <- case args of + ([x]) | "[" `isPrefixOf` x && "]" `isSuffixOf` x -> + parseFromString (many inline) $ tail $ init x + _ -> return [] + return (opt, blocks) orderedList = try $ do - string "\\begin{enumerate}" - (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $ - try $ do failIfStrict - char '[' - res <- anyOrderedListMarker - char ']' - return res - spaces - option "" $ try $ do string "\\setlength{\\itemindent}" - char '{' - manyTill anyChar (char '}') - spaces - start <- option 1 $ try $ do failIfStrict - string "\\setcounter{enum" - many1 (char 'i') - string "}{" - num <- many1 digit - char '}' - spaces - return $ (read num) + 1 - items <- many listItem - end "enumerate" - spaces - return $ OrderedList (start, style, delim) $ map snd items + string "\\begin{enumerate}" + (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $ + try $ do failIfStrict + char '[' + res <- anyOrderedListMarker + char ']' + return res + spaces + option "" $ try $ do string "\\setlength{\\itemindent}" + char '{' + manyTill anyChar (char '}') + spaces + start <- option 1 $ try $ do failIfStrict + string "\\setcounter{enum" + many1 (char 'i') + string "}{" + num <- many1 digit + char '}' + spaces + return $ (read num) + 1 + items <- many listItem + end "enumerate" + spaces + return $ OrderedList (start, style, delim) $ map snd items bulletList = try $ do - begin "itemize" - spaces - items <- many listItem - end "itemize" - spaces - return (BulletList $ map snd items) + begin "itemize" + spaces + items <- many listItem + end "itemize" + spaces + return (BulletList $ map snd items) definitionList = try $ do - begin "description" - spaces - items <- many listItem - end "description" - spaces - return (DefinitionList items) + begin "description" + spaces + items <- many listItem + end "description" + spaces + return (DefinitionList items) -- -- paragraph block -- -para = try (do - result <- many1 inline - spaces - return (Para (normalizeSpaces result))) +para = many1 inline >>~ spaces >>= return . Para . normalizeSpaces -- -- title authors date @@ -307,33 +287,30 @@ para = try (do bibliographic = choice [ maketitle, title, authors, date ] -maketitle = try (do - string "\\maketitle" - spaces - return Null) +maketitle = try (string "\\maketitle") >> spaces >> return Null -title = try (do +title = try $ do string "\\title{" tit <- manyTill inline (char '}') spaces updateState (\state -> state { stateTitle = tit }) - return Null) + return Null -authors = try (do +authors = try $ do string "\\author{" authors <- manyTill anyChar (char '}') spaces let authors' = map removeLeadingTrailingSpace $ lines $ substitute "\\\\" "\n" authors updateState (\state -> state { stateAuthors = authors' }) - return Null) + return Null -date = try (do +date = try $ do string "\\date{" date' <- manyTill anyChar (char '}') spaces updateState (\state -> state { stateDate = date' }) - return Null) + return Null -- -- item block @@ -341,14 +318,14 @@ date = try (do -- -- this forces items to be parsed in different blocks -itemBlock = try (do +itemBlock = try $ do ("item", _, args) <- command state <- getState if (stateParserContext state == ListItemState) then fail "item should be handled by list block" else if null args then return Null - else return (Plain [Str (stripFirstAndLast (head args))])) + else return $ Plain [Str (stripFirstAndLast (head args))] -- -- raw LaTeX @@ -362,77 +339,93 @@ specialEnvironment = do -- these are always parsed as raw -- | Parse any LaTeX environment and return a Para block containing -- the whole literal environment as raw TeX. rawLaTeXEnvironment :: GenParser Char st Block -rawLaTeXEnvironment = try (do - string "\\begin" - char '{' +rawLaTeXEnvironment = try $ do + string "\\begin{" name <- many1 alphaNum star <- option "" (string "*") -- for starred variants let name' = name ++ star char '}' args <- option [] commandArgs let argStr = concat args - contents <- manyTill (choice [(many1 (noneOf "\\")), + contents <- manyTill (choice [ (many1 (noneOf "\\")), (do (Para [TeX str]) <- rawLaTeXEnvironment return str), string "\\" ]) (end name') spaces - return (Para [TeX ("\\begin{" ++ name' ++ "}" ++ argStr ++ - (concat contents) ++ "\\end{" ++ name' ++ "}")])) + return $ Para [TeX $ "\\begin{" ++ name' ++ "}" ++ argStr ++ + concat contents ++ "\\end{" ++ name' ++ "}"] -unknownEnvironment = try (do +unknownEnvironment = try $ do state <- getState result <- if stateParseRaw state -- check whether we should include raw TeX then rawLaTeXEnvironment -- if so, get whole raw environment else anyEnvironment -- otherwise just the contents - return result) + return result -unknownCommand = try (do - notFollowedBy' $ choice $ map end - ["itemize", "enumerate", "description", "document"] +unknownCommand = try $ do + notFollowedBy' $ choice $ map end ["itemize", "enumerate", "description", + "document"] (name, star, args) <- command spaces let argStr = concat args state <- getState - if (name == "item") && ((stateParserContext state) == ListItemState) + if name == "item" && (stateParserContext state) == ListItemState then fail "should not be parsed as raw" else string "" if stateParseRaw state - then return (Plain [TeX ("\\" ++ name ++ star ++ argStr)]) - else return (Plain [Str (joinWithSep " " args)])) + then return $ Plain [TeX ("\\" ++ name ++ star ++ argStr)] + else return $ Plain [Str (joinWithSep " " args)] -- latex comment -comment = try (do - char '%' - result <- manyTill anyChar newline - spaces - return Null) +comment = try $ char '%' >> manyTill anyChar newline >> spaces >> return Null -- -- inline -- -inline = choice [ strong, emph, strikeout, superscript, subscript, - ref, lab, code, linebreak, spacer, - math, ellipses, emDash, enDash, hyphen, quoted, apostrophe, - accentedChar, specialChar, specialInline, escapedChar, - unescapedChar, str, endline, whitespace ] <?> "inline" - -specialInline = choice [ url, link, image, footnote, rawLaTeXInline ] - <?> "link, raw TeX, note, or image" +inline = choice [ strong + , emph + , strikeout + , superscript + , subscript + , ref + , lab + , code + , linebreak + , spacer + , math + , ellipses + , emDash + , enDash + , hyphen + , quoted + , apostrophe + , accentedChar + , specialChar + , url + , link + , image + , footnote + , rawLaTeXInline + , escapedChar + , unescapedChar + , str + , endline + , whitespace ] <?> "inline" accentedChar = normalAccentedChar <|> specialAccentedChar -normalAccentedChar = try (do +normalAccentedChar = try $ do char '\\' accent <- oneOf "'`^\"~" - character <- choice [ between (char '{') (char '}') anyChar, anyChar ] + character <- (try $ char '{' >> alphaNum >>~ char '}') <|> alphaNum let table = fromMaybe [] $ lookup character accentTable let result = case lookup accent table of Just num -> chr num Nothing -> '?' - return (Str [result])) + return $ Str [result] -- an association list of letters and association list of accents -- and decimal character numbers. @@ -451,245 +444,179 @@ accentTable = ('u', [('`', 249), ('\'', 250), ('^', 251), ('"', 252)]) ] specialAccentedChar = choice [ ccedil, aring, iuml, szlig, aelig, - oslash, pound, euro, copyright, sect ] + oslash, pound, euro, copyright, sect ] -ccedil = try (do +ccedil = try $ do char '\\' letter <- oneOfStrings ["cc", "cC"] let num = if letter == "cc" then 231 else 199 - return (Str [chr num])) + return $ Str [chr num] -aring = try (do +aring = try $ do char '\\' letter <- oneOfStrings ["aa", "AA"] let num = if letter == "aa" then 229 else 197 - return (Str [chr num])) + return $ Str [chr num] -iuml = try (do - string "\\\"" - oneOfStrings ["\\i", "{\\i}"] - return (Str [chr 239])) +iuml = try (string "\\\"") >> oneOfStrings ["\\i", "{\\i}"] >> + return (Str [chr 239]) -icirc = try (do - string "\\^" - oneOfStrings ["\\i", "{\\i}"] - return (Str [chr 238])) +icirc = try (string "\\^") >> oneOfStrings ["\\i", "{\\i}"] >> + return (Str [chr 238]) -szlig = try (do - string "\\ss" - return (Str [chr 223])) +szlig = try (string "\\ss") >> return (Str [chr 223]) -oslash = try (do +oslash = try $ do char '\\' letter <- choice [char 'o', char 'O'] let num = if letter == 'o' then 248 else 216 - return (Str [chr num])) + return $ Str [chr num] -aelig = try (do +aelig = try $ do char '\\' letter <- oneOfStrings ["ae", "AE"] let num = if letter == "ae" then 230 else 198 - return (Str [chr num])) + return $ Str [chr num] -pound = try (do - string "\\pounds" - return (Str [chr 163])) +pound = try (string "\\pounds") >> return (Str [chr 163]) -euro = try (do - string "\\euro" - return (Str [chr 8364])) +euro = try (string "\\euro") >> return (Str [chr 8364]) -copyright = try (do - string "\\copyright" - return (Str [chr 169])) +copyright = try (string "\\copyright") >> return (Str [chr 169]) -sect = try (do - string "\\S" - return (Str [chr 167])) +sect = try (string "\\S") >> return (Str [chr 167]) escapedChar = do result <- escaped (oneOf " $%&_#{}\n") - return (if result == Str "\n" then Str " " else result) + return $ if result == Str "\n" then Str " " else result -unescapedChar = do -- ignore standalone, nonescaped special characters - oneOf "$^&_#{}|<>" - return (Str "") +-- ignore standalone, nonescaped special characters +unescapedChar = oneOf "$^&_#{}|<>" >> return (Str "") specialChar = choice [ backslash, tilde, caret, bar, lt, gt ] -backslash = try (do - string "\\textbackslash" - return (Str "\\")) +backslash = try (string "\\textbackslash") >> return (Str "\\") -tilde = try (do - string "\\ensuremath{\\sim}" - return (Str "~")) +tilde = try (string "\\ensuremath{\\sim}") >> return (Str "~") -caret = try (do - string "\\^{}" - return (Str "^")) +caret = try (string "\\^{}") >> return (Str "^") -bar = try (do - string "\\textbar" - return (Str "\\")) +bar = try (string "\\textbar") >> return (Str "\\") -lt = try (do - string "\\textless" - return (Str "<")) +lt = try (string "\\textless") >> return (Str "<") -gt = try (do - string "\\textgreater" - return (Str ">")) +gt = try (string "\\textgreater") >> return (Str ">") -code = try (do +code = try $ do string "\\verb" marker <- anyChar result <- manyTill anyChar (char marker) - let result' = removeLeadingTrailingSpace result - return (Code result')) + return $ Code $ removeLeadingTrailingSpace result -emph = try (do - oneOfStrings [ "\\emph{", "\\textit{" ] - result <- manyTill inline (char '}') - return (Emph result)) +emph = try $ oneOfStrings [ "\\emph{", "\\textit{" ] >> + manyTill inline (char '}') >>= return . Emph -strikeout = try $ do - string "\\sout{" - result <- manyTill inline (char '}') - return (Strikeout result) +strikeout = try $ string "\\sout{" >> manyTill inline (char '}') >>= + return . Strikeout -superscript = try $ do - string "\\textsuperscript{" - result <- manyTill inline (char '}') - return (Superscript result) +superscript = try $ string "\\textsuperscript{" >> + manyTill inline (char '}') >>= return . Superscript -- note: \textsubscript isn't a standard latex command, but we use -- a defined version in pandoc. -subscript = try $ do - string "\\textsubscript{" - result <- manyTill inline (char '}') - return (Subscript result) +subscript = try $ string "\\textsubscript{" >> manyTill inline (char '}') >>= + return . Subscript -apostrophe = do - char '\'' - return Apostrophe +apostrophe = char '\'' >> return Apostrophe -quoted = do - doubleQuoted <|> singleQuoted +quoted = doubleQuoted <|> singleQuoted -singleQuoted = try (do - result <- enclosed singleQuoteStart singleQuoteEnd inline - return $ Quoted SingleQuote $ normalizeSpaces result) +singleQuoted = enclosed singleQuoteStart singleQuoteEnd inline >>= + return . Quoted SingleQuote . normalizeSpaces -doubleQuoted = try (do - result <- enclosed doubleQuoteStart doubleQuoteEnd inline - return $ Quoted DoubleQuote $ normalizeSpaces result) +doubleQuoted = enclosed doubleQuoteStart doubleQuoteEnd inline >>= + return . Quoted DoubleQuote . normalizeSpaces singleQuoteStart = char '`' -singleQuoteEnd = char '\'' >> notFollowedBy alphaNum +singleQuoteEnd = try $ char '\'' >> notFollowedBy alphaNum doubleQuoteStart = string "``" doubleQuoteEnd = string "''" -ellipses = try (do - string "\\ldots" - option "" (try (string "{}")) - return Ellipses) +ellipses = try $ string "\\ldots" >> optional (try (string "{}")) >> + return Ellipses -enDash = try (do - string "--" - notFollowedBy (char '-') - return EnDash) +enDash = try (string "--") >> return EnDash -emDash = try (do - string "---" - return EmDash) +emDash = try (string "---") >> return EmDash -hyphen = do - char '-' - return (Str "-") +hyphen = char '-' >> return (Str "-") -lab = try (do +lab = try $ do string "\\label{" result <- manyTill anyChar (char '}') - return (Str ("(" ++ result ++ ")"))) + return $ Str $ "(" ++ result ++ ")" -ref = try (do - string "\\ref{" - result <- manyTill anyChar (char '}') - return (Str (result))) +ref = try (string "\\ref{") >> manyTill anyChar (char '}') >>= return . Str -strong = try (do - string "\\textbf{" - result <- manyTill inline (char '}') - return (Strong result)) +strong = try (string "\\textbf{") >> manyTill inline (char '}') >>= + return . Strong -whitespace = do - many1 (oneOf "~ \t") - return Space +whitespace = many1 (oneOf "~ \t") >> return Space -- hard line break -linebreak = try (do - string "\\\\" - return LineBreak) +linebreak = try (string "\\\\") >> return LineBreak -spacer = try $ do - string "\\," - return (Str "") +spacer = try (string "\\,") >> return (Str "") -str = do - result <- many1 (noneOf specialChars) - return (Str result) +str = many1 (noneOf specialChars) >>= return . Str -- endline internal to paragraph -endline = try (do - newline - notFollowedBy blankline - return Space) +endline = try $ newline >> notFollowedBy blankline >> return Space -- math math = math1 <|> math2 <?> "math" -math1 = try (do +math1 = try $ do char '$' result <- many (noneOf "$") char '$' - return (TeX ("$" ++ result ++ "$"))) + return $ TeX ("$" ++ result ++ "$") -math2 = try (do +math2 = try $ do string "\\(" result <- many (noneOf "$") string "\\)" - return (TeX ("$" ++ result ++ "$"))) + return $ TeX ("$" ++ result ++ "$") -- -- links and images -- -url = try (do +url = try $ do string "\\url" url <- charsInBalanced '{' '}' - return (Link [Code url] (url, ""))) + return $ Link [Code url] (url, "") -link = try (do +link = try $ do string "\\href{" url <- manyTill anyChar (char '}') char '{' label <- manyTill inline (char '}') - return (Link (normalizeSpaces label) (url, ""))) + return $ Link (normalizeSpaces label) (url, "") -image = try (do +image = try $ do ("includegraphics", _, args) <- command let args' = filter isArg args -- filter out options let src = if null args' then ("", "") else (stripFirstAndLast (head args'), "") - return (Image [Str "image"] src)) + return $ Image [Str "image"] src -footnote = try (do +footnote = try $ do (name, _, (contents:[])) <- command if ((name == "footnote") || (name == "thanks")) then string "" @@ -700,16 +627,15 @@ footnote = try (do setInput $ contents' blocks <- parseBlocks setInput rest - return (Note blocks)) + return $ Note blocks -- | Parse any LaTeX command and return it in a raw TeX inline element. rawLaTeXInline :: GenParser Char ParserState Inline -rawLaTeXInline = try (do +rawLaTeXInline = try $ do (name, star, args) <- command - let argStr = concat args state <- getState if ((name == "begin") || (name == "end") || (name == "item")) then fail "not an inline command" else string "" - return (TeX ("\\" ++ name ++ star ++ argStr))) + return $ TeX ("\\" ++ name ++ star ++ concat args) |