From 308436996e7311caa257000f4c010686c08a58e7 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 24 Jul 2012 19:28:51 -0700 Subject: Use catch from Control.Exception to avoid warnings. --- src/Text/Pandoc/Readers/LaTeX.hs | 6 ++++-- src/Text/Pandoc/Writers/ODT.hs | 9 +++++---- src/Text/Pandoc/Writers/RTF.hs | 4 +++- src/pandoc.hs | 19 ++++++++++++------- 4 files changed, 24 insertions(+), 14 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 351e1fef5..88c11593b 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -46,6 +46,7 @@ import Data.Monoid import System.FilePath (replaceExtension) import Data.List (intercalate) import qualified Data.Map as M +import qualified Control.Exception as E -- | Parse LaTeX from string and return 'Pandoc' document. readLaTeX :: ParserState -- ^ Parser state, including options for parser @@ -670,8 +671,9 @@ handleIncludes :: String -> IO String handleIncludes [] = return [] handleIncludes ('\\':xs) = case runParser include defaultParserState "input" ('\\':xs) of - Right (fs, rest) -> do let getfile f = catch (UTF8.readFile f) - (\_ -> return "") + Right (fs, rest) -> do let getfile f = E.catch (UTF8.readFile f) + (\e -> let _ = (e :: E.SomeException) + in return "") yss <- mapM getfile fs (intercalate "\n" yss ++) `fmap` handleIncludes rest diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index b45a6bc92..de397d817 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -47,6 +47,7 @@ import Control.Monad (liftM) import Network.URI ( unEscapeString ) import Text.Pandoc.XML import Text.Pandoc.Pretty +import qualified Control.Exception as E -- | Produce an ODT file from a Pandoc document. writeODT :: WriterOptions -- ^ Writer options @@ -109,9 +110,9 @@ transformPic sourceDir entriesRef (Image lab (src,tit)) = do Nothing -> tit entries <- readIORef entriesRef let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src' - catch (readEntry [] (sourceDir src') >>= \entry -> - modifyIORef entriesRef (entry{ eRelativePath = newsrc } :) >> - return (Image lab (newsrc, tit'))) - (\_ -> return (Emph lab)) + E.catch (readEntry [] (sourceDir src') >>= \entry -> + modifyIORef entriesRef (entry{ eRelativePath = newsrc } :) >> + return (Image lab (newsrc, tit'))) + (\e -> let _ = (e :: E.SomeException) in return (Emph lab)) transformPic _ _ x = return x diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 4e7c2a7cd..a571f2a0f 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -38,6 +38,7 @@ import System.FilePath ( takeExtension ) import qualified Data.ByteString as B import Text.Printf ( printf ) import Network.URI ( isAbsoluteURI, unEscapeString ) +import qualified Control.Exception as E -- | Convert Image inlines into a raw RTF embedded image, read from a file. -- If file not found or filetype not jpeg or png, leave the inline unchanged. @@ -47,7 +48,8 @@ rtfEmbedImage x@(Image _ (src,_)) = do if ext `elem` [".jpg",".jpeg",".png"] && not (isAbsoluteURI src) then do let src' = unEscapeString src - imgdata <- catch (B.readFile src') (\_ -> return B.empty) + imgdata <- E.catch (B.readFile src') + (\e -> let _ = (e :: E.SomeException) in return B.empty) let bytes = map (printf "%02x") $ B.unpack imgdata let filetype = case ext of ".jpg" -> "\\jpegblip" diff --git a/src/pandoc.hs b/src/pandoc.hs index e6e9c710c..0fd9f37a4 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -48,6 +48,7 @@ import Data.List ( intercalate, isSuffixOf, isPrefixOf ) import System.Directory ( getAppUserDataDirectory, doesFileExist, findExecutable ) import System.IO ( stdout ) import System.IO.Error ( isDoesNotExistError ) +import qualified Control.Exception as E import Control.Exception.Extensible ( throwIO ) import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.CSL as CSL @@ -840,9 +841,10 @@ main = do let sources = if ignoreArgs then [] else args datadir <- case mbDataDir of - Nothing -> catch + Nothing -> E.catch (liftM Just $ getAppUserDataDirectory "pandoc") - (const $ return Nothing) + (\e -> let _ = (e :: E.SomeException) + in return Nothing) Just _ -> return mbDataDir -- assign reader and writer based on options and filenames @@ -893,12 +895,13 @@ main = do let tp' = case takeExtension tp of "" -> tp <.> format _ -> tp - catch (UTF8.readFile tp') + E.catch (UTF8.readFile tp') (\e -> if isDoesNotExistError e - then catch + then E.catch (readDataFile datadir $ "templates" tp') - (\_ -> throwIO e) + (\e' -> let _ = (e' :: E.SomeException) + in throwIO e') else throwIO e) variables' <- case mathMethod of @@ -922,8 +925,10 @@ main = do -- that we can do lookups with regular string equality let unescapeRefId ref = ref{ refId = fromEntities (refId ref) } - refs <- mapM (\f -> catch (CSL.readBiblioFile f) $ \e -> - err 23 $ "Error reading bibliography `" ++ f ++ "'" ++ "\n" ++ show e) + refs <- mapM (\f -> E.catch (CSL.readBiblioFile f) + (\e -> let _ = (e :: E.SomeException) + in err 23 $ "Error reading bibliography `" ++ f ++ + "'" ++ "\n" ++ show e)) reffiles >>= return . map unescapeRefId . concat -- cgit v1.2.3