1 -----------------------------------------------------------------------------
2 -- $Id: TmpFiles.hs,v 1.15 2001/02/12 13:33:47 simonmar Exp $
4 -- Temporary file management
6 -- (c) The University of Glasgow 2000
8 -----------------------------------------------------------------------------
12 initTempFileStorage, -- :: IO ()
13 cleanTempFiles, -- :: Int -> IO ()
14 cleanTempFilesExcept, -- :: Int -> [FilePath] -> IO ()
15 newTempName, -- :: Suffix -> IO FilePath
16 addFilesToClean, -- :: [FilePath] -> IO ()
17 removeTmpFiles, -- :: Int -> [FilePath] -> IO ()
36 #include "HsVersions.h"
38 GLOBAL_VAR(v_FilesToClean, [], [String] )
39 GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String )
42 initTempFileStorage = do
43 -- check whether TMPDIR is set in the environment
44 IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
45 #ifndef mingw32_TARGET_OS
46 writeIORef v_TmpDir dir
51 cleanTempFiles :: Int -> IO ()
52 cleanTempFiles verb = do
53 fs <- readIORef v_FilesToClean
54 removeTmpFiles verb fs
56 cleanTempFilesExcept :: Int -> [FilePath] -> IO ()
57 cleanTempFilesExcept verb dont_delete = do
58 fs <- readIORef v_FilesToClean
59 let leftovers = filter (`notElem` dont_delete) fs
60 removeTmpFiles verb leftovers
61 writeIORef v_FilesToClean dont_delete
65 -- find a temporary name that doesn't already exist.
66 newTempName :: Suffix -> IO FilePath
69 tmp_dir <- readIORef v_TmpDir
70 findTempName tmp_dir x
71 where findTempName tmp_dir x = do
72 let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
73 b <- doesFileExist filename
74 if b then findTempName tmp_dir (x+1)
75 else do add v_FilesToClean filename -- clean it up later
78 addFilesToClean :: [FilePath] -> IO ()
79 addFilesToClean files = mapM_ (add v_FilesToClean) files
81 removeTmpFiles :: Int -> [FilePath] -> IO ()
82 removeTmpFiles verb fs = do
83 let verbose = verb >= 2
85 (do when verbose (hPutStrLn stderr ("Removing: " ++ f))
87 then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
90 (\_ -> when verbose (hPutStrLn stderr
91 ("Warning: can't remove tmp file " ++ f)))