add explict test that a closed file even is on a regular file
There are two reasons for this test. First, there could be a fifo or other non-regular file that was closed. Second, this test avoids ugliness when a subdirectory is moved out of the top of the watch directory to elsewhere, and a file added to it. Since the subdirectory has moved, the file won't be present under the old location, and nothing will be done. I cannot find a way to stop watching such directories, at least not without a lot of pain. The inotify interface in Haskell doesn't make it easy to stop watching a given subdirectory when it's moved out; it would require keeping a map of all watch handles that is shared between threads. This workaround avoids the problem in most cases; the only remaining case being deletion of a file from a moved subdirectory.
This commit is contained in:
parent
59ce18d757
commit
fa9d479fd1
1 changed files with 6 additions and 5 deletions
|
@ -86,13 +86,13 @@ watchDir i dir ignored add addsymlink del deldir
|
|||
go (Created { isDirectory = True, filePath = subdir }) = recurse $ indir subdir
|
||||
go (Created { isDirectory = False, filePath = f })
|
||||
| isJust addsymlink =
|
||||
ifM (catchBoolIO $ Files.isSymbolicLink <$> getSymbolicLinkStatus (indir f))
|
||||
( addsymlink <@> f
|
||||
, noop
|
||||
)
|
||||
whenM (filetype Files.isSymbolicLink f) $
|
||||
addsymlink <@> f
|
||||
| otherwise = noop
|
||||
-- Closing a file is assumed to mean it's done being written.
|
||||
go (Closed { isDirectory = False, maybeFilePath = Just f }) = add <@> f
|
||||
go (Closed { isDirectory = False, maybeFilePath = Just f }) =
|
||||
whenM (filetype Files.isRegularFile f) $
|
||||
add <@> f
|
||||
-- When a file or directory is moved in, walk it to add new
|
||||
-- stuff.
|
||||
go (MovedIn { filePath = f }) = walk f
|
||||
|
@ -106,6 +106,7 @@ watchDir i dir ignored add addsymlink del deldir
|
|||
Nothing <@> _ = noop
|
||||
|
||||
indir f = dir </> f
|
||||
filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir f)
|
||||
|
||||
{- Pauses the main thread, letting children run until program termination. -}
|
||||
waitForTermination :: IO ()
|
||||
|
|
Loading…
Reference in a new issue