ghc/compiler/main/TmpFiles.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: TmpFiles.hs,v 1.11 2000/12/07 08:20:46 simonpj 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    v_TmpDir
  17  ) where
  18
  19 -- main
  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 GLOBAL_VAR(v_TmpDir,       cDEFAULT_TMPDIR,  String   )
  37
  38
  39 initTempFileStorage = do
  40         -- check whether TMPDIR is set in the environment
  41    IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
  42 #ifndef mingw32_TARGET_OS
  43               writeIORef v_TmpDir dir
  44 #endif
  45               return ()
  46           )
  47
  48 cleanTempFiles :: Bool -> IO ()
  49 cleanTempFiles verbose = do
  50   fs <- readIORef v_FilesToClean
  51
  52   let blowAway f =
  53            (do  when verbose (hPutStrLn stderr ("Removing: " ++ f))
  54                 if '*' `elem` f then system ("rm -f " ++ f) >> return ()
  55                                 else removeFile f)
  56             `catchAllIO`
  57            (\_ -> when verbose (hPutStrLn stderr
  58                                 ("Warning: can't remove tmp file " ++ f)))
  59   mapM_ blowAway fs
  60
  61 type Suffix = String
  62
  63 -- find a temporary name that doesn't already exist.
  64 newTempName :: Suffix -> IO FilePath
  65 newTempName extn = do
  66   x <- myGetProcessID
  67   tmp_dir <- readIORef v_TmpDir
  68   findTempName tmp_dir x
  69   where findTempName tmp_dir x = do
  70            let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
  71            b  <- doesFileExist filename
  72            if b then findTempName tmp_dir (x+1)
  73                 else do add v_FilesToClean filename -- clean it up later
  74                         return filename
  75
  76 addFilesToClean :: [FilePath] -> IO ()
  77 addFilesToClean files = mapM_ (add v_FilesToClean) files
  78
  79 add :: IORef [a] -> a -> IO ()
  80 add var x = do
  81   xs <- readIORef var
  82   writeIORef var (x:xs)
  83