From: krasimir <unknown>
Date: Fri, 30 Jul 2004 06:16:00 +0000 (+0000)
Subject: [project @ 2004-07-30 06:16:00 by krasimir]
X-Git-Tag: nhc98-1-18-release~287
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c985d72d2f21068b54042bf4dd9bf5793d3bfc73;p=ghc-base.git

[project @ 2004-07-30 06:16:00 by krasimir]
add copyFile function
---

diff --git a/System/Directory.hs b/System/Directory.hs
index baa55ec..58d443c 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -62,6 +62,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 +429,29 @@ 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 = handle (changeFunName) $
+	(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
+		changeFunName e                             = e
+		
+		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/.