diff options
Diffstat (limited to 'src/Language/Fiddle')
-rw-r--r-- | src/Language/Fiddle/Compiler/ImportResolution.hs | 15 |
1 files changed, 14 insertions, 1 deletions
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 |