Atomic transcript output file rewrites

lib/unison-prelude/src/Unison/Prelude.hs

@@ -5,6 +5,7 @@ module Unison.Prelude
     safeReadUtf8StdIn,
     writeUtf8,
     prependUtf8,
+    atomicallyReplaceFile,
     uncurry4,
     reportBug,
     tShow,
@@ -100,6 +101,8 @@ import Text.Read as X (readMaybe)
 import UnliftIO as X (MonadUnliftIO (..), askRunInIO, askUnliftIO, try, withUnliftIO)
 import UnliftIO qualified
 import UnliftIO.Directory qualified as UnliftIO
+import UnliftIO.IO (hClose)
+import UnliftIO.Temporary (withSystemTempFile)
 import Witch as X (From (from), TryFrom (tryFrom), TryFromException (TryFromException), into, tryInto)
 import Witherable as X (filterA, forMaybe, mapMaybe, wither, witherMap)
 
@@ -251,6 +254,16 @@ writeUtf8 fileName txt = do
     Handle.hSetEncoding handle IO.utf8
     Text.hPutStr handle txt
 
+-- | Atomically replace the contents of a file with some text
+-- Unfortunately this _still_ isn't atomic on Windows; but is still
+-- less likely to leave an empty file than writing directly to the output file.
+atomicallyReplaceFile :: (MonadIO m) => FilePath -> Text -> m ()
+atomicallyReplaceFile path txt = liftIO $ do
+  withSystemTempFile "temp" \fp outputHandle -> do
+    hClose outputHandle
+    liftIO $ writeUtf8 fp txt
+    UnliftIO.renameFile fp path
+
 -- | Atomically prepend some text to a file, creating the file if it doesn't already exist
 prependUtf8 :: FilePath -> Text -> IO ()
 prependUtf8 path txt = do

unison-cli/package.yaml

@@ -153,7 +153,6 @@ executables:
       - base
       - bytestring
       - code-page
-      - directory
       - easytest
       - filepath
       - megaparsec

unison-cli/transcripts/Transcripts.hs

@@ -11,7 +11,6 @@ import Data.List
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import EasyTest
-import System.Directory
 import System.Environment (getArgs)
 import System.FilePath
   ( replaceExtension,
@@ -30,6 +29,11 @@ import Unison.Codebase.Transcript.Runner as Transcript
 import Unison.Codebase.Verbosity qualified as Verbosity
 import Unison.Prelude
 import Unison.Util.Timing
+import UnliftIO.Directory
+  ( createDirectoryIfMissing,
+    listDirectory,
+    renameDirectory,
+  )
 import UnliftIO.STM qualified as STM
 
 data TestConfig = TestConfig
@@ -73,29 +77,29 @@ testBuilder expectFailure replaceOriginal recordFailure inputDir outputDir prelu
         case err of
           Transcript.PortBindingFailure -> do
             let errMsg = "Failed to bind codebase server to the default port when running transcripts in " <> filePath
-            io . writeUtf8 outputFile $ Text.pack errMsg
+            atomicallyReplaceFile outputFile $ Text.pack errMsg
             when (not expectFailure) $ do
               io $ recordFailure (inputDir </> filePath, Text.pack errMsg)
               crash errMsg
           Transcript.ParseError errors -> do
             let bundle = MP.errorBundlePretty errors
                 errMsg = "Error parsing " <> filePath <> ": " <> bundle
             -- Drop the file name, to avoid POSIX/Windows conflicts
-            io . writeUtf8 outputFile . Text.dropWhile (/= ':') $ Text.pack bundle
+            atomicallyReplaceFile outputFile . Text.dropWhile (/= ':') $ Text.pack bundle
             when (not expectFailure) $ do
               io $ recordFailure (inputDir </> filePath, Text.pack errMsg)
               crash errMsg
           Transcript.RunFailure errOutput -> do
             let errText = Transcript.format errOutput
-            io $ writeUtf8 outputFile errText
+            atomicallyReplaceFile outputFile errText
             when (not expectFailure) $ do
               io $ Text.putStrLn errText
               io $ recordFailure (inputDir </> filePath, errText)
               crash $ "Failure in " <> filePath
       (filePath, Right out) -> do
         let outputFile = outputDir </> if replaceOriginal then filePath else outputFileForTranscript filePath
         io . createDirectoryIfMissing True $ takeDirectory outputFile
-        io . writeUtf8 outputFile $ Transcript.format out
+        atomicallyReplaceFile outputFile $ Transcript.format out
         when expectFailure $ do
           let errMsg = "Expected a failure, but transcript was successful."
           io $ recordFailure (filePath, Text.pack errMsg)

unison-cli/unison-cli.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.38.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -359,7 +359,6 @@ executable transcripts
       base
     , bytestring
     , code-page
-    , directory
     , easytest
     , filepath
     , megaparsec