Commit 015975f7 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-10-10 13:21:10 by simonmar]

Temporary file management, broken out of the driver.
parent 35fb1e38
-----------------------------------------------------------------------------
-- $Id: TmpFiles.hs,v 1.1 2000/10/10 13:21:10 simonmar Exp $
--
-- Temporary file management
--
-- (c) The University of Glasgow 2000
--
-----------------------------------------------------------------------------
module TmpFiles (
Suffix,
initTempFileStorage, -- :: IO ()
cleanTempFiles, -- :: IO ()
newTempName -- :: Suffix -> IO FilePath
) where
-- main
import Config
import Util
-- hslibs
import Posix
import Exception
import IOExts
-- std
import System
import Directory
import IO
import Monad
#include "HsVersions.h"
GLOBAL_VAR( v_FilesToClean, [], [String] )
GLOBAL_VAR( v_TmpDir, cDEFAULT_TMPDIR, String )
initTempFileStorage = do
-- check whether TMPDIR is set in the environment
IO.try (do dir <- getEnv "TMPDIR" -- fails if not set
writeIORef tmpdir dir)
cleanTempFiles :: Bool -> IO ()
cleanTempFiles verbose = do
fs <- readIORef v_FilesToClean
let blowAway f =
(do when verbose (hPutStrLn stderr ("removing: " ++ f))
if '*' `elem` f then system ("rm -f " ++ f) >> return ()
else removeFile f)
`catchAllIO`
(\_ -> when verbose (hPutStrLn stderr
("warning: can't remove tmp file" ++ f)))
mapM_ blowAway fs
type Suffix = String
-- find a temporary name that doesn't already exist.
newTempName :: Suffix -> IO FilePath
newTempName extn = do
x <- getProcessID
tmp_dir <- readIORef v_TmpDir
findTempName tmp_dir x
where findTempName tmp_dir x = do
let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
b <- doesFileExist filename
if b then findTempName tmp_dir (x+1)
else return filename
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment