projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
ccc1989
)
ghc-pkg: don't fail, if a file is already removed
author
ich@christoph-bauer.net
<unknown>
Sun, 25 Jul 2010 16:26:06 +0000
(16:26 +0000)
committer
ich@christoph-bauer.net
<unknown>
Sun, 25 Jul 2010 16:26:06 +0000
(16:26 +0000)
utils/ghc-pkg/Main.hs
patch
|
blob
|
history
diff --git
a/utils/ghc-pkg/Main.hs
b/utils/ghc-pkg/Main.hs
index
940e404
..
bb836f0
100644
(file)
--- a/
utils/ghc-pkg/Main.hs
+++ b/
utils/ghc-pkg/Main.hs
@@
-38,7
+38,7
@@
import System.Directory ( doesDirectoryExist, getDirectoryContents,
import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv )
import System.IO
import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv )
import System.IO
-import System.IO.Error (try)
+import System.IO.Error (try, isDoesNotExistError)
import Data.List
import Control.Concurrent
import Data.List
import Control.Concurrent
@@
-719,7
+719,7
@@
changeDBDir verbosity cmds db = do
do_cmd (RemovePackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ putStrLn ("removing " ++ file)
do_cmd (RemovePackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ putStrLn ("removing " ++ file)
- removeFile file
+ removeFileSafe file
do_cmd (AddPackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ putStrLn ("writing " ++ file)
do_cmd (AddPackage p) = do
let file = location db </> display (installedPackageId p) <.> "conf"
when (verbosity > Normal) $ putStrLn ("writing " ++ file)
@@
-1584,7
+1584,7
@@
withFileAtomic targetFile write_content = do
`catchIO` \err -> do
exists <- doesFileExist targetFile
if exists
`catchIO` \err -> do
exists <- doesFileExist targetFile
if exists
- then do removeFile targetFile
+ then do removeFileSafe targetFile
-- Big fat hairy race condition
renameFile newFile targetFile
-- If the removeFile succeeds and the renameFile fails
-- Big fat hairy race condition
renameFile newFile targetFile
-- If the removeFile succeeds and the renameFile fails
@@
-1594,7
+1594,7
@@
withFileAtomic targetFile write_content = do
renameFile newFile targetFile
#endif
`Exception.onException` do hClose newHandle
renameFile newFile targetFile
#endif
`Exception.onException` do hClose newHandle
- removeFile newFile
+ removeFileSafe newFile
where
template = targetName <.> "tmp"
targetDir | null targetDir_ = "."
where
template = targetName <.> "tmp"
targetDir | null targetDir_ = "."
@@
-1693,3
+1693,9
@@
readUTF8File file = do
hSetEncoding h utf8
#endif
hGetContents h
hSetEncoding h utf8
#endif
hGetContents h
+
+-- removeFileSave doesn't throw an exceptions, if the file is already deleted
+removeFileSafe :: FilePath -> IO ()
+removeFileSafe fn =
+ removeFile fn `catch` \ e ->
+ when (not $ isDoesNotExistError e) $ ioError e
\ No newline at end of file