git.iko.soy/typeable/pandoc
on master help sign in
LaTeX reader: Better error messages with include files.

Closes #1274. Rewrote handleIncludes. We now report the actual source file and position where the error occurs, even if it is included. We do this by inserting special commands, `\PandocStartInclude` and `\PandocEndInclude`, that encode this information in the preprocessing phase. Also generalized the types of a couple functions from `Text.Pandoc.Parsing`.

commit743dac493fab08abdec59feb7bd57030a3ba5c90 authorJohn MacFarlane <jgm@berkeley.edu> dateSat 3 May 2014, 15:15 (12 years ago) parent4c43824
2 files changed+118−56
src/Text/Pandoc/Parsing.hs+1−1 src/Text/Pandoc/Readers/LaTeX.hs+117−55
src/Text/Pandoc/Parsing.hs+1−1
@@ -504,7 +504,7 @@ withHorizDisplacement parser = do
504504
505505-- | Applies a parser and returns the raw string that was parsed,
506506-- along with the value produced by the parser.
507−withRaw :: Parser [Char] st a -> Parser [Char] st (a, [Char])
507+withRaw :: Monad m => ParsecT [Char] st m a -> ParsecT [Char] st m (a, [Char])
508508withRaw parser = do
509509 pos1 <- getPosition
510510 inp <- getInput
src/Text/Pandoc/Readers/LaTeX.hs+117−55
@@ -40,8 +40,10 @@ import Text.Pandoc.Shared
4040import Text.Pandoc.Options
4141import Text.Pandoc.Parsing hiding ((<|>), many, optional, space,
4242 mathDisplay, mathInline)
43+import Text.Parsec.Prim (ParsecT, runParserT)
4344import qualified Text.Pandoc.UTF8 as UTF8
4445import Data.Char ( chr, ord )
46+import Control.Monad.Trans (lift)
4547import Control.Monad
4648import Text.Pandoc.Builder
4749import Data.Char (isLetter, isAlphaNum)
@@ -303,6 +305,8 @@ blockCommands = M.fromList $
303305 , ("documentclass", skipopts *> braced *> preamble)
304306 , ("centerline", (para . trimInlines) <$> (skipopts *> tok))
305307 , ("caption", tok >>= setCaption)
308+ , ("PandocStartInclude", startInclude)
309+ , ("PandocEndInclude", endInclude)
306310 ] ++ map ignoreBlocks
307311 -- these commands will be ignored unless --parse-raw is specified,
308312 -- in which case they will appear as raw latex blocks
@@ -794,31 +798,107 @@ rawEnv name = do
794798 (withRaw (env name blocks) >>= applyMacros' . snd)
795799 else env name blocks
796800
801+----
802+
803+type IncludeParser = ParsecT [Char] [String] IO String
804+
797805-- | Replace "include" commands with file contents.
798806handleIncludes :: String -> IO String
799−handleIncludes = handleIncludes' []
800−
801−-- parents parameter prevents infinite include loops
802−handleIncludes' :: [FilePath] -> String -> IO String
803−handleIncludes' _ [] = return []
804−handleIncludes' parents ('\\':'%':xs) =
805− ("\\%"++) `fmap` handleIncludes' parents xs
806−handleIncludes' parents ('%':xs) = handleIncludes' parents
807− $ drop 1 $ dropWhile (/='\n') xs
808−handleIncludes' parents ('\\':xs) =
809− case runParser include defaultParserState "input" ('\\':xs) of
810− Right (fs, rest) -> do yss <- mapM (\f -> if f `elem` parents
811− then "" <$ warn ("Include file loop in '"
812− ++ f ++ "'.")
813− else readTeXFile f >>=
814− handleIncludes' (f:parents)) fs
815− rest' <- handleIncludes' parents rest
816− return $ intercalate "\n" yss ++ rest'
817− _ -> case runParser (verbCmd <|> verbatimEnv) defaultParserState
818− "input" ('\\':xs) of
819− Right (r, rest) -> (r ++) `fmap` handleIncludes' parents rest
820− _ -> ('\\':) `fmap` handleIncludes' parents xs
821−handleIncludes' parents (x:xs) = (x:) `fmap` handleIncludes' parents xs
807+handleIncludes s = do
808+ res <- runParserT includeParser' [] "input" s
809+ case res of
810+ Right s' -> return s'
811+ Left e -> error $ show e
812+
813+includeParser' :: IncludeParser
814+includeParser' =
815+ concat <$> many (comment' <|> escaped' <|> blob' <|> include'
816+ <|> startMarker' <|> endMarker'
817+ <|> verbCmd' <|> verbatimEnv' <|> backslash')
818+
819+comment' :: IncludeParser
820+comment' = do
821+ char '%'
822+ xs <- manyTill anyChar newline
823+ return ('%':xs ++ "\n")
824+
825+escaped' :: IncludeParser
826+escaped' = try $ string "\\%" <|> string "\\\\"
827+
828+verbCmd' :: IncludeParser
829+verbCmd' = fmap snd <$>
830+ withRaw $ try $ do
831+ string "\\verb"
832+ c <- anyChar
833+ manyTill anyChar (char c)
834+
835+verbatimEnv' :: IncludeParser
836+verbatimEnv' = fmap snd <$>
837+ withRaw $ try $ do
838+ string "\\begin"
839+ name <- braced'
840+ guard $ name `elem` ["verbatim", "Verbatim", "lstlisting",
841+ "minted", "alltt"]
842+ manyTill anyChar (try $ string $ "\\end{" ++ name ++ "}")
843+
844+blob' :: IncludeParser
845+blob' = try $ many1 (noneOf "\\%")
846+
847+backslash' :: IncludeParser
848+backslash' = string "\\"
849+
850+braced' :: IncludeParser
851+braced' = try $ char '{' *> manyTill (satisfy (/='}')) (char '}')
852+
853+include' :: IncludeParser
854+include' = do
855+ name <- try $ do
856+ char '\\'
857+ try (string "include")
858+ <|> try (string "input")
859+ <|> string "usepackage"
860+ -- skip options
861+ skipMany $ try $ char '[' *> (manyTill anyChar (char ']'))
862+ fs <- (map trim . splitBy (==',')) <$> braced'
863+ pos <- getPosition
864+ let fs' = if name == "usepackage"
865+ then map (flip replaceExtension ".sty") fs
866+ else map (flip replaceExtension ".tex") fs
867+ containers <- getState
868+ let fn = case containers of
869+ (f':_) -> f'
870+ [] -> "input"
871+ -- now process each include file in order...
872+ rest <- getInput
873+ results' <- forM fs' (\f -> do
874+ when (f `elem` containers) $
875+ fail "Include file loop!"
876+ contents <- lift $ readTeXFile f
877+ return $ "\\PandocStartInclude{" ++ f ++ "}" ++
878+ contents ++ "\\PandocEndInclude{" ++
879+ fn ++ "}{" ++ show (sourceLine pos) ++ "}{"
880+ ++ show (sourceColumn pos) ++ "}")
881+ setInput $ concat results' ++ rest
882+ return ""
883+
884+startMarker' :: IncludeParser
885+startMarker' = try $ do
886+ string "\\PandocStartInclude"
887+ fn <- braced'
888+ updateState (fn:)
889+ setPosition $ newPos fn 1 1
890+ return $ "\\PandocStartInclude{" ++ fn ++ "}"
891+
892+endMarker' :: IncludeParser
893+endMarker' = try $ do
894+ string "\\PandocEndInclude"
895+ fn <- braced'
896+ ln <- braced'
897+ co <- braced'
898+ updateState tail
899+ setPosition $ newPos fn (fromMaybe 1 $ safeRead ln) (fromMaybe 1 $ safeRead co)
900+ return $ "\\PandocEndInclude{" ++ fn ++ "}{" ++ ln ++ "}{" ++
901+ co ++ "}"
822902
823903readTeXFile :: FilePath -> IO String
824904readTeXFile f = do
@@ -833,27 +913,7 @@ readFileFromDirs (d:ds) f =
833913 E.catch (UTF8.readFile $ d </> f) $ \(_ :: E.SomeException) ->
834914 readFileFromDirs ds f
835915
836−include :: LP ([FilePath], String)
837−include = do
838− name <- controlSeq "include"
839− <|> controlSeq "input"
840− <|> controlSeq "usepackage"
841− skipopts
842− fs <- (splitBy (==',')) <$> braced
843− rest <- getInput
844− let fs' = if name == "usepackage"
845− then map (flip replaceExtension ".sty") fs
846− else map (flip replaceExtension ".tex") fs
847− return (fs', rest)
848−
849−verbCmd :: LP (String, String)
850−verbCmd = do
851− (_,r) <- withRaw $ do
852− controlSeq "verb"
853− c <- anyChar
854− manyTill anyChar (char c)
855− rest <- getInput
856− return (r, rest)
916+----
857917
858918keyval :: LP (String, String)
859919keyval = try $ do
@@ -875,17 +935,6 @@ alltt t = walk strToCode <$> parseFromString blocks
875935 where strToCode (Str s) = Code nullAttr s
876936 strToCode x = x
877937
878−verbatimEnv :: LP (String, String)
879−verbatimEnv = do
880− (_,r) <- withRaw $ do
881− controlSeq "begin"
882− name <- braced
883− guard $ name `elem` ["verbatim", "Verbatim", "lstlisting",
884− "minted", "alltt"]
885− verbEnv name
886− rest <- getInput
887− return (r,rest)
888−
889938rawLaTeXBlock :: Parser [Char] ParserState String
890939rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
891940
@@ -1218,3 +1267,16 @@ simpTable = try $ do
12181267 lookAhead $ controlSeq "end" -- make sure we're at end
12191268 return $ table mempty (zip aligns (repeat 0)) header'' rows
12201269
1270+startInclude :: LP Blocks
1271+startInclude = do
1272+ fn <- braced
1273+ setPosition $ newPos fn 1 1
1274+ return mempty
1275+
1276+endInclude :: LP Blocks
1277+endInclude = do
1278+ fn <- braced
1279+ ln <- braced
1280+ co <- braced
1281+ setPosition $ newPos fn (fromMaybe 1 $ safeRead ln) (fromMaybe 1 $ safeRead co)
1282+ return mempty