diff --git a/Distribution/Compat/TempFile.hs b/Distribution/Compat/TempFile.hs
index fc123e7211dc1a5bffda4caa3c253a1996c70079..5c5bb0c7f6da1722dfc57f17dffc2106f19b26e3 100644
--- a/Distribution/Compat/TempFile.hs
+++ b/Distribution/Compat/TempFile.hs
@@ -3,62 +3,42 @@
{-# OPTIONS_NHC98 -cpp #-}
{-# OPTIONS_JHC -fcpp #-}
-- #hide
-module Distribution.Compat.TempFile (openTempFile, withTempFile) where
+module Distribution.Compat.TempFile (openTempFile) where
-import System.IO (openFile, Handle, IOMode(ReadWriteMode))
-import System.Directory (doesFileExist, removeFile)
-import Control.Exception (finally,try)
-
-import System.FilePath ( (</>), (<.>) )
-
-#if (__GLASGOW_HASKELL__ || __HUGS__)
+#if __NHC__ || __HUGS__
+import System.IO (openFile, Handle, IOMode(ReadWriteMode))
+import System.Directory (doesFileExist)
+import System.FilePath ((</>))
import System.Posix.Internals (c_getpid)
#else
-import System.Posix.Types (CPid(..))
+import System.IO (openTempFile)
#endif
-
-- ------------------------------------------------------------
-- * temporary files
-- ------------------------------------------------------------
--- TODO: this function *really really really* should be
--- eliminated and replaced with System.IO.openTempFile,
--- except that is currently GHC-only for no valid reason.
+-- This is here for Haskell implementations that do not come with
+-- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9.
+-- TODO: Not sure about jhc
+#if __NHC__ || __HUGS__
-- use a temporary filename that doesn't already exist.
-- NB. *not* secure (we don't atomically lock the tmp file we get)
openTempFile :: FilePath -> String -> IO (FilePath, Handle)
openTempFile tmp_dir template
- = do x <- getProcessID
- findTempName x
- where
- findTempName x
- = do let filename = template ++ show x
- path = tmp_dir </> filename
- b <- doesFileExist path
- if b then findTempName (x+1)
- else do hnd <- openFile path ReadWriteMode
- return (path, hnd)
-
-#if !(__GLASGOW_HASKELL__ || __HUGS__)
-foreign import ccall unsafe "getpid" c_getpid :: IO CPid
-#endif
-
-getProcessID :: IO Int
-getProcessID = c_getpid >>= return . fromIntegral
-
--- use a temporary filename that doesn't already exist.
--- NB. *not* secure (we don't atomically lock the tmp file we get)
-withTempFile :: FilePath -> String -> (FilePath -> IO a) -> IO a
-withTempFile tmp_dir extn action
= do x <- getProcessID
findTempName x
where
+ (templateBase, templateExt) = splitExtension template
+ findTempName :: Int -> IO (FilePath, Handle)
findTempName x
- = do let filename = ("tmp" ++ show x) <.> extn
- path = tmp_dir </> filename
+ = do let path = tmp_dir </> (templateBase ++ show x) <.> templateExt
b <- doesFileExist path
if b then findTempName (x+1)
- else action path `finally` try (removeFile path)
+ else do hnd <- openFile path ReadWriteMode
+ return (path, hnd)
+ getProcessID :: IO Int
+ getProcessID = fmap fromIntegral c_getpid
+#endif
diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs
index 2657a2b812ce2c75cc4088614855e6436c3f38a4..8c6c21584b6bdce3380e0b2bddb885b2fb7b4eba 100644
--- a/Distribution/Simple/GHC.hs
+++ b/Distribution/Simple/GHC.hs
@@ -84,7 +84,6 @@ import Data.List ( nub, isPrefixOf )
import System.Directory ( removeFile, renameFile,
getDirectoryContents, doesFileExist,
getTemporaryDirectory )
-import Distribution.Compat.TempFile ( withTempFile )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension, splitExtension )
import System.IO (openFile, IOMode(WriteMode), hClose, hPutStrLn)
@@ -131,13 +130,15 @@ configure verbosity hcPath hcPkgPath conf = do
-- we need to find out if ld supports the -x flag
(ldProg, conf''') <- requireProgram verbosity ldProgram' AnyVersion conf''
tempDir <- getTemporaryDirectory
- ldx <- withTempFile tempDir "c" $ \testcfile ->
- withTempFile tempDir "o" $ \testofile -> do
- writeFile testcfile "int foo() {}\n"
+ ldx <- withTempFile tempDir ".c" $ \testcfile testchnd ->
+ withTempFile tempDir ".o" $ \testofile testohnd -> do
+ hPutStrLn testchnd "int foo() {}"
+ hClose testchnd; hClose testohnd
rawSystemProgram verbosity ghcProg ["-c", testcfile,
"-o", testofile]
- withTempFile tempDir "o" $ \testofile' ->
+ withTempFile tempDir ".o" $ \testofile' testohnd' ->
handle (\_ -> return False) $ do
+ hClose testohnd'
rawSystemProgramStdout verbosity ldProg
["-x", "-r", testofile, "-o", testofile']
return True
diff --git a/Distribution/Simple/Program.hs b/Distribution/Simple/Program.hs
index 18d2addaba95a0b79137a06ab8ee5fb59881f98a..ac7c77b6f893366c358ed045fb8c2f30bbb406a4 100644
--- a/Distribution/Simple/Program.hs
+++ b/Distribution/Simple/Program.hs
@@ -84,14 +84,15 @@ module Distribution.Simple.Program (
) where
import qualified Data.Map as Map
-import Distribution.Compat.TempFile (withTempFile)
import Distribution.Simple.Utils (die, debug, warn, rawSystemExit,
- rawSystemStdout, rawSystemStdout')
+ rawSystemStdout, rawSystemStdout',
+ withTempFile)
import Distribution.Version (Version(..), readVersion, showVersion,
VersionRange(..), withinRange, showVersionRange)
import Distribution.Verbosity
import System.Directory (doesFileExist, removeFile, findExecutable)
import System.FilePath (dropExtension)
+import System.IO (hClose)
import System.IO.Error (try)
import Control.Monad (join, foldM)
import Control.Exception as Exception (catch)
@@ -570,8 +571,8 @@ hsc2hsProgram = (simpleProgram "hsc2hs") {
case maybeVersion of
Nothing -> return Nothing
Just version ->
- withTempFile "dist" "hsc" $ \hsc -> do
- writeFile hsc ""
+ withTempFile "dist" ".hsc" $ \hsc hnd -> do
+ hClose hnd
(str, _) <- rawSystemStdout' verbosity path [hsc, "--cflag=--version"]
try $ removeFile (dropExtension hsc ++ "_hsc_make.c")
case words str of
diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs
index 7b470553114eb7fb76373b95089fe660ca9067ab..7fb5a2d7002504179463f13399f89d8370ee920f 100644
--- a/Distribution/Simple/Utils.hs
+++ b/Distribution/Simple/Utils.hs
@@ -70,6 +70,7 @@ module Distribution.Simple.Utils (
currentDir,
dotToSep,
findFile,
+ withTempFile,
defaultPackageDesc,
findPackageDesc,
defaultHookedPackageDesc,
@@ -121,13 +122,9 @@ import System.Cmd (system)
import Control.Exception (evaluate)
import System.Process (runProcess, waitForProcess)
#endif
-import System.IO (hClose)
+import System.IO (Handle, hClose)
-#if __GLASGOW_HASKELL__ >= 604
import Distribution.Compat.TempFile (openTempFile)
-#else
-import Distribution.Compat.TempFile (withTempFile)
-#endif
import Distribution.Verbosity
#ifdef DEBUG
@@ -445,7 +442,15 @@ copyDirectoryRecursiveVerbose verbosity srcDir destDir = do
fmap (filter (not . flip elem [".", ".."]))
. getDirectoryContents
-
+-- | Use a temporary filename that doesn't already exist.
+--
+withTempFile :: FilePath -- ^ Temp dir to create the file in
+ -> String -- ^ File name template. See 'openTempFile'.
+ -> (FilePath -> Handle -> IO a) -> IO a
+withTempFile tmpDir template action =
+ bracket (openTempFile tmpDir template)
+ (\(name, handle) -> hClose handle >> removeFile name)
+ (uncurry action)
-- | The path name that represents the current directory.
-- In Unix, it's @\".\"@, but this is system-specific.