From 8d5ebd16125af02902a4e437f9295ad732c4dd1f Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Wed, 11 Dec 2024 11:17:47 -0700 Subject: Atomically read and write to interface files. This sychronizes multiple processes so fiddle files can be effectively complied in parallel. --- src/Language/Fiddle/Compiler/ImportResolution.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) (limited to 'src/Language/Fiddle/Compiler/ImportResolution.hs') diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs index d4d6a05..5c09523 100644 --- a/src/Language/Fiddle/Compiler/ImportResolution.hs +++ b/src/Language/Fiddle/Compiler/ImportResolution.hs @@ -12,6 +12,7 @@ import qualified Codec.Compression.GZip as GZip import Control.Arrow (Arrow (second)) import Control.Monad (filterM, when) import Control.Monad.State (put) +import Control.Monad.Loops (untilM_) import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT)) import Control.Monad.Writer.Lazy (MonadTrans (lift), MonadWriter (tell), WriterT (..), execWriterT) import Data.Aeson (eitherDecode, encode) @@ -31,6 +32,7 @@ import Options.Applicative import System.Directory import System.FilePath import Text.Printf (printf) +import Control.Exception (uninterruptibleMask) data Flags = Flags { importDirectories :: [FilePath], @@ -265,7 +267,18 @@ getImportResolutionState parseFile compileToChecked flags unit = do writeInterfaceFile intfile val = do createDirectoryIfMissing True (takeDirectory intfile) - BL.writeFile intfile $ GZip.compress (encode val) + + -- Write to a temporary file and then rename it to make the write atomic. + let tmpIntFile = intfile <> ".tmp" + exists <- doesFileExist tmpIntFile + if exists + then do + -- Another process appears to be writing the file now. Wait for it to + -- complete. + untilM_ (return ()) (doesFileExist intfile) + else do + BL.writeFile tmpIntFile $ GZip.compress (encode val) + renameFile tmpIntFile intfile interfaceFileValid :: FilePath -> FilePath -> IO Bool interfaceFileValid originalPath intfPath = do -- cgit