Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/597ea1f595ee5e8c8a928edcae83934a7064f099 >--------------------------------------------------------------- commit 597ea1f595ee5e8c8a928edcae83934a7064f099 Author: Duncan Coutts <[email protected]> Date: Mon Feb 2 01:19:17 2009 +0000 Add compat withTempDirectory function This is already in Cabal HEAD but we cannot use that yet >--------------------------------------------------------------- cabal-install/Distribution/Client/Utils.hs | 13 +++++++++- cabal-install/Distribution/Compat/TempFile.hs | 28 +++++++++++++++++++++++++ cabal-install/cabal-install.cabal | 1 + 3 files changed, 40 insertions(+), 2 deletions(-) diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs index 07a0b87..6e3d73c 100644 --- a/cabal-install/Distribution/Client/Utils.hs +++ b/cabal-install/Distribution/Client/Utils.hs @@ -13,9 +13,11 @@ import System.IO.Error ( isDoesNotExistError ) import System.Directory ( removeFile, renameFile, doesFileExist, getModificationTime - , getCurrentDirectory, setCurrentDirectory ) + , getCurrentDirectory, setCurrentDirectory, removeDirectoryRecursive ) +import Distribution.Compat.TempFile + ( createTempDirectory ) import qualified Control.Exception as Exception - ( handle, throwIO, evaluate, finally ) + ( handle, throwIO, evaluate, finally, bracket ) -- | Generic merging utility. For sorted input lists this is a full outer join. -- @@ -92,6 +94,13 @@ rewriteFile path newContent = mightNotExist e | isDoesNotExistError e = writeFile path newContent | otherwise = ioError e +--TODO: replace with function from Cabal utils in next version +withTempDirectory :: FilePath -> String -> (FilePath -> IO a) -> IO a +withTempDirectory targetDir template = + Exception.bracket + (createTempDirectory targetDir template) + (removeDirectoryRecursive) + -- | Executes the action in the specified directory. inDir :: Maybe FilePath -> IO () -> IO () inDir Nothing m = m diff --git a/cabal-install/Distribution/Compat/TempFile.hs b/cabal-install/Distribution/Compat/TempFile.hs new file mode 100644 index 0000000..0d56803 --- /dev/null +++ b/cabal-install/Distribution/Compat/TempFile.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -cpp #-} +{-# OPTIONS_NHC98 -cpp #-} +{-# OPTIONS_JHC -fcpp #-} +-- #hide +module Distribution.Compat.TempFile ( + createTempDirectory, + ) where + +import System.FilePath ((</>)) +import System.Posix.Internals (mkdir, c_getpid) +import Foreign.C (withCString, getErrno, eEXIST, errnoToIOError) + +createTempDirectory :: FilePath -> String -> IO FilePath +createTempDirectory dir template = do + pid <- c_getpid + findTempName pid + where + findTempName x = do + let dirpath = dir </> template ++ show x + res <- withCString dirpath $ \s -> mkdir s 0o700 + if res == 0 + then return dirpath + else do + errno <- getErrno + if errno == eEXIST + then findTempName (x+1) + else ioError (errnoToIOError "createTempDirectory" errno Nothing (Just dir)) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 7f36d81..6960733 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -67,6 +67,7 @@ Executable cabal Distribution.Client.Upload Distribution.Client.Utils Distribution.Client.Win32SelfUpgrade + Distribution.Compat.TempFile Paths_cabal_install build-depends: base >= 2 && < 4, _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
