[project @ 2000-10-27 13:50:25 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / TmpFiles.hs
1 -----------------------------------------------------------------------------
2 -- $Id: TmpFiles.hs,v 1.5 2000/10/27 13:50:25 sewardj Exp $
3 --
4 -- Temporary file management
5 --
6 -- (c) The University of Glasgow 2000
7 --
8 -----------------------------------------------------------------------------
9
10 module TmpFiles (
11    Suffix,
12    initTempFileStorage,  -- :: IO ()
13    cleanTempFiles,       -- :: IO ()
14    newTempName,          -- :: Suffix -> IO FilePath
15    addFilesToClean       -- :: [FilePath] -> IO ()
16  ) where
17
18 -- main
19 import DriverState
20 import Config
21 import Util
22
23 -- hslibs
24 import Exception
25 import IOExts
26
27 -- std
28 import System
29 import Directory
30 import IO
31 import Monad
32
33 #include "HsVersions.h"
34
35 GLOBAL_VAR(v_FilesToClean, [],               [String] )
36
37 initTempFileStorage = do
38         -- check whether TMPDIR is set in the environment
39    IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
40               writeIORef v_TmpDir dir)
41
42
43 cleanTempFiles :: Bool -> IO ()
44 cleanTempFiles verbose = do
45   fs <- readIORef v_FilesToClean
46
47   let blowAway f =
48            (do  when verbose (hPutStrLn stderr ("removing: " ++ f))
49                 if '*' `elem` f then system ("rm -f " ++ f) >> return ()
50                                 else removeFile f)
51             `catchAllIO`
52            (\_ -> when verbose (hPutStrLn stderr 
53                                 ("warning: can't remove tmp file" ++ f)))
54   mapM_ blowAway fs
55
56 type Suffix = String
57
58 -- find a temporary name that doesn't already exist.
59 newTempName :: Suffix -> IO FilePath
60 newTempName extn = do
61   x <- myGetProcessID
62   tmp_dir <- readIORef v_TmpDir
63   findTempName tmp_dir x
64   where findTempName tmp_dir x = do
65            let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
66            b  <- doesFileExist filename
67            if b then findTempName tmp_dir (x+1)
68                 else do add v_FilesToClean filename -- clean it up later
69                         return filename
70
71 addFilesToClean :: [FilePath] -> IO ()
72 addFilesToClean files = mapM_ (add v_FilesToClean) files
73
74 add :: IORef [a] -> a -> IO ()
75 add var x = do
76   xs <- readIORef var
77   writeIORef var (x:xs)
78