From d7fdebe8a174f968b63c98845cb16577e444ee13 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Mon, 10 Jul 2006 21:43:08 +0000 Subject: [PATCH] Pull out common removal code, and detect does-not-exist correctly --- compiler/main/SysTools.lhs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index a377427..fb9cf37 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -615,19 +615,14 @@ removeTmpDirs :: DynFlags -> [FilePath] -> IO () removeTmpDirs dflags ds = traceCmd dflags "Deleting temp dirs" ("Deleting: " ++ unwords ds) - (mapM_ rmdir ds) - where - rmdir d = removeDirectory d `IO.catch` - (\_ignored -> - debugTraceMsg dflags 2 (ptext SLIT("Warning: deleting") <+> text d <+> ptext SLIT("raised exception")) - ) + (mapM_ (removeWith dflags removeDirectory) ds) removeTmpFiles :: DynFlags -> [FilePath] -> IO () removeTmpFiles dflags fs = warnNon $ traceCmd dflags "Deleting temp files" ("Deleting: " ++ unwords deletees) - (mapM_ rm deletees) + (mapM_ (removeWith dflags removeFile) deletees) where -- Flat out refuse to delete files that are likely to be source input -- files (is there a worse bug than having a compiler delete your source @@ -643,11 +638,16 @@ removeTmpFiles dflags fs (non_deletees, deletees) = partition isHaskellUserSrcFilename fs - rm f = removeFile f `IO.catch` - (\_ignored -> - debugTraceMsg dflags 2 (ptext SLIT("Warning: deleting non-existent") <+> text f) - ) - +removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO () +removeWith dflags remover f = remover f `IO.catch` + (\e -> + let msg = if isDoesNotExistError e + then ptext SLIT("Warning: deleting non-existent") <+> text f + else ptext SLIT("Warning: exception raised when deleting") + <+> text f <> colon + $$ text (show e) + in debugTraceMsg dflags 2 msg + ) ----------------------------------------------------------------------------- -- Running an external program -- 1.7.10.4