make work on windows

Utility/TempFile.hs

@@ -1,70 +1,71 @@
 {- temp file functions
  -
- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Utility.TempFile where
 
 import Control.Exception (bracket)
 import System.IO
-#ifndef mingw32_HOST_OS
-import System.Posix.Process
-#endif
 import System.Directory
+import Control.Monad.IfElse
 
 import Utility.Exception
-import Utility.Path
 import System.FilePath
 
+type Template = String
+
 {- Runs an action like writeFile, writing to a temp file first and
  - then moving it into place. The temp file is stored in the same
  - directory as the final file to avoid cross-device renames. -}
 viaTmp :: (FilePath -> String -> IO ()) -> FilePath -> String -> IO ()
-#ifndef mingw32_HOST_OS
 viaTmp a file content = do
-	pid <- getProcessID
+	let (dir, base) = splitFileName file
-	let tmpfile = file ++ ".tmp" ++ show pid
+	createDirectoryIfMissing True dir
-	createDirectoryIfMissing True (parentDir file)
+	(tmpfile, handle) <- openTempFile dir (base ++ ".tmp")
+	hClose handle
 	a tmpfile content
 	renameFile tmpfile file
-#else
-viaTmp = error "viaTMP TODO"
-#endif
 
-type Template = String
+{- Runs an action with a tmp file located in the system's tmp directory
-
+ - (or in "." if there is none) then removes the file. -}
-{- Runs an action with a temp file, then removes the file. -}
 withTempFile :: Template -> (FilePath -> Handle -> IO a) -> IO a
-withTempFile template a = bracket create remove use
+withTempFile template a = do
+	tmpdir <- catchDefaultIO "." getTemporaryDirectory
+	withTempFileIn tmpdir template a
+
+{- Runs an action with a tmp file located in the specified directory,
+ - then removes the file. -}
+withTempFileIn :: FilePath -> Template -> (FilePath -> Handle -> IO a) -> IO a
+withTempFileIn tmpdir template a = bracket create remove use
   where
-	create = do
+	create = openTempFile tmpdir template
-		tmpdir <- catchDefaultIO "." getTemporaryDirectory
-		openTempFile tmpdir template
 	remove (name, handle) = do
 		hClose handle
 		catchBoolIO (removeFile name >> return True)
 	use (name, handle) = a name handle
 
-{- Runs an action with a temp directory, then removes the directory and
+{- Runs an action with a tmp directory located within the system's tmp
- - all its contents. -}
+ - directory (or within "." if there is none), then removes the tmp
+ - directory and all its contents. -}
 withTempDir :: Template -> (FilePath -> IO a) -> IO a
-#ifndef mingw32_HOST_OS
+withTempDir template a = do
-withTempDir template = bracket create remove
+	tmpdir <- catchDefaultIO "." getTemporaryDirectory
+	withTempDirIn tmpdir template a
+
+{- Runs an action with a tmp directory located within a specified directory,
+ - then removes the tmp directory and all its contents. -}
+withTempDirIn :: FilePath -> Template -> (FilePath -> IO a) -> IO a
+withTempDirIn tmpdir template = bracket create remove
   where
-	remove = removeDirectoryRecursive
+	remove d = whenM (doesDirectoryExist d) $
+		removeDirectoryRecursive d
 	create = do
-		tmpdir <- catchDefaultIO "." getTemporaryDirectory
 		createDirectoryIfMissing True tmpdir
-		pid <- getProcessID
+		makenewdir (tmpdir </> template) (0 :: Int)
-		makedir tmpdir (template ++ show pid) (0 :: Int)
+	makenewdir t n = do
-	makedir tmpdir t n = do
+		let dir = t ++ "." ++ show n
-		let dir = tmpdir </> t ++ "." ++ show n
+		either (const $ makenewdir t $ n + 1) (const $ return dir)
-		r <- tryIO $ createDirectory dir
+			=<< tryIO (createDirectory dir)
-		either (const $ makedir tmpdir t $ n + 1) (const $ return dir) r
-#else
-withTempDir = error "withTempDir TODO"
-#endif