diff options
| -rw-r--r-- | package.yaml | 1 | ||||
| -rw-r--r-- | src/Language/Fiddle/Compiler/ImportResolution.hs | 15 |
2 files changed, 15 insertions, 1 deletions
diff --git a/package.yaml b/package.yaml index 3940bd2..ced62e0 100644 --- a/package.yaml +++ b/package.yaml @@ -78,3 +78,4 @@ dependencies: - hspec - zlib - process + - monad-loops 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 |