summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/DriverPipeline.hs7
-rw-r--r--compiler/main/GHC.hs4
-rw-r--r--ghc/GhciTags.hs9
-rw-r--r--ghc/InteractiveUI.hs14
-rw-r--r--utils/ghc-pkg/Main.hs10
5 files changed, 23 insertions, 21 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index d900f62966..8bd4c6c9be 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 6f42aedf29..cb433c3528 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 c4b52f39c2..c2e6973e18 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 2f3ca85dec..ac056a6a7e 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 e843d88a38..1cec56a998 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 =
View Lorry Controller Status