{- Copyright (C) 2006-2010 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Readers.LaTeX Copyright : Copyright (C) 2006-2010 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha Portability : portable Conversion of LaTeX to 'Pandoc' document. -} module Text.Pandoc.Readers.LaTeX ( readLaTeX, rawLaTeXInline, rawLaTeXEnvironment' ) where import Text.ParserCombinators.Parsec import Text.Pandoc.Definition import Text.Pandoc.Shared import Data.Maybe ( fromMaybe ) import Data.Char ( chr ) import Data.List ( isPrefixOf, isSuffixOf ) import Control.Monad ( when ) -- | Parse LaTeX from string and return 'Pandoc' document. readLaTeX :: ParserState -- ^ Parser state, including options for parser -> String -- ^ String to parse (assumes @'\n'@ line endings) -> Pandoc readLaTeX = readWith parseLaTeX -- characters with special meaning specialChars :: [Char] specialChars = "\\`$%^&_~#{}\n \t|<>'\"-" -- -- utility functions -- -- | Returns text between brackets and its matching pair. bracketedText :: Char -> Char -> GenParser Char st [Char] bracketedText openB closeB = do result <- charsInBalanced' openB closeB return $ [openB] ++ result ++ [closeB] -- | Returns an option or argument of a LaTeX command. optOrArg :: GenParser Char st [Char] optOrArg = bracketedText '{' '}' <|> bracketedText '[' ']' -- | True if the string begins with '{'. isArg :: [Char] -> Bool isArg ('{':_) = True isArg _ = False -- | Returns list of options and arguments of a LaTeX command. commandArgs :: GenParser Char st [[Char]] commandArgs = many optOrArg -- | Parses LaTeX command, returns (name, star, list of options or arguments). command :: GenParser Char st ([Char], [Char], [[Char]]) command = do char '\\' name <- many1 letter star <- option "" (string "*") -- some commands have starred versions args <- commandArgs return (name, star, args) begin :: [Char] -> GenParser Char st [Char] begin name = try $ do string $ "\\begin{" ++ name ++ "}" optional commandArgs spaces return name end :: [Char] -> GenParser Char st [Char] end name = try $ do string $ "\\end{" ++ name ++ "}" return name -- | Returns a list of block elements containing the contents of an -- environment. environment :: [Char] -> GenParser Char ParserState [Block] environment name = try $ begin name >> spaces >> manyTill block (end name) >>~ spaces anyEnvironment :: GenParser Char ParserState Block anyEnvironment = try $ do string "\\begin{" name <- many letter star <- option "" (string "*") -- some environments have starred variants char '}' optional commandArgs spaces contents <- manyTill block (end (name ++ star)) spaces return $ BlockQuote contents -- -- parsing documents -- -- | Process LaTeX preamble, extracting metadata. processLaTeXPreamble :: GenParser Char ParserState () processLaTeXPreamble = try $ manyTill (choice [bibliographic, comment, unknownCommand, nullBlock]) (try (string "\\begin{document}")) >> spaces -- | Parse LaTeX and return 'Pandoc'. parseLaTeX :: GenParser Char ParserState Pandoc parseLaTeX = do optional processLaTeXPreamble -- preamble might not be present (fragment) spaces blocks <- parseBlocks spaces optional $ try (string "\\end{document}" >> many anyChar) -- might not be present (fragment) spaces eof state <- getState let blocks' = filter (/= Null) blocks let title' = stateTitle state let authors' = stateAuthors state let date' = stateDate state return $ Pandoc (Meta title' authors' date') blocks' -- -- parsing blocks -- parseBlocks :: GenParser Char ParserState [Block] parseBlocks = spaces >> many block block :: GenParser Char ParserState Block block = choice [ hrule , codeBlock , header , list , blockQuote , comment , bibliographic , para , itemBlock , unknownEnvironment , ignore , unknownCommand ] "block" -- -- header blocks -- header :: GenParser Char ParserState Block header = try $ do char '\\' subs <- many (try (string "sub")) base <- try (string "section" >> return 1) <|> (string "paragraph" >> return 4) optional (char '*') optional $ bracketedText '[' ']' -- alt title char '{' title' <- manyTill inline (char '}') spaces return $ Header (length subs + base) (normalizeSpaces title') -- -- hrule block -- hrule :: GenParser Char st Block hrule = oneOfStrings [ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n", "\\newpage" ] >> spaces >> return HorizontalRule -- -- code blocks -- codeBlock :: GenParser Char ParserState Block codeBlock = codeBlockWith "verbatim" <|> codeBlockWith "Verbatim" <|> lhsCodeBlock -- Note: Verbatim is from fancyvrb. codeBlockWith :: String -> GenParser Char st Block codeBlockWith env = try $ do string ("\\begin{" ++ env ++ "}") -- don't use begin function because it -- gobbles whitespace optional blanklines -- we want to gobble blank lines, but not -- leading space contents <- manyTill anyChar (try (string $ "\\end{" ++ env ++ "}")) spaces let classes = if env == "code" then ["haskell"] else [] return $ CodeBlock ("",classes,[]) (stripTrailingNewlines contents) lhsCodeBlock :: GenParser Char ParserState Block lhsCodeBlock = do failUnlessLHS (CodeBlock (_,_,_) cont) <- codeBlockWith "code" return $ CodeBlock ("", ["sourceCode","literate","haskell"], []) cont -- -- block quotes -- blockQuote :: GenParser Char ParserState Block blockQuote = (environment "quote" <|> environment "quotation") >>~ spaces >>= return . BlockQuote -- -- list blocks -- list :: GenParser Char ParserState Block list = bulletList <|> orderedList <|> definitionList "list" listItem :: GenParser Char ParserState ([Inline], [Block]) listItem = try $ do ("item", _, args) <- command spaces state <- getState let oldParserContext = stateParserContext state updateState (\s -> s {stateParserContext = ListItemState}) blocks <- many block updateState (\s -> s {stateParserContext = oldParserContext}) opt <- case args of ([x]) | "[" `isPrefixOf` x && "]" `isSuffixOf` x -> parseFromString (many inline) $ tail $ init x _ -> return [] return (opt, blocks) orderedList :: GenParser Char ParserState Block 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 (oneOf "iv") 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 :: GenParser Char ParserState Block bulletList = try $ do begin "itemize" spaces items <- many listItem end "itemize" spaces return (BulletList $ map snd items) definitionList :: GenParser Char ParserState Block definitionList = try $ do begin "description" spaces items <- many listItem end "description" spaces return $ DefinitionList $ map (\(t,d) -> (t,[d])) items -- -- paragraph block -- para :: GenParser Char ParserState Block para = do res <- many1 inline spaces return $ if null (filter (`notElem` [Str "", Space]) res) then Null else Para $ normalizeSpaces res -- -- title authors date -- bibliographic :: GenParser Char ParserState Block bibliographic = choice [ maketitle, title, authors, date ] maketitle :: GenParser Char st Block maketitle = try (string "\\maketitle") >> spaces >> return Null title :: GenParser Char ParserState Block title = try $ do string "\\title{" tit <- manyTill inline (char '}') spaces updateState (\state -> state { stateTitle = tit }) return Null authors :: GenParser Char ParserState Block authors = try $ do string "\\author{" raw <- many1 (notFollowedBy (char '}') >> inline) let authors' = map normalizeSpaces $ splitBy LineBreak raw char '}' spaces updateState (\s -> s { stateAuthors = authors' }) return Null date :: GenParser Char ParserState Block date = try $ do string "\\date{" date' <- manyTill inline (char '}') spaces updateState (\state -> state { stateDate = normalizeSpaces date' }) return Null -- -- item block -- for use in unknown environments that aren't being parsed as raw latex -- -- this forces items to be parsed in different blocks itemBlock :: GenParser Char ParserState Block 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))] -- -- raw LaTeX -- -- | Parse any LaTeX environment and return a Para block containing -- the whole literal environment as raw TeX. rawLaTeXEnvironment :: GenParser Char st Block rawLaTeXEnvironment = do contents <- rawLaTeXEnvironment' spaces return $ Para [TeX contents] -- | Parse any LaTeX environment and return a string containing -- the whole literal environment as raw TeX. rawLaTeXEnvironment' :: GenParser Char st String rawLaTeXEnvironment' = try $ do string "\\begin{" name <- many1 letter star <- option "" (string "*") -- for starred variants let name' = name ++ star char '}' args <- option [] commandArgs let argStr = concat args contents <- manyTill (choice [ (many1 (noneOf "\\")), rawLaTeXEnvironment', string "\\" ]) (end name') return $ "\\begin{" ++ name' ++ "}" ++ argStr ++ concat contents ++ "\\end{" ++ name' ++ "}" unknownEnvironment :: GenParser Char ParserState Block 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 -- \ignore{} is used conventionally in literate haskell for definitions -- that are to be processed by the compiler but not printed. ignore :: GenParser Char ParserState Block ignore = try $ do ("ignore", _, _) <- command spaces return Null unknownCommand :: GenParser Char ParserState Block unknownCommand = try $ do notFollowedBy' $ choice $ map end ["itemize", "enumerate", "description", "document"] state <- getState when (stateParserContext state == ListItemState) $ notFollowedBy' (string "\\item") if stateParseRaw state then do (name, star, args) <- command spaces return $ Plain [TeX ("\\" ++ name ++ star ++ concat args)] else do (name, _, args) <- command spaces if name `elem` commandsToIgnore then return Null else return $ Plain [Str $ concat args] commandsToIgnore :: [String] commandsToIgnore = ["special","pdfannot","pdfstringdef"] -- latex comment comment :: GenParser Char st Block comment = try $ char '%' >> manyTill anyChar newline >> spaces >> return Null -- -- inline -- inline :: GenParser Char ParserState Inline inline = choice [ str , endline , whitespace , quoted , apostrophe , strong , math , ellipses , emDash , enDash , hyphen , emph , strikeout , superscript , subscript , ref , lab , code , url , link , image , footnote , linebreak , accentedChar , nonbreakingSpace , specialChar , rawLaTeXInline , escapedChar , unescapedChar ] "inline" accentedChar :: GenParser Char st Inline accentedChar = normalAccentedChar <|> specialAccentedChar normalAccentedChar :: GenParser Char st Inline normalAccentedChar = try $ do char '\\' accent <- oneOf "'`^\"~" character <- (try $ char '{' >> letter >>~ char '}') <|> letter let table = fromMaybe [] $ lookup character accentTable let result = case lookup accent table of Just num -> chr num Nothing -> '?' return $ Str [result] -- an association list of letters and association list of accents -- and decimal character numbers. accentTable :: [(Char, [(Char, Int)])] accentTable = [ ('A', [('`', 192), ('\'', 193), ('^', 194), ('~', 195), ('"', 196)]), ('E', [('`', 200), ('\'', 201), ('^', 202), ('"', 203)]), ('I', [('`', 204), ('\'', 205), ('^', 206), ('"', 207)]), ('N', [('~', 209)]), ('O', [('`', 210), ('\'', 211), ('^', 212), ('~', 213), ('"', 214)]), ('U', [('`', 217), ('\'', 218), ('^', 219), ('"', 220)]), ('a', [('`', 224), ('\'', 225), ('^', 227), ('"', 228)]), ('e', [('`', 232), ('\'', 233), ('^', 234), ('"', 235)]), ('i', [('`', 236), ('\'', 237), ('^', 238), ('"', 239)]), ('n', [('~', 241)]), ('o', [('`', 242), ('\'', 243), ('^', 244), ('~', 245), ('"', 246)]), ('u', [('`', 249), ('\'', 250), ('^', 251), ('"', 252)]) ] specialAccentedChar :: GenParser Char st Inline specialAccentedChar = choice [ ccedil, aring, iuml, szlig, aelig, oslash, pound, euro, copyright, sect ] ccedil :: GenParser Char st Inline ccedil = try $ do char '\\' letter' <- oneOfStrings ["cc", "cC"] let num = if letter' == "cc" then 231 else 199 return $ Str [chr num] aring :: GenParser Char st Inline aring = try $ do char '\\' letter' <- oneOfStrings ["aa", "AA"] let num = if letter' == "aa" then 229 else 197 return $ Str [chr num] iuml :: GenParser Char st Inline iuml = try (string "\\\"") >> oneOfStrings ["\\i", "{\\i}"] >> return (Str [chr 239]) szlig :: GenParser Char st Inline szlig = try (string "\\ss") >> return (Str [chr 223]) oslash :: GenParser Char st Inline oslash = try $ do char '\\' letter' <- choice [char 'o', char 'O'] let num = if letter' == 'o' then 248 else 216 return $ Str [chr num] aelig :: GenParser Char st Inline aelig = try $ do char '\\' letter' <- oneOfStrings ["ae", "AE"] let num = if letter' == "ae" then 230 else 198 return $ Str [chr num] pound :: GenParser Char st Inline pound = try (string "\\pounds") >> return (Str [chr 163]) euro :: GenParser Char st Inline euro = try (string "\\euro") >> return (Str [chr 8364]) copyright :: GenParser Char st Inline copyright = try (string "\\copyright") >> return (Str [chr 169]) sect :: GenParser Char st Inline sect = try (string "\\S") >> return (Str [chr 167]) escapedChar :: GenParser Char st Inline escapedChar = do result <- escaped (oneOf specialChars) return $ if result == Str "\n" then Str " " else result -- nonescaped special characters unescapedChar :: GenParser Char st Inline unescapedChar = oneOf "`$^&_#{}|<>" >>= return . (\c -> Str [c]) specialChar :: GenParser Char st Inline specialChar = choice [ spacer, interwordSpace, backslash, tilde, caret, bar, lt, gt, doubleQuote ] spacer :: GenParser Char st Inline spacer = try (string "\\,") >> return (Str "") interwordSpace :: GenParser Char st Inline interwordSpace = try (string "\\ ") >> return (Str "\160") backslash :: GenParser Char st Inline backslash = try (string "\\textbackslash") >> optional (try $ string "{}") >> return (Str "\\") tilde :: GenParser Char st Inline tilde = try (string "\\ensuremath{\\sim}") >> return (Str "~") caret :: GenParser Char st Inline caret = try (string "\\^{}") >> return (Str "^") bar :: GenParser Char st Inline bar = try (string "\\textbar") >> optional (try $ string "{}") >> return (Str "\\") lt :: GenParser Char st Inline lt = try (string "\\textless") >> optional (try $ string "{}") >> return (Str "<") gt :: GenParser Char st Inline gt = try (string "\\textgreater") >> optional (try $ string "{}") >> return (Str ">") doubleQuote :: GenParser Char st Inline doubleQuote = char '"' >> return (Str "\"") code :: GenParser Char ParserState Inline code = code1 <|> code2 <|> lhsInlineCode code1 :: GenParser Char st Inline code1 = try $ do string "\\verb" marker <- anyChar result <- manyTill anyChar (char marker) return $ Code $ removeLeadingTrailingSpace result code2 :: GenParser Char st Inline code2 = try $ do string "\\texttt{" result <- manyTill (noneOf "\\\n~$%^&{}") (char '}') return $ Code result lhsInlineCode :: GenParser Char ParserState Inline lhsInlineCode = try $ do failUnlessLHS char '|' result <- manyTill (noneOf "|\n") (char '|') return $ Code result emph :: GenParser Char ParserState Inline emph = try $ oneOfStrings [ "\\emph{", "\\textit{" ] >> manyTill inline (char '}') >>= return . Emph strikeout :: GenParser Char ParserState Inline strikeout = try $ string "\\sout{" >> manyTill inline (char '}') >>= return . Strikeout superscript :: GenParser Char ParserState Inline 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 :: GenParser Char ParserState Inline subscript = try $ string "\\textsubscript{" >> manyTill inline (char '}') >>= return . Subscript apostrophe :: GenParser Char ParserState Inline apostrophe = char '\'' >> return Apostrophe quoted :: GenParser Char ParserState Inline quoted = doubleQuoted <|> singleQuoted singleQuoted :: GenParser Char ParserState Inline singleQuoted = enclosed singleQuoteStart singleQuoteEnd inline >>= return . Quoted SingleQuote . normalizeSpaces doubleQuoted :: GenParser Char ParserState Inline doubleQuoted = enclosed doubleQuoteStart doubleQuoteEnd inline >>= return . Quoted DoubleQuote . normalizeSpaces singleQuoteStart :: GenParser Char st Char singleQuoteStart = char '`' singleQuoteEnd :: GenParser Char st () singleQuoteEnd = try $ char '\'' >> notFollowedBy alphaNum doubleQuoteStart :: CharParser st String doubleQuoteStart = string "``" doubleQuoteEnd :: CharParser st String doubleQuoteEnd = try $ string "''" ellipses :: GenParser Char st Inline ellipses = try $ string "\\ldots" >> optional (try $ string "{}") >> return Ellipses enDash :: GenParser Char st Inline enDash = try (string "--") >> return EnDash emDash :: GenParser Char st Inline emDash = try (string "---") >> return EmDash hyphen :: GenParser Char st Inline hyphen = char '-' >> return (Str "-") lab :: GenParser Char st Inline lab = try $ do string "\\label{" result <- manyTill anyChar (char '}') return $ Str $ "(" ++ result ++ ")" ref :: GenParser Char st Inline ref = try (string "\\ref{") >> manyTill anyChar (char '}') >>= return . Str strong :: GenParser Char ParserState Inline strong = try (string "\\textbf{") >> manyTill inline (char '}') >>= return . Strong whitespace :: GenParser Char st Inline whitespace = many1 (oneOf " \t") >> return Space nonbreakingSpace :: GenParser Char st Inline nonbreakingSpace = char '~' >> return (Str "\160") -- hard line break linebreak :: GenParser Char st Inline linebreak = try (string "\\\\") >> return LineBreak str :: GenParser Char st Inline str = many1 (noneOf specialChars) >>= return . Str -- endline internal to paragraph endline :: GenParser Char st Inline endline = try $ newline >> notFollowedBy blankline >> return Space -- math math :: GenParser Char st Inline math = (math3 >>= return . Math DisplayMath) <|> (math1 >>= return . Math InlineMath) <|> (math2 >>= return . Math InlineMath) <|> (math4 >>= return . Math DisplayMath) <|> (math5 >>= return . Math DisplayMath) <|> (math6 >>= return . Math DisplayMath) "math" math1 :: GenParser Char st String math1 = try $ char '$' >> manyTill anyChar (char '$') math2 :: GenParser Char st String math2 = try $ string "\\(" >> manyTill anyChar (try $ string "\\)") math3 :: GenParser Char st String math3 = try $ char '$' >> math1 >>~ char '$' math4 :: GenParser Char st String math4 = try $ do name <- begin "displaymath" <|> begin "equation" <|> begin "equation*" <|> begin "gather" <|> begin "gather*" <|> begin "gathered" <|> begin "multline" <|> begin "multline*" spaces manyTill anyChar (end name) math5 :: GenParser Char st String math5 = try $ (string "\\[") >> spaces >> manyTill anyChar (try $ string "\\]") math6 :: GenParser Char st String math6 = try $ do name <- begin "eqnarray" <|> begin "eqnarray*" <|> begin "align" <|> begin "align*" <|> begin "alignat" <|> begin "alignat*" <|> begin "split" <|> begin "aligned" <|> begin "alignedat" spaces res <- manyTill anyChar (end name) return $ filter (/= '&') res -- remove alignment codes -- -- links and images -- url :: GenParser Char ParserState Inline url = try $ do string "\\url" url' <- charsInBalanced '{' '}' return $ Link [Code url'] (escapeURI url', "") link :: GenParser Char ParserState Inline link = try $ do string "\\href{" url' <- manyTill anyChar (char '}') char '{' label' <- manyTill inline (char '}') return $ Link (normalizeSpaces label') (escapeURI url', "") image :: GenParser Char ParserState Inline image = try $ do ("includegraphics", _, args) <- command let args' = filter isArg args -- filter out options let (src,tit) = case args' of [] -> ("", "") (x:_) -> (stripFirstAndLast x, "") return $ Image [Str "image"] (escapeURI src, tit) footnote :: GenParser Char ParserState Inline footnote = try $ do (name, _, (contents:[])) <- command if ((name == "footnote") || (name == "thanks")) then string "" else fail "not a footnote or thanks command" let contents' = stripFirstAndLast contents -- parse the extracted block, which may contain various block elements: rest <- getInput setInput $ contents' blocks <- parseBlocks setInput rest return $ Note blocks -- | Parse any LaTeX command and return it in a raw TeX inline element. rawLaTeXInline :: GenParser Char ParserState Inline rawLaTeXInline = try $ do notFollowedBy' $ oneOfStrings ["\\begin", "\\end", "\\item", "\\ignore", "\\section"] state <- getState if stateParseRaw state then do (name, star, args) <- command return $ TeX ("\\" ++ name ++ star ++ concat args) else do (name, _, args) <- command spaces if name `elem` commandsToIgnore then return $ Str "" else return $ Str (concat args)