better method of waiting for new mtime

This will even work on eg FAT with its 1-2 second mtime granularity. And
without slowing down everything else.
This commit is contained in:
Joey Hess 2018-10-30 01:08:29 -04:00
parent c75807ba3a
commit 6956f533fe
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -504,14 +504,26 @@ content f
| "import" `isPrefixOf` f = "imported content" | "import" `isPrefixOf` f = "imported content"
| otherwise = "unknown file " ++ f | otherwise = "unknown file " ++ f
-- Writes new content to a file, and makes sure that it has a different
-- mtime than it did before
writecontent :: FilePath -> String -> IO () writecontent :: FilePath -> String -> IO ()
writecontent f c = do writecontent f c = go (10000000 :: Integer)
-- Delay 1/10th of a second, because filesystem's where
-- mtime resolution may not be very high, and we want to make sure go ticsleft = do
-- that git etc notices the file has been modified even when oldmtime <- catchMaybeIO $ getModificationTime f
-- multiple modifications happen close together. writeFile f c
threadDelay 100000 newmtime <- getModificationTime f
writeFile f c if Just newmtime == oldmtime
then do
threadDelay 100000
let ticsleft' = ticsleft - 100000
if ticsleft' > 0
then go ticsleft'
else do
hPutStrLn stderr "file mtimes do not seem to be changing (tried for 10 seconds)"
hFlush stderr
return ()
else return ()
changecontent :: FilePath -> IO () changecontent :: FilePath -> IO ()
changecontent f = writecontent f $ changedcontent f changecontent f = writecontent f $ changedcontent f