From: Ian Lynagh Date: Sat, 18 Dec 2010 23:08:27 +0000 (+0000) Subject: Replace uses of the old try function with the new one X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=acb9c929a4ab025972027b55b4c18d4410207d29 Replace uses of the old try function with the new one --- diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index d900f62..8bd4c6c 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -58,7 +58,6 @@ import Data.IORef ( readIORef ) import System.Directory import System.FilePath import System.IO -import System.IO.Error as IO import Control.Monad import Data.List ( isSuffixOf ) import Data.Maybe @@ -365,13 +364,13 @@ linkingNeeded dflags linkables pkg_deps = do -- modification times on all of the objects and libraries, then omit -- linking (unless the -fforce-recomp flag was given). let exe_file = exeFileName dflags - e_exe_time <- IO.try $ getModificationTime exe_file + e_exe_time <- tryIO $ getModificationTime exe_file case e_exe_time of Left _ -> return True Right t -> do -- first check object files and extra_ld_inputs extra_ld_inputs <- readIORef v_Ld_inputs - e_extra_times <- mapM (IO.try . getModificationTime) extra_ld_inputs + e_extra_times <- mapM (tryIO . getModificationTime) extra_ld_inputs let (errs,extra_times) = splitEithers e_extra_times let obj_times = map linkableTime linkables ++ extra_times if not (null errs) || any (t <) obj_times @@ -387,7 +386,7 @@ linkingNeeded dflags linkables pkg_deps = do pkg_libfiles <- mapM (uncurry findHSLib) pkg_hslibs if any isNothing pkg_libfiles then return True else do - e_lib_times <- mapM (IO.try . getModificationTime) + e_lib_times <- mapM (tryIO . getModificationTime) (catMaybes pkg_libfiles) let (lib_errs,lib_times) = splitEithers e_lib_times if not (null lib_errs) || any (t <) lib_times diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 6f42aed..cb433c3 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -312,7 +312,7 @@ import Exception import Data.IORef import System.FilePath import System.IO -import System.IO.Error ( try, isDoesNotExistError ) +import System.IO.Error ( isDoesNotExistError ) import Prelude hiding (init) @@ -2067,7 +2067,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) case maybe_buf of Just (_,t) -> check_timestamp old_summary location src_fn t Nothing -> do - m <- System.IO.Error.try (getModificationTime src_fn) + m <- tryIO (getModificationTime src_fn) case m of Right t -> check_timestamp old_summary location src_fn t Left e | isDoesNotExistError e -> find_it diff --git a/ghc/GhciTags.hs b/ghc/GhciTags.hs index c4b52f3..c2e6973 100644 --- a/ghc/GhciTags.hs +++ b/ghc/GhciTags.hs @@ -13,6 +13,7 @@ module GhciTags ( createETagsFileCmd ) where +import Exception import GHC import GhciMonad import Outputable @@ -29,7 +30,7 @@ import Panic import Data.List import Control.Monad import System.IO -import System.IO.Error as IO +import System.IO.Error ----------------------------------------------------------------------------- -- create tags file for currently loaded modules. @@ -130,18 +131,18 @@ collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ( -- ctags style with the Ex exresion being just the line number, Vim et al collateAndWriteTags CTagsWithLineNumbers file tagInfos = do let tags = unlines $ sortLe (<=) $ map showCTag tagInfos - IO.try (writeFile file tags) + tryIO (writeFile file tags) -- ctags style with the Ex exresion being a regex searching the line, Vim et al collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos let tags = unlines $ sortLe (<=) $ map showCTag $concat tagInfoGroups - IO.try (writeFile file tags) + tryIO (writeFile file tags) collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos let tagGroups = map processGroup tagInfoGroups - IO.try (writeFile file $ concat tagGroups) + tryIO (writeFile file $ concat tagGroups) where processGroup [] = ghcError (CmdLineError "empty tag file group??") diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 2f3ca85..ac056a6 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -81,7 +81,7 @@ import System.Environment import System.Exit ( exitWith, ExitCode(..) ) import System.Directory import System.IO -import System.IO.Error as IO +import System.IO.Error import Data.Char import Data.Array import Control.Monad as Monad @@ -369,7 +369,7 @@ interactiveUI srcs maybe_exprs = do withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a withGhcAppData right left = do - either_dir <- IO.try (getAppUserDataDirectory "ghc") + either_dir <- tryIO (getAppUserDataDirectory "ghc") case either_dir of Right dir -> do createDirectoryIfMissing False dir `catchIO` \_ -> return () @@ -388,7 +388,7 @@ runGHCi paths maybe_exprs = do (return Nothing) home_dir = do - either_dir <- liftIO $ IO.try (getEnv "HOME") + either_dir <- liftIO $ tryIO (getEnv "HOME") case either_dir of Right home -> return (Just (home ".ghci")) _ -> return Nothing @@ -404,7 +404,7 @@ runGHCi paths maybe_exprs = do dir_ok <- liftIO $ checkPerms (getDirectory file) file_ok <- liftIO $ checkPerms file when (dir_ok && file_ok) $ do - either_hdl <- liftIO $ IO.try (openFile file ReadMode) + either_hdl <- liftIO $ tryIO (openFile file ReadMode) case either_hdl of Left _e -> return () -- NOTE: this assumes that runInputT won't affect the terminal; @@ -517,7 +517,7 @@ checkPerms name = fileLoop :: MonadIO m => Handle -> InputT m (Maybe String) fileLoop hdl = do - l <- liftIO $ IO.try $ hGetLine hdl + l <- liftIO $ tryIO $ hGetLine hdl case l of Left e | isEOFError e -> return Nothing | InvalidArgument <- etype -> return Nothing @@ -661,7 +661,7 @@ runStmt stmt step -- are really two stdin Handles. So we flush any bufferred data in -- GHCi's stdin Handle here (only relevant if stdin is attached to -- a file, otherwise the read buffer can't be flushed). - _ <- liftIO $ IO.try $ hFlushAll stdin + _ <- liftIO $ tryIO $ hFlushAll stdin result <- GhciMonad.runStmt stmt step afterRunStmt (const True) result @@ -890,7 +890,7 @@ addModule files = do changeDirectory :: String -> InputT GHCi () changeDirectory "" = do -- :cd on its own changes to the user's home directory - either_dir <- liftIO $ IO.try getHomeDirectory + either_dir <- liftIO $ tryIO getHomeDirectory case either_dir of Left _e -> return () Right dir -> changeDirectory dir diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index e843d88..1cec56a 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -449,7 +449,7 @@ getPkgDatabases verbosity modify use_cache my_flags = do -- get the location of the user package database, and create it if necessary -- getAppUserDataDirectory can fail (e.g. if $HOME isn't set) - e_appdir <- try $ getAppUserDataDirectory "ghc" + e_appdir <- tryIO $ getAppUserDataDirectory "ghc" mb_user_conf <- if no_user_db then return Nothing else @@ -470,7 +470,7 @@ getPkgDatabases verbosity modify use_cache my_flags = do modify || user_exists = [user_conf, global_conf] | otherwise = [global_conf] - e_pkg_path <- try (System.Environment.getEnv "GHC_PACKAGE_PATH") + e_pkg_path <- tryIO (System.Environment.getEnv "GHC_PACKAGE_PATH") let env_stack = case e_pkg_path of Left _ -> sys_databases @@ -541,7 +541,7 @@ readParseDatabase verbosity mb_user_conf use_cache path | Just (user_conf,False) <- mb_user_conf, path == user_conf = return PackageDB { location = path, packages = [] } | otherwise - = do e <- try $ getDirectoryContents path + = do e <- tryIO $ getDirectoryContents path case e of Left _ -> do pkgs <- parseMultiPackageConf verbosity path @@ -551,7 +551,7 @@ readParseDatabase verbosity mb_user_conf use_cache path | otherwise -> do let cache = path cachefilename tdir <- getModificationTime path - e_tcache <- try $ getModificationTime cache + e_tcache <- tryIO $ getModificationTime cache case e_tcache of Left ex -> do when (verbosity > Normal) $ @@ -1542,6 +1542,8 @@ catchError :: IO a -> (String -> IO a) -> IO a catchError io handler = io `Exception.catch` handler' where handler' (Exception.ErrorCall err) = handler err +tryIO :: IO a -> IO (Either Exception.IOException a) +tryIO = Exception.try writeBinaryFileAtomic :: Bin.Binary a => FilePath -> a -> IO () writeBinaryFileAtomic targetFile obj =