1 -----------------------------------------------------------------------------
2 -- $Id: TmpFiles.hs,v 1.4 2000/10/24 13:23:33 sewardj 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 ()
24 #ifndef mingw32_TARGET_OS
25 import Posix ( getProcessID )
36 #include "HsVersions.h"
38 GLOBAL_VAR(v_FilesToClean, [], [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 writeIORef v_TmpDir dir)
46 cleanTempFiles :: Bool -> IO ()
47 cleanTempFiles verbose = do
48 fs <- readIORef v_FilesToClean
51 (do when verbose (hPutStrLn stderr ("removing: " ++ f))
52 if '*' `elem` f then system ("rm -f " ++ f) >> return ()
55 (\_ -> when verbose (hPutStrLn stderr
56 ("warning: can't remove tmp file" ++ f)))
61 -- find a temporary name that doesn't already exist.
62 #ifdef mingw32_TARGET_OS
63 getProcessID :: IO Int
65 = do putStr "warning: faking getProcessID in main/TmpFiles.lhs"
69 newTempName :: Suffix -> IO FilePath
72 tmp_dir <- readIORef v_TmpDir
73 findTempName tmp_dir x
74 where findTempName tmp_dir x = do
75 let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
76 b <- doesFileExist filename
77 if b then findTempName tmp_dir (x+1)
78 else do add v_FilesToClean filename -- clean it up later
81 addFilesToClean :: [FilePath] -> IO ()
82 addFilesToClean files = mapM_ (add v_FilesToClean) files
84 add :: IORef [a] -> a -> IO ()