From: ross <unknown>
Date: Tue, 15 Feb 2005 08:09:43 +0000 (+0000)
Subject: [project @ 2005-02-15 08:09:43 by ross]
X-Git-Tag: nhc98-1-18-release~18
X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=e0062ebb3e48285f0649cd3ef9d71135829ba965

[project @ 2005-02-15 08:09:43 by ross]
Hugs only: use binary handles for copyFile
---

diff --git a/System/Directory.hs b/System/Directory.hs
index 295d3a5..c6f3d66 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -77,6 +77,8 @@ import NHC.FFI
 
 #ifdef __HUGS__
 import Hugs.Directory
+import Control.Exception       ( bracket )
+import System.IO
 #endif /* __HUGS__ */
 
 #ifdef __GLASGOW_HASKELL__
@@ -491,7 +493,14 @@ Neither path may refer to an existing directory.
 -}
 copyFile :: FilePath -> FilePath -> IO ()
 copyFile fromFPath toFPath =
-#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
+#if defined(__HUGS__)
+	(bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+	 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo -> do
+	 hGetContents hFrom >>= hPutStr hTo
+	 try (getPermissions fromFPath >>= setPermissions toFPath)
+	 return ()) `catch` \err ->
+		ioError (annotateIOError err "copyFile" Nothing Nothing)
+#elif (!defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ <= 600)
 	do readFile fromFPath >>= writeFile toFPath
 	   try (getPermissions fromFPath >>= setPermissions toFPath)
 	   return ()