-----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.10 2000/12/05 12:09:43 sewardj Exp $
+-- $Id: TmpFiles.hs,v 1.15 2001/02/12 13:33:47 simonmar Exp $
--
-- Temporary file management
--
module TmpFiles (
Suffix,
initTempFileStorage, -- :: IO ()
- cleanTempFiles, -- :: IO ()
+ cleanTempFiles, -- :: Int -> IO ()
+ cleanTempFilesExcept, -- :: Int -> [FilePath] -> IO ()
newTempName, -- :: Suffix -> IO FilePath
addFilesToClean, -- :: [FilePath] -> IO ()
+ removeTmpFiles, -- :: Int -> [FilePath] -> IO ()
v_TmpDir
) where
-- main
import Config
import Util
+import DriverUtil
-- hslibs
import Exception
#ifndef mingw32_TARGET_OS
writeIORef v_TmpDir dir
#endif
+ return ()
)
-cleanTempFiles :: Bool -> IO ()
-cleanTempFiles verbose = do
+cleanTempFiles :: Int -> IO ()
+cleanTempFiles verb = do
fs <- readIORef v_FilesToClean
+ removeTmpFiles verb fs
- let blowAway f =
- (do when verbose (hPutStrLn stderr ("Removing: " ++ f))
- if '*' `elem` f then system ("rm -f " ++ f) >> return ()
- else removeFile f)
- `catchAllIO`
- (\_ -> when verbose (hPutStrLn stderr
- ("Warning: can't remove tmp file " ++ f)))
- mapM_ blowAway fs
+cleanTempFilesExcept :: Int -> [FilePath] -> IO ()
+cleanTempFilesExcept verb dont_delete = do
+ fs <- readIORef v_FilesToClean
+ let leftovers = filter (`notElem` dont_delete) fs
+ removeTmpFiles verb leftovers
+ writeIORef v_FilesToClean dont_delete
type Suffix = String
addFilesToClean :: [FilePath] -> IO ()
addFilesToClean files = mapM_ (add v_FilesToClean) files
-add :: IORef [a] -> a -> IO ()
-add var x = do
- xs <- readIORef var
- writeIORef var (x:xs)
-
+removeTmpFiles :: Int -> [FilePath] -> IO ()
+removeTmpFiles verb fs = do
+ let verbose = verb >= 2
+ blowAway f =
+ (do when verbose (hPutStrLn stderr ("Removing: " ++ f))
+ if '*' `elem` f
+ then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
+ else removeFile f)
+ `catchAllIO`
+ (\_ -> when verbose (hPutStrLn stderr
+ ("Warning: can't remove tmp file " ++ f)))
+ mapM_ blowAway fs