ghc/compiler/main/TmpFiles.hs

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