1 -----------------------------------------------------------------------------
2 -- $Id: TmpFiles.hs,v 1.16 2001/03/08 09:50:18 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 ()
38 #include "HsVersions.h"
40 GLOBAL_VAR(v_FilesToClean, [], [String] )
41 GLOBAL_VAR(v_TmpDir, cDEFAULT_TMPDIR, String )
44 initTempFileStorage = do
45 -- check whether TMPDIR is set in the environment
46 IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
47 #ifndef mingw32_TARGET_OS
48 writeIORef v_TmpDir dir
53 cleanTempFiles :: Int -> IO ()
54 cleanTempFiles verb = do
55 fs <- readIORef v_FilesToClean
56 removeTmpFiles verb fs
58 cleanTempFilesExcept :: Int -> [FilePath] -> IO ()
59 cleanTempFilesExcept verb dont_delete = do
60 fs <- readIORef v_FilesToClean
61 let leftovers = filter (`notElem` dont_delete) fs
62 removeTmpFiles verb leftovers
63 writeIORef v_FilesToClean dont_delete
67 -- find a temporary name that doesn't already exist.
68 newTempName :: Suffix -> IO FilePath
71 tmp_dir <- readIORef v_TmpDir
72 findTempName tmp_dir x
73 where findTempName tmp_dir x = do
74 let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
75 b <- doesFileExist filename
76 if b then findTempName tmp_dir (x+1)
77 else do add v_FilesToClean filename -- clean it up later
80 addFilesToClean :: [FilePath] -> IO ()
81 addFilesToClean files = mapM_ (add v_FilesToClean) files
83 removeTmpFiles :: Int -> [FilePath] -> IO ()
84 removeTmpFiles verb fs = do
85 let verbose = verb >= 2
87 (do when verbose (hPutStrLn stderr ("Removing: " ++ f))
89 then kludgedSystem ("rm -f " ++ f) "Cleaning temp files" >> return ()
92 (\_ -> when verbose (hPutStrLn stderr
93 ("Warning: can't remove tmp file " ++ f)))
97 -- system that works feasibly under Windows (i.e. passes the command line to sh,
98 -- because system() under Windows doesn't look at SHELL, and always uses CMD.EXE)
99 kludgedSystem cmd phase_name
101 #ifndef mingw32_TARGET_OS
102 exit_code <- system cmd `catchAllIO`
103 (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
105 pid <- myGetProcessID
106 tmp_dir <- readIORef v_TmpDir
107 let tmp = tmp_dir++"/sh"++show pid
108 h <- openFile tmp WriteMode
111 exit_code <- system ("sh - " ++ tmp) `catchAllIO`
112 (\_ -> removeFile tmp >>
113 throwDyn (PhaseFailed phase_name (ExitFailure 1)))