X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FDirectory.hs;h=c6f3d66663e01f73677da2d63f461c75e619306b;hb=e0062ebb3e48285f0649cd3ef9d71135829ba965;hp=a7839ea6b82d24093475d32767e7d2bbddf14fe3;hpb=ec3ba94b254bd444e7a1c560c1d91c4879948c69;p=haskell-directory.git

diff --git a/System/Directory.hs b/System/Directory.hs
index a7839ea..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 ()
@@ -519,7 +528,7 @@ copyFile fromFPath toFPath =
 -- canonicalized path, with the intent that two paths referring
 -- to the same file\/directory will map to the same canonicalized
 -- path. Note that it is impossible to guarantee that the
--- implication (same file\/dir <=> same canonicalizedPath) holds
+-- implication (same file\/dir \<=\> same canonicalizedPath) holds
 -- in either direction: this function can make only a best-effort
 -- attempt.
 canonicalizePath :: FilePath -> IO FilePath