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:
parent
c75807ba3a
commit
6956f533fe
1 changed files with 19 additions and 7 deletions
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue