diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Readers/LaTeX.hs | 174 |
1 files changed, 82 insertions, 92 deletions
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 2886e2f29..08aa0b20e 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -42,20 +42,18 @@ import Text.Pandoc.Options import Text.Pandoc.Parsing hiding ((<|>), many, optional, space, mathDisplay, mathInline) import qualified Text.Pandoc.UTF8 as UTF8 -import Data.Char ( chr, ord ) +import Data.Char ( chr, ord, isLetter, isAlphaNum ) import Control.Monad.Trans (lift) import Control.Monad import Text.Pandoc.Builder -import Data.Char (isLetter, isAlphaNum) import Control.Applicative import Data.Monoid -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, maybeToList) import System.Environment (getEnv) -import System.FilePath (replaceExtension, (</>)) -import Data.List (intercalate, intersperse) +import System.FilePath (replaceExtension, (</>), takeExtension, addExtension) +import Data.List (intercalate) import qualified Data.Map as M import qualified Control.Exception as E -import System.FilePath (takeExtension, addExtension) import Text.Pandoc.Highlighting (fromListingsLanguage) import Text.Pandoc.Error @@ -74,17 +72,16 @@ parseLaTeX = do let (Pandoc _ bs') = doc bs return $ Pandoc meta bs' -type LP = Parser [Char] ParserState +type LP = Parser String ParserState anyControlSeq :: LP String anyControlSeq = do char '\\' next <- option '\n' anyChar - name <- case next of - '\n' -> return "" - c | isLetter c -> (c:) <$> (many letter <* optional sp) - | otherwise -> return [c] - return name + case next of + '\n' -> return "" + c | isLetter c -> (c:) <$> (many letter <* optional sp) + | otherwise -> return [c] controlSeq :: String -> LP String controlSeq name = try $ do @@ -104,7 +101,7 @@ dimenarg = try $ do sp :: LP () sp = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t') - <|> (try $ newline <* lookAhead anyChar <* notFollowedBy blankline) + <|> try (newline <* lookAhead anyChar <* notFollowedBy blankline) isLowerHex :: Char -> Bool isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f' @@ -162,30 +159,28 @@ mathInline :: LP String -> LP Inlines mathInline p = math <$> (try p >>= applyMacros') mathChars :: LP String -mathChars = concat <$> - many ( many1 (satisfy (\c -> c /= '$' && c /='\\')) - <|> (\c -> ['\\',c]) <$> (try $ char '\\' *> anyChar) - ) +mathChars = (concat <$>) $ + many $ + many1 (satisfy (\c -> c /= '$' && c /='\\')) + <|> (\c -> ['\\',c]) <$> try (char '\\' *> anyChar) quoted' :: (Inlines -> Inlines) -> LP String -> LP () -> LP Inlines quoted' f starter ender = do startchs <- starter try ((f . mconcat) <$> manyTill inline ender) <|> lit startchs -double_quote :: LP Inlines -double_quote = - ( quoted' doubleQuoted (try $ string "``") (void $ try $ string "''") +doubleQuote :: LP Inlines +doubleQuote = + quoted' doubleQuoted (try $ string "``") (void $ try $ string "''") <|> quoted' doubleQuoted (string "“") (void $ char '”') -- the following is used by babel for localized quotes: <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'") <|> quoted' doubleQuoted (string "\"") (void $ char '"') - ) -single_quote :: LP Inlines -single_quote = - ( quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter) +singleQuote :: LP Inlines +singleQuote = + quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter) <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter) - ) inline :: LP Inlines inline = (mempty <$ comment) @@ -195,17 +190,17 @@ inline = (mempty <$ comment) <|> inlineEnvironment <|> inlineGroup <|> (char '-' *> option (str "-") - ((char '-') *> option (str "–") (str "—" <$ char '-'))) - <|> double_quote - <|> single_quote + (char '-' *> option (str "–") (str "—" <$ char '-'))) + <|> doubleQuote + <|> singleQuote <|> (str "”" <$ try (string "''")) <|> (str "”" <$ char '”') <|> (str "’" <$ char '\'') <|> (str "’" <$ char '’') <|> (str "\160" <$ char '~') - <|> (mathDisplay $ string "$$" *> mathChars <* string "$$") - <|> (mathInline $ char '$' *> mathChars <* char '$') - <|> (superscript <$> (char '^' *> tok)) + <|> mathDisplay (string "$$" *> mathChars <* string "$$") + <|> mathInline (char '$' *> mathChars <* char '$') + <|> try (superscript <$> (char '^' *> tok)) <|> (subscript <$> (char '_' *> tok)) <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb) <|> (str . (:[]) <$> tildeEscape) @@ -244,6 +239,11 @@ getRawCommand name' = do rawargs <- withRaw (skipopts *> option "" dimenarg *> many braced) return $ '\\' : name' ++ snd rawargs +lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v +lookupListDefault d = (fromMaybe d .) . lookupList + where + lookupList l m = msum $ map (`M.lookup` m) l + blockCommand :: LP Blocks blockCommand = try $ do name <- anyControlSeq @@ -256,14 +256,10 @@ blockCommand = try $ do guard $ transformed /= rawcommand notFollowedBy $ parseFromString inlines transformed parseFromString blocks transformed - case M.lookup name' blockCommands of - Just p -> p - Nothing -> case M.lookup name blockCommands of - Just p -> p - Nothing -> raw + lookupListDefault raw [name',name] blockCommands inBrackets :: Inlines -> Inlines -inBrackets x = (str "[") <> x <> (str "]") +inBrackets x = str "[" <> x <> str "]" -- eat an optional argument and one or more arguments in braces ignoreInlines :: String -> (String, LP Inlines) @@ -271,14 +267,14 @@ ignoreInlines name = (name, doraw <|> (mempty <$ optargs)) where optargs = skipopts *> skipMany (try $ optional sp *> braced) contseq = '\\':name doraw = (rawInline "latex" . (contseq ++) . snd) <$> - (getOption readerParseRaw >>= guard >> (withRaw optargs)) + (getOption readerParseRaw >>= guard >> withRaw optargs) ignoreBlocks :: String -> (String, LP Blocks) ignoreBlocks name = (name, doraw <|> (mempty <$ optargs)) where optargs = skipopts *> skipMany (try $ optional sp *> braced) contseq = '\\':name doraw = (rawBlock "latex" . (contseq ++) . snd) <$> - (getOption readerParseRaw >>= guard >> (withRaw optargs)) + (getOption readerParseRaw >>= guard >> withRaw optargs) blockCommands :: M.Map String (LP Blocks) blockCommands = M.fromList $ @@ -316,7 +312,7 @@ blockCommands = M.fromList $ -- , ("hrule", pure horizontalRule) , ("rule", skipopts *> tok *> tok *> pure horizontalRule) - , ("item", skipopts *> loose_item) + , ("item", skipopts *> looseItem) , ("documentclass", skipopts *> braced *> preamble) , ("centerline", (para . trimInlines) <$> (skipopts *> tok)) , ("caption", skipopts *> setCaption) @@ -403,17 +399,14 @@ inlineCommand = try $ do else if parseRaw then return $ rawInline "latex" rawcommand else return mempty - case M.lookup name' inlineCommands of - Just p -> p <|> raw - Nothing -> case M.lookup name inlineCommands of - Just p -> p <|> raw - Nothing -> raw + lookupListDefault mzero [name',name] inlineCommands + <|> raw unlessParseRaw :: LP () unlessParseRaw = getOption readerParseRaw >>= guard . not isBlockCommand :: String -> Bool -isBlockCommand s = maybe False (const True) $ M.lookup s blockCommands +isBlockCommand s = s `M.member` blockCommands inlineEnvironments :: M.Map String (LP Inlines) @@ -459,7 +452,7 @@ inlineCommands = M.fromList $ , ("cref", unlessParseRaw >> (inBrackets <$> tok)) -- from cleveref.sty , ("(", mathInline $ manyTill anyChar (try $ string "\\)")) , ("[", mathDisplay $ manyTill anyChar (try $ string "\\]")) - , ("ensuremath", mathInline $ braced) + , ("ensuremath", mathInline braced) , ("texorpdfstring", (\_ x -> x) <$> tok <*> tok) , ("P", lit "¶") , ("S", lit "§") @@ -631,7 +624,7 @@ lit = pure . str accent :: (Char -> String) -> Inlines -> LP Inlines accent f ils = case toList ils of - (Str (x:xs) : ys) -> return $ fromList $ (Str (f x ++ xs) : ys) + (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys) [] -> mzero _ -> return ils @@ -820,7 +813,7 @@ breve 'u' = "ŭ" breve c = [c] tok :: LP Inlines -tok = try $ grouped inline <|> inlineCommand <|> str <$> (count 1 $ inlineChar) +tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar opt :: LP Inlines opt = bracketed inline <* optional sp @@ -838,17 +831,14 @@ environment :: LP Blocks environment = do controlSeq "begin" name <- braced - case M.lookup name environments of - Just p -> p <|> rawEnv name - Nothing -> rawEnv name + M.findWithDefault mzero name environments + <|> rawEnv name inlineEnvironment :: LP Inlines inlineEnvironment = try $ do controlSeq "begin" name <- braced - case M.lookup name inlineEnvironments of - Just p -> p - Nothing -> mzero + M.findWithDefault mzero name inlineEnvironments rawEnv :: String -> LP Blocks rawEnv name = do @@ -861,7 +851,7 @@ rawEnv name = do ---- -type IncludeParser = ParserT [Char] [String] IO String +type IncludeParser = ParserT String [String] IO String -- | Replace "include" commands with file contents. handleIncludes :: String -> IO (Either PandocError String) @@ -921,7 +911,7 @@ include' = do <|> try (string "input") <|> string "usepackage" -- skip options - skipMany $ try $ char '[' *> (manyTill anyChar (char ']')) + skipMany $ try $ char '[' *> manyTill anyChar (char ']') fs <- (map trim . splitBy (==',')) <$> braced' return $ if name == "usepackage" then map (maybeAddExtension ".sty") fs @@ -994,14 +984,14 @@ keyvals = try $ char '[' *> manyTill keyval (char ']') alltt :: String -> LP Blocks alltt t = walk strToCode <$> parseFromString blocks (substitute " " "\\ " $ substitute "%" "\\%" $ - concat $ intersperse "\\\\\n" $ lines t) + intercalate "\\\\\n" $ lines t) where strToCode (Str s) = Code nullAttr s strToCode x = x -rawLaTeXBlock :: Parser [Char] ParserState String +rawLaTeXBlock :: LP String rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand)) -rawLaTeXInline :: Parser [Char] ParserState Inline +rawLaTeXInline :: LP Inline rawLaTeXInline = do raw <- (snd <$> withRaw inlineCommand) <|> (snd <$> withRaw blockCommand) RawInline "latex" <$> applyMacros' raw @@ -1010,24 +1000,24 @@ addImageCaption :: Blocks -> LP Blocks addImageCaption = walkM go where go (Image alt (src,tit)) = do mbcapt <- stateCaption <$> getState - case mbcapt of - Just ils -> return (Image (toList ils) (src, "fig:")) - Nothing -> return (Image alt (src,tit)) + return $ case mbcapt of + Just ils -> Image (toList ils) (src, "fig:") + Nothing -> Image alt (src,tit) go x = return x addTableCaption :: Blocks -> LP Blocks addTableCaption = walkM go where go (Table c als ws hs rs) = do mbcapt <- stateCaption <$> getState - case mbcapt of - Just ils -> return (Table (toList ils) als ws hs rs) - Nothing -> return (Table c als ws hs rs) + return $ case mbcapt of + Just ils -> Table (toList ils) als ws hs rs + Nothing -> Table c als ws hs rs go x = return x environments :: M.Map String (LP Blocks) environments = M.fromList [ ("document", env "document" blocks <* skipMany anyChar) - , ("letter", env "letter" letter_contents) + , ("letter", env "letter" letterContents) , ("figure", env "figure" $ resetCaption *> skipopts *> blocks >>= addImageCaption) , ("center", env "center" blocks) @@ -1040,12 +1030,12 @@ environments = M.fromList , ("verse", blockQuote <$> env "verse" blocks) , ("itemize", bulletList <$> listenv "itemize" (many item)) , ("description", definitionList <$> listenv "description" (many descItem)) - , ("enumerate", ordered_list) + , ("enumerate", orderedList') , ("alltt", alltt =<< verbEnv "alltt") , ("code", guardEnabled Ext_literate_haskell *> (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$> verbEnv "code")) - , ("verbatim", codeBlock <$> (verbEnv "verbatim")) + , ("verbatim", codeBlock <$> verbEnv "verbatim") , ("Verbatim", do options <- option [] keyvals let kvs = [ (if k == "firstnumber" then "startFrom" @@ -1053,17 +1043,17 @@ environments = M.fromList let classes = [ "numberLines" | lookup "numbers" options == Just "left" ] let attr = ("",classes,kvs) - codeBlockWith attr <$> (verbEnv "Verbatim")) + codeBlockWith attr <$> verbEnv "Verbatim") , ("lstlisting", do options <- option [] keyvals let kvs = [ (if k == "firstnumber" then "startFrom" else k, v) | (k,v) <- options ] let classes = [ "numberLines" | lookup "numbers" options == Just "left" ] - ++ maybe [] (:[]) (lookup "language" options + ++ maybeToList (lookup "language" options >>= fromListingsLanguage) let attr = (fromMaybe "" (lookup "label" options),classes,kvs) - codeBlockWith attr <$> (verbEnv "lstlisting")) + codeBlockWith attr <$> verbEnv "lstlisting") , ("minted", do options <- option [] keyvals lang <- grouped (many1 $ satisfy (/='}')) let kvs = [ (if k == "firstnumber" @@ -1073,7 +1063,7 @@ environments = M.fromList [ "numberLines" | lookup "linenos" options == Just "true" ] let attr = ("",classes,kvs) - codeBlockWith attr <$> (verbEnv "minted")) + codeBlockWith attr <$> verbEnv "minted") , ("obeylines", parseFromString (para . trimInlines . mconcat <$> many inline) =<< intercalate "\\\\\n" . lines <$> verbEnv "obeylines") @@ -1092,8 +1082,8 @@ environments = M.fromList , ("alignat*", mathEnv para (Just "aligned") "alignat*") ] -letter_contents :: LP Blocks -letter_contents = do +letterContents :: LP Blocks +letterContents = do bs <- blocks st <- getState -- add signature (author) and address (title) @@ -1120,8 +1110,8 @@ closing = do item :: LP Blocks item = blocks *> controlSeq "item" *> skipopts *> blocks -loose_item :: LP Blocks -loose_item = do +looseItem :: LP Blocks +looseItem = do ctx <- stateParserContext `fmap` getState if ctx == ListItemState then mzero @@ -1164,8 +1154,8 @@ verbEnv name = do res <- manyTill anyChar endEnv return $ stripTrailingNewlines res -ordered_list :: LP Blocks -ordered_list = do +orderedList' :: LP Blocks +orderedList' = do optional sp (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $ try $ char '[' *> anyOrderedListMarker <* char ']' @@ -1177,7 +1167,7 @@ ordered_list = do optional sp num <- grouped (many1 digit) spaces - return $ (read num + 1 :: Int) + return (read num + 1 :: Int) bs <- listenv "enumerate" (many item) return $ orderedListWith (start, style, delim) bs @@ -1191,14 +1181,14 @@ paragraph = do preamble :: LP Blocks preamble = mempty <$> manyTill preambleBlock beginDoc where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}" - preambleBlock = (void comment) - <|> (void sp) - <|> (void blanklines) - <|> (void macro) - <|> (void blockCommand) - <|> (void anyControlSeq) - <|> (void braced) - <|> (void anyChar) + preambleBlock = void comment + <|> void sp + <|> void blanklines + <|> void macro + <|> void blockCommand + <|> void anyControlSeq + <|> void braced + <|> void anyChar ------- @@ -1274,7 +1264,7 @@ complexNatbibCitation mode = try $ do suff <- ils skipSpaces optional $ char ';' - return $ addPrefix pref $ addSuffix suff $ cits' + return $ addPrefix pref $ addSuffix suff cits' (c:cits, raw) <- withRaw $ grouped parseOne return $ cite (c{ citationMode = mode }:cits) (rawInline "latex" $ "\\citetext" ++ raw) @@ -1298,13 +1288,13 @@ parseAligns = try $ do return aligns' hline :: LP () -hline = () <$ (try $ spaces' *> controlSeq "hline" <* spaces') +hline = () <$ try (spaces' *> controlSeq "hline" <* spaces') lbreak :: LP () -lbreak = () <$ (try $ spaces' *> controlSeq "\\" <* spaces') +lbreak = () <$ try (spaces' *> controlSeq "\\" <* spaces') amp :: LP () -amp = () <$ (try $ spaces' *> char '&') +amp = () <$ try (spaces' *> char '&') parseTableRow :: Int -- ^ number of columns -> LP [Blocks] |