[project @ 2004-07-30 23:29:41 by ross]

[haskell-directory.git] / System / Directory.hs

diff --git a/System/Directory.hs b/System/Directory.hs
index baa55ec..7d92473 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -28,6 +28,9 @@ module System.Directory
     -- * Actions on files
     , removeFile               -- :: FilePath -> IO ()
     , renameFile                -- :: FilePath -> FilePath -> IO ()
+#ifdef __GLASGOW_HASKELL__
+    , copyFile                  -- :: FilePath -> FilePath -> IO ()
+#endif
 
     -- * Existence tests
     , doesFileExist            -- :: FilePath -> IO Bool
@@ -62,6 +65,7 @@ import Hugs.Directory
 import Prelude
 
 import Control.Exception       ( bracket )
+import Control.Monad           ( when )
 import System.Posix.Types
 import System.Posix.Internals
 import System.Time             ( ClockTime(..) )
@@ -428,6 +432,28 @@ renameFile opath npath =
       withCString npath $ \s2 ->
          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 
+{- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
+If the /new/ file already exists, it is atomically replaced by the /old/ file.
+Neither path may refer to an existing directory.
+-}
+copyFile :: FilePath -> FilePath -> IO ()
+copyFile fromFPath toFPath =
+       (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+        bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
+        allocaBytes bufferSize $ \buffer ->
+               copyContents hFrom hTo buffer) `catch` (ioError . changeFunName)
+       where
+               bufferSize = 1024
+               
+               changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
+               
+               copyContents hFrom hTo buffer = do
+                       count <- hGetBuf hFrom buffer bufferSize
+                       when (count > 0) $ do
+                               hPutBuf hTo buffer count
+                               copyContents hFrom hTo buffer
+
+
 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 in /dir/.