Commit 1f9c6674 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Fix the FileMonitor to keep multiple monitors for the same file

Rather than doing any fancy merging of monitor kinds, we just do the
simple thing and keep each monitor spec separately, so each one will be
checked when the file system is probed. Internally, rather than keeping
a Map indexed by FilePath we just keep a list.

Add a regression test for this.
parent 902fae64
......@@ -199,7 +199,7 @@ monitorFileHashedSearchPath notFoundAtPaths foundAtPath =
-- files to be monitored (index by their path), and a list of
-- globs, which monitor may files at once.
data MonitorStateFileSet
= MonitorStateFileSet !(Map FilePath MonitorStateFile)
= MonitorStateFileSet ![MonitorStateFile]
![MonitorStateGlob]
deriving Show
......@@ -216,7 +216,7 @@ type Hash = Int
-- no longer exists at all.
--
data MonitorStateFile = MonitorStateFile !MonitorKindFile !MonitorKindDir
!MonitorStateFileStatus
!FilePath !MonitorStateFileStatus
deriving (Show, Generic)
data MonitorStateFileStatus
......@@ -262,11 +262,10 @@ instance Binary MonitorStateGlobRel
--
reconstructMonitorFilePaths :: MonitorStateFileSet -> [MonitorFilePath]
reconstructMonitorFilePaths (MonitorStateFileSet singlePaths globPaths) =
Map.foldrWithKey (\k x r -> getSinglePath k x : r)
(map getGlobPath globPaths)
singlePaths
map getSinglePath singlePaths
++ map getGlobPath globPaths
where
getSinglePath filepath (MonitorStateFile kindfile kinddir _) =
getSinglePath (MonitorStateFile kindfile kinddir filepath _) =
MonitorFile kindfile kinddir filepath
getGlobPath (MonitorStateGlob kindfile kinddir root gstate) =
......@@ -516,7 +515,7 @@ probeFileSystem root (MonitorStateFileSet singlePaths globPaths) =
runChangedM $ do
sequence_
[ probeMonitorStateFileStatus root file status
| (file, MonitorStateFile _ _ status) <- Map.toList singlePaths ]
| MonitorStateFile _ _ file status <- singlePaths ]
-- The glob monitors can require state changes
globPaths' <-
sequence
......@@ -793,19 +792,19 @@ buildMonitorStateFileSet :: Maybe MonitorTimestamp -- ^ optional: timestamp
-- relative to root
-> IO MonitorStateFileSet
buildMonitorStateFileSet mstartTime hashcache root =
go Map.empty []
go [] []
where
go :: Map FilePath MonitorStateFile -> [MonitorStateGlob]
go :: [MonitorStateFile] -> [MonitorStateGlob]
-> [MonitorFilePath] -> IO MonitorStateFileSet
go !singlePaths !globPaths [] =
return (MonitorStateFileSet singlePaths globPaths)
return (MonitorStateFileSet (reverse singlePaths) (reverse globPaths))
go !singlePaths !globPaths
(MonitorFile kindfile kinddir path : monitors) = do
monitorState <- MonitorStateFile kindfile kinddir
monitorState <- MonitorStateFile kindfile kinddir path
<$> buildMonitorStateFile mstartTime hashcache
kindfile kinddir root path
go (Map.insert path monitorState singlePaths) globPaths monitors
go (monitorState : singlePaths) globPaths monitors
go !singlePaths !globPaths
(MonitorFileGlob kindfile kinddir globPath : monitors) = do
......@@ -976,15 +975,15 @@ readCacheFileHashes monitor =
collectAllFileHashes singlePaths
`Map.union` collectAllGlobHashes globPaths
collectAllFileHashes =
Map.mapMaybe $ \(MonitorStateFile _ _ fstate) -> case fstate of
MonitorStateFileHashed mtime hash -> Just (mtime, hash)
_ -> Nothing
collectAllFileHashes singlePaths =
Map.fromList [ (fpath, (mtime, hash))
| MonitorStateFile _ _ fpath
(MonitorStateFileHashed mtime hash) <- singlePaths ]
collectAllGlobHashes globPaths =
Map.fromList [ (fpath, hash)
Map.fromList [ (fpath, (mtime, hash))
| MonitorStateGlob _ _ _ gstate <- globPaths
, (fpath, hash) <- collectGlobHashes "" gstate ]
, (fpath, (mtime, hash)) <- collectGlobHashes "" gstate ]
collectGlobHashes dir (MonitorStateGlobDirs _ _ _ entries) =
[ res
......
......@@ -34,6 +34,7 @@ tests mtimeChange =
, testCase "remove file" testRemoveFile
, testCase "non-existent file" testNonExistentFile
, testCase "changed file type" $ testChangedFileType mtimeChange
, testCase "several monitor kinds" $ testMultipleMonitorKinds mtimeChange
, testGroup "glob matches"
[ testCase "no change" testGlobNoChange
......@@ -328,6 +329,34 @@ testChangedFileType mtimeChange = do
reason <- expectMonitorChanged root monitor ()
reason @?= MonitoredFileChanged "a"
-- Monitoring the same file with two different kinds of monitor should work
-- both should be kept, and both checked for changes.
-- We had a bug where only one monitor kind was kept per file.
-- https://github.com/haskell/cabal/pull/3863#issuecomment-248495178
testMultipleMonitorKinds :: Int -> Assertion
testMultipleMonitorKinds mtimeChange =
withFileMonitor $ \root monitor -> do
touchFile root "a"
updateMonitor root monitor [monitorFile "a", monitorFileHashed "a"] () ()
(res, files) <- expectMonitorUnchanged root monitor ()
res @?= ()
files @?= [monitorFile "a", monitorFileHashed "a"]
threadDelay mtimeChange
touchFile root "a" -- not changing content, just mtime
reason <- expectMonitorChanged root monitor ()
reason @?= MonitoredFileChanged "a"
createDir root "dir"
updateMonitor root monitor [monitorDirectory "dir",
monitorDirectoryExistence "dir"] () ()
(res2, files2) <- expectMonitorUnchanged root monitor ()
res2 @?= ()
files2 @?= [monitorDirectory "dir", monitorDirectoryExistence "dir"]
threadDelay mtimeChange
touchFile root ("dir" </> "a") -- changing dir mtime, not existence
reason2 <- expectMonitorChanged root monitor ()
reason2 @?= MonitoredFileChanged "dir"
------------------
-- globs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment