From: Ian Lynagh <igloo@earth.li>
Date: Sun, 22 Jul 2007 01:02:05 +0000 (+0000)
Subject: Move open(Binary)TempFile to System.IO
X-Git-Tag: 2007-09-13~42
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0720957fe6b813845dc6e0239ab0ecdb2eb193cc;p=ghc-base.git

Move open(Binary)TempFile to System.IO
---

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 762083c..fc4d613 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -35,7 +35,7 @@ module GHC.Handle (
   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
 
   stdin, stdout, stderr,
-  IOMode(..), openFile, openBinaryFile, openTempFile, openBinaryTempFile, fdToHandle', fdToHandle,
+  IOMode(..), openFile, openBinaryFile, fdToHandle', fdToHandle,
   hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
   hFlush, hDuplicate, hDuplicateTo,
 
@@ -903,58 +903,6 @@ openFile' filepath mode binary =
     return h
 
 
--- | The function creates a temporary file in ReadWrite mode.
--- The created file isn\'t deleted automatically, so you need to delete it manually.
-openTempFile :: FilePath   -- ^ Directory in which to create the file
-             -> String     -- ^ File name template. If the template is \"foo.ext\" then
-                           -- the create file will be \"fooXXX.ext\" where XXX is some
-                           -- random number.
-             -> IO (FilePath, Handle)
-openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template dEFAULT_OPEN_IN_BINARY_MODE
-
--- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
-openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
-openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True
-
-openTempFile' :: String -> FilePath -> String -> Bool -> IO (FilePath, Handle)
-openTempFile' loc tmp_dir template binary = do
-  pid <- c_getpid
-  findTempName pid
-  where
-    (prefix,suffix) = break (=='.') template
-
-    oflags1 = rw_flags .|. o_EXCL
-
-    binary_flags
-      | binary    = o_BINARY
-      | otherwise = 0
-
-    oflags = oflags1 .|. binary_flags
-
-    findTempName x = do
-      fd <- withCString filepath $ \ f ->
-              c_open f oflags 0o666
-      if fd < 0 
-       then do
-         errno <- getErrno
-         if errno == eEXIST
-           then findTempName (x+1)
-           else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
-       else do
-         h <- fdToHandle' fd Nothing False filepath ReadWriteMode True
-	        `catchException` \e -> do c_close fd; throw e
-	 return (filepath, h)
-      where
-        filename        = prefix ++ show x ++ suffix
-        filepath        = tmp_dir ++ [pathSeparator] ++ filename
-
-pathSeparator :: Char
-#ifdef mingw32_HOST_OS
-pathSeparator = '\\'
-#else
-pathSeparator = '/'
-#endif
-
 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 output_flags = std_flags    .|. o_CREAT
 read_flags   = std_flags    .|. o_RDONLY 
diff --git a/System/IO.hs b/System/IO.hs
index 0179d8d..0d9d029 100644
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -163,6 +163,13 @@ module System.IO (
 #endif
   ) where
 
+import Data.Bits
+import Data.List
+import Data.Maybe
+import Foreign.C.Error
+import Foreign.C.String
+import System.Posix.Internals
+
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
 import GHC.IOBase	-- Together these four Prelude modules define
@@ -400,6 +407,67 @@ openBinaryFile = openFile
 hSetBinaryMode _ _ = return ()
 #endif
 
+-- | The function creates a temporary file in ReadWrite mode.
+-- The created file isn\'t deleted automatically, so you need to delete it manually.
+openTempFile :: FilePath   -- ^ Directory in which to create the file
+             -> String     -- ^ File name template. If the template is \"foo.ext\" then
+                           -- the create file will be \"fooXXX.ext\" where XXX is some
+                           -- random number.
+             -> IO (FilePath, Handle)
+openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template False
+
+-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
+openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
+openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True
+
+openTempFile' :: String -> FilePath -> String -> Bool -> IO (FilePath, Handle)
+openTempFile' loc tmp_dir template binary = do
+  pid <- c_getpid
+  findTempName pid
+  where
+    (prefix,suffix) = break (=='.') template
+
+    oflags1 = rw_flags .|. o_EXCL
+
+    binary_flags
+      | binary    = o_BINARY
+      | otherwise = 0
+
+    oflags = oflags1 .|. binary_flags
+
+    findTempName x = do
+      fd <- withCString filepath $ \ f ->
+              c_open f oflags 0o666
+      if fd < 0 
+       then do
+         errno <- getErrno
+         if errno == eEXIST
+           then findTempName (x+1)
+           else ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+       else do
+         h <- fdToHandle' fd Nothing False filepath ReadWriteMode True
+	        `catchException` \e -> do c_close fd; throw e
+	 return (filepath, h)
+      where
+        filename        = prefix ++ show x ++ suffix
+        filepath        = tmp_dir ++ [pathSeparator] ++ filename
+
+-- XXX Should use filepath library
+pathSeparator :: Char
+#ifdef mingw32_HOST_OS
+pathSeparator = '\\'
+#else
+pathSeparator = '/'
+#endif
+
+-- XXX Copied from GHC.Handle
+std_flags    = o_NONBLOCK   .|. o_NOCTTY
+output_flags = std_flags    .|. o_CREAT
+read_flags   = std_flags    .|. o_RDONLY
+write_flags  = output_flags .|. o_WRONLY
+rw_flags     = output_flags .|. o_RDWR
+append_flags = write_flags  .|. o_APPEND
+
 -- $locking
 -- Implementations should enforce as far as possible, at least locally to the
 -- Haskell process, multiple-reader single-writer locking on files.