1 -----------------------------------------------------------------------------
2 -- $Id: TmpFiles.hs,v 1.12 2000/12/11 12:30:58 rrt Exp $
4 -- Temporary file management
6 -- (c) The University of Glasgow 2000
8 -----------------------------------------------------------------------------
12 initTempFileStorage, -- :: IO ()
13 cleanTempFiles, -- :: IO ()
14 newTempName, -- :: Suffix -> IO FilePath
15 addFilesToClean, -- :: [FilePath] -> IO ()
22 import DriverUtil ( kludgedSystem )
34 #include "HsVersions.h"
36 GLOBAL_VAR(v_FilesToClean, [], [String] )
37 GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String )
40 initTempFileStorage = do
41 -- check whether TMPDIR is set in the environment
42 IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
43 #ifndef mingw32_TARGET_OS
44 writeIORef v_TmpDir dir
49 cleanTempFiles :: Bool -> IO ()
50 cleanTempFiles verbose = do
51 fs <- readIORef v_FilesToClean
54 (do when verbose (hPutStrLn stderr ("Removing: " ++ f))
55 if '*' `elem` f then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
58 (\_ -> when verbose (hPutStrLn stderr
59 ("Warning: can't remove tmp file " ++ f)))
64 -- find a temporary name that doesn't already exist.
65 newTempName :: Suffix -> IO FilePath
68 tmp_dir <- readIORef v_TmpDir
69 findTempName tmp_dir x
70 where findTempName tmp_dir x = do
71 let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
72 b <- doesFileExist filename
73 if b then findTempName tmp_dir (x+1)
74 else do add v_FilesToClean filename -- clean it up later
77 addFilesToClean :: [FilePath] -> IO ()
78 addFilesToClean files = mapM_ (add v_FilesToClean) files
80 add :: IORef [a] -> a -> IO ()