Add replaceFile

Author: zlonast

.github/workflows/build.yml

@@ -14,17 +14,18 @@ jobs:
       fail-fast: false
       matrix:
         include:
-          - { os: macOS-13, stack: lts-15.3, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, unix-2.8.0.0" }
-          - { os: macos-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, file-io-0.1.4, filepath-1.5.2.0, os-string-2.0.2, unix-2.8.5.1", stack-package-flags: "{directory: {os-string: true}, file-io: {os-string: true}, unix: {os-string: true}}", ghc-flags: -Werror=deprecations }
-          - { os: ubuntu-latest, ghc: 8.10.7, cabal: 3.8.1.0 }
-          - { os: ubuntu-latest, ghc: 9.0.2, cabal: 3.8.1.0 }
-          - { os: ubuntu-latest, ghc: 9.2.4, cabal: 3.8.1.0 }
-          - { os: ubuntu-latest, ghc: 9.4.3, cabal: 3.8.1.0 }
+          # - { os: macOS-13, stack: lts-15.3, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, unix-2.8.0.0" }
+          # - { os: macos-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, file-io-0.1.4, filepath-1.5.2.0, os-string-2.0.2, unix-2.8.5.1", stack-package-flags: "{directory: {os-string: true}, file-io: {os-string: true}, unix: {os-string: true}}", ghc-flags: -Werror=deprecations }
+          # - { os: ubuntu-latest, ghc: 8.10.7, cabal: 3.8.1.0 }
+          # - { os: ubuntu-latest, ghc: 9.0.2, cabal: 3.8.1.0 }
+          # - { os: ubuntu-latest, ghc: 9.2.4, cabal: 3.8.1.0 }
+          # - { os: ubuntu-latest, ghc: 9.4.3, cabal: 3.8.1.0 }
           # TODO: Unpin cabal from 3.12.10 after https://github.com/haskell/cabal/issues/10718 is fixed.
-          - { os: ubuntu-latest, ghc: latest, cabal: 3.12.1.0, cabal-package-flags: +os-string, ghc-flags: -Werror=deprecations }
-          - { os: windows-latest, stack: lts-15.3, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, time-1.9.3, Win32-2.14.1.0", overrides: "before_prepare() { sed -i.bak -e /CreateSymbolicLinkW/d -e /GetFinalPathNameByHandleW/d configure.ac; }" }
-          - { os: windows-latest, stack: lts-17.5, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, time-1.9.3, Win32-2.14.1.0" }
+          # - { os: ubuntu-latest, ghc: latest, cabal: 3.12.1.0, cabal-package-flags: +os-string, ghc-flags: -Werror=deprecations }
+          # - { os: windows-latest, stack: lts-15.3, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, time-1.9.3, Win32-2.14.1.0", overrides: "before_prepare() { sed -i.bak -e /CreateSymbolicLinkW/d -e /GetFinalPathNameByHandleW/d configure.ac; }" }
+          # - { os: windows-latest, stack: lts-17.5, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, time-1.9.3, Win32-2.14.1.0" }
           - { os: windows-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, file-io-0.1.4, filepath-1.5.2.0, os-string-2.0.2, time-1.14, Win32-2.14.1.0", stack-package-flags: "{directory: {os-string: true}, file-io: {os-string: true}, Win32: {os-string: true}}", ghc-flags: -Werror=deprecations }
+          - { os: windows-latest, ghc: latest, cabal: 3.12.1.0, cabal-package-flags: +os-string, ghc-flags: -Werror=deprecations }
     runs-on: ${{ matrix.os }}
     env:
       CABAL_PACKAGE_FLAGS: ${{ matrix.cabal-package-flags }}

System/Directory.hs

@@ -50,6 +50,7 @@ module System.Directory
     , copyFile
     , copyFileWithMetadata
     , getFileSize
+    , replaceFile
 
     , canonicalizePath
     , makeAbsolute

System/Directory/Internal/Posix.hsc

@@ -85,6 +85,9 @@ removePathInternal False = Posix.removeLink . getOsString
 renamePathInternal :: OsPath -> OsPath -> IO ()
 renamePathInternal (OsString p1) (OsString p2) = Posix.rename p1 p2
 
+replaceFileInternal :: OsPath -> OsPath -> Maybe OsPath -> IO ()
+replaceFileInternal (OsString p1) (OsString p2) _ = Posix.rename p1 p2
+
 -- On POSIX, the removability of a file is only affected by the attributes of
 -- the containing directory.
 filesAlwaysRemovable :: Bool

System/Directory/Internal/Windows.hsc

@@ -98,6 +98,14 @@ renamePathInternal opath npath =
     npath' <- furnishPath npath
     Win32.moveFileEx opath' (Just npath') Win32.mOVEFILE_REPLACE_EXISTING
 
+replaceFileInternal :: OsPath -> OsPath -> Maybe OsPath -> IO ()
+replaceFileInternal replacedFile replacementFile mBackupFile =
+  (`ioeSetOsPath` replacedFile) `modifyIOError` do
+    replacedFile'    <- furnishPath replacedFile
+    replacementFile' <- furnishPath replacementFile
+    mBackupFile'     <- fmap furnishPath mBackupFile
+    Win32.replaceFile replacedFile' replacementFile' mBackupFile' Win32.rEPLACEFILE_IGNORE_MERGE_ERRORS
+
 -- On Windows, the removability of a file may be affected by the attributes of
 -- the file itself.
 filesAlwaysRemovable :: Bool

System/Directory/OsPath.hs

@@ -52,6 +52,7 @@ module System.Directory.OsPath
     , copyFile
     , copyFileWithMetadata
     , getFileSize
+    , replaceFile
 
     , canonicalizePath
     , makeAbsolute
@@ -709,6 +710,69 @@ renamePath opath npath =
   (`ioeAddLocation` "renamePath") `modifyIOError` do
     renamePathInternal opath npath
 
+-- | 'replaceFile' replaces one file with another file. The replacement file
+-- assumes the name of the replaced file and its identity.
+--
+-- This operation is atomic.
+--
+-- On the unix same as renamePath, on the Windows platform this is ReplaceFileW.
+--
+-- The operation on unix may fail with:
+--
+-- * @HardwareFault@
+-- A physical I\/O error has occurred.
+-- @[EIO]@
+--
+-- * @InvalidArgument@
+-- Either operand is not a valid file name.
+-- @[ENAMETOOLONG, ELOOP]@
+--
+-- * 'isDoesNotExistError'
+-- The original file does not exist, or there is no path to the target.
+-- @[ENOENT, ENOTDIR]@
+--
+-- * 'isPermissionError'
+-- The process has insufficient privileges to perform the operation.
+-- @[EROFS, EACCES, EPERM]@
+--
+-- * 'System.IO.isFullError'
+-- Insufficient resources are available to perform the operation.
+-- @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
+--
+-- * @UnsatisfiedConstraints@
+-- Implementation-dependent constraints are not satisfied.
+-- @[EBUSY]@
+--
+-- * @UnsupportedOperation@
+-- The implementation does not support renaming in this situation.
+-- @[EXDEV]@
+--
+-- * @InappropriateType@
+-- Either the destination path refers to an existing directory, or one of the
+-- parent segments in the destination path is not a directory.
+-- @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
+--
+-- The operation on Windows may fail with:
+--
+-- ERROR_UNABLE_TO_MOVE_REPLACEMENT 1176 (0x498)
+-- The replacement file could not be renamed. The replaced file no longer exists
+-- and the replacement file exists under its original name.
+-- 
+-- ERROR_UNABLE_TO_MOVE_REPLACEMENT_2 1177 (0x499)
+-- 
+-- The replacement file could not be moved. The replacement file still exists
+-- under its original name; however, it has inherited the file streams and
+-- attributes from the file it is replacing. The file to be replaced still
+-- exists with a different name.
+--
+-- ERROR_UNABLE_TO_REMOVE_REPLACED 1175 (0x497)
+-- The replaced file could not be deleted. The replaced and replacement files
+-- retain their original file names.
+replaceFile :: OsPath -> OsPath -> IO ()
+replaceFile opath npath =
+  (`ioeAddLocation` "replaceFile") `modifyIOError` do
+    replaceFileInternal opath npath Nothing
+
 -- | Copy a file with its permissions.  If the destination file already exists,
 -- it is replaced atomically.  Neither path may refer to an existing
 -- directory.  No exceptions are thrown if the permissions could not be

directory.cabal

@@ -63,7 +63,7 @@ Library
         file-io  >= 0.1.4 && < 0.2,
         time     >= 1.8.0 && < 1.15,
     if os(windows)
-        build-depends: Win32 >= 2.14.1.0 && < 2.15
+        build-depends: Win32 >= 2.14.2.0 && < 2.15
     else
         build-depends: unix >= 2.8.0 && < 2.9