summaryrefslogtreecommitdiff
path: root/compiler/utils/Util.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/utils/Util.hs')
-rw-r--r--compiler/utils/Util.hs24
1 files changed, 23 insertions, 1 deletions
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index 16864fe017..41f63f2246 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -99,6 +99,7 @@ module Util (
doesDirNameExist,
getModificationUTCTime,
modificationTimeIfExists,
+ withAtomicRename,
global, consIORef, globalM,
sharedGlobal, sharedGlobalM,
@@ -145,9 +146,10 @@ import GHC.Stack (HasCallStack)
import Control.Applicative ( liftA2 )
import Control.Monad ( liftM, guard )
+import Control.Monad.IO.Class ( MonadIO, liftIO )
import GHC.Conc.Sync ( sharedCAF )
import System.IO.Error as IO ( isDoesNotExistError )
-import System.Directory ( doesDirectoryExist, getModificationTime )
+import System.Directory ( doesDirectoryExist, getModificationTime, renameFile )
import System.FilePath
import Data.Char ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit, toUpper
@@ -1304,6 +1306,26 @@ modificationTimeIfExists f = do
else ioError e
-- --------------------------------------------------------------
+-- atomic file writing by writing to a temporary file first (see #14533)
+--
+-- This should be used in all cases where GHC writes files to disk
+-- and uses their modification time to skip work later,
+-- as otherwise a partially written file (e.g. due to crash or Ctrl+C)
+-- also results in a skip.
+
+withAtomicRename :: (MonadIO m) => FilePath -> (FilePath -> m a) -> m a
+withAtomicRename targetFile f = do
+ -- The temp file must be on the same file system (mount) as the target file
+ -- to result in an atomic move on most platforms.
+ -- The standard way to ensure that is to place it into the same directory.
+ -- This can still be fooled when somebody mounts a different file system
+ -- at just the right time, but that is not a case we aim to cover here.
+ let temp = targetFile <.> "tmp"
+ res <- f temp
+ liftIO $ renameFile temp targetFile
+ return res
+
+-- --------------------------------------------------------------
-- split a string at the last character where 'pred' is True,
-- returning a pair of strings. The first component holds the string
-- up (but not including) the last character for which 'pred' returned