-copyFile fromFPath toFPath = do
- -- We try removing the target file before opening it for
- -- writing. In the event that the target file is locked or in
- -- use, this allows us to replace it safely. However, it
- -- leaves a race condition: someone else might create the file
- -- after we delete it, but there isn't much we can do about
- -- that.
-#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
- contents <- readFile fromFPath
- try (removeFile toFPath)
- writeFile toFPath contents
- try (copyPermissions fromFPath toFPath)
- return ()
-#else
- (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom -> do
- try (removeFile toFPath)
- bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo -> do
- allocaBytes bufferSize $ \buffer -> do
- copyContents hFrom hTo buffer
- try (copyPermissions fromFPath toFPath)
- return ()) `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
-#endif
+copyFile fromFPath toFPath =
+ copy `catch` (\e -> case e of
+ IOException e ->
+ throw $ IOException $ ioeSetLocation e "copyFile"
+ _ -> throw e)
+ where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+ bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
+ do allocaBytes bufferSize $ copyContents hFrom hTmp
+ hClose hTmp
+ try (copyPermissions fromFPath toFPath)
+ renameFile tmpFPath toFPath
+ openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
+ cleanTmp (tmpFPath, hTmp) = do try $ hClose hTmp
+ try $ removeFile tmpFPath
+ bufferSize = 1024
+
+ copyContents hFrom hTo buffer = do
+ count <- hGetBuf hFrom buffer bufferSize
+ when (count > 0) $ do
+ hPutBuf hTo buffer count
+ copyContents hFrom hTo buffer