ghc/compiler/main/TmpFiles.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: TmpFiles.hs,v 1.1 2000/10/10 13:21:10 simonmar 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  ) where
  16
  17 -- main
  18 import Config
  19 import Util
  20
  21 -- hslibs
  22 import Posix
  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 initTempFileStorage = do
  38         -- check whether TMPDIR is set in the environment
  39    IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
  40               writeIORef 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 <- getProcessID
  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 return filename
  69