robustness fixes
This commit is contained in:
parent
3d163f5ff9
commit
e164553272
1 changed files with 19 additions and 9 deletions
|
@ -12,6 +12,9 @@ module Utility.Kqueue (
|
||||||
stopKqueue,
|
stopKqueue,
|
||||||
waitChange,
|
waitChange,
|
||||||
Change(..),
|
Change(..),
|
||||||
|
changedFile,
|
||||||
|
isAdd,
|
||||||
|
isDelete,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
|
@ -60,10 +63,10 @@ getDirInfo dir = do
|
||||||
|
|
||||||
{- Difference between the dirCaches of two DirInfos. -}
|
{- Difference between the dirCaches of two DirInfos. -}
|
||||||
(//) :: DirInfo -> DirInfo -> [Change]
|
(//) :: DirInfo -> DirInfo -> [Change]
|
||||||
old // new = deleted ++ added
|
oldc // newc = deleted ++ added
|
||||||
where
|
where
|
||||||
deleted = calc Deleted old new
|
deleted = calc Deleted oldc newc
|
||||||
added = calc Added new old
|
added = calc Added newc oldc
|
||||||
calc a x y = map a . map (dirName x </>) $
|
calc a x y = map a . map (dirName x </>) $
|
||||||
S.toList $ S.difference (dirCache x) (dirCache y)
|
S.toList $ S.difference (dirCache x) (dirCache y)
|
||||||
|
|
||||||
|
@ -76,11 +79,18 @@ scanRecursive topdir prune = M.fromList <$> walk [] [topdir]
|
||||||
walk c (dir:rest)
|
walk c (dir:rest)
|
||||||
| prune dir = walk c rest
|
| prune dir = walk c rest
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
info <- getDirInfo dir
|
minfo <- catchMaybeIO $ getDirInfo dir
|
||||||
fd <- openFd dir ReadOnly Nothing defaultFileFlags
|
case minfo of
|
||||||
dirs <- filterM (\d -> doesDirectoryExist $ dir </> d)
|
Nothing -> walk c rest
|
||||||
(S.toList $ dirCache info)
|
Just info -> do
|
||||||
walk ((fd, info):c) (dirs++rest)
|
mfd <- catchMaybeIO $
|
||||||
|
openFd dir ReadOnly Nothing defaultFileFlags
|
||||||
|
case mfd of
|
||||||
|
Nothing -> walk c rest
|
||||||
|
Just fd -> do
|
||||||
|
let subdirs = map (dir </>) $
|
||||||
|
S.toList $ dirCache info
|
||||||
|
walk ((fd, info):c) (subdirs ++ rest)
|
||||||
|
|
||||||
{- Adds a list of subdirectories (and all their children), unless pruned to a
|
{- Adds a list of subdirectories (and all their children), unless pruned to a
|
||||||
- directory map. Adding a subdirectory that's already in the map will
|
- directory map. Adding a subdirectory that's already in the map will
|
||||||
|
@ -146,7 +156,7 @@ waitChange kq@(Kqueue h dirmap _) = do
|
||||||
- directories as necessary.
|
- directories as necessary.
|
||||||
-}
|
-}
|
||||||
handleChange :: Kqueue -> Fd -> DirInfo -> IO (Kqueue, [Change])
|
handleChange :: Kqueue -> Fd -> DirInfo -> IO (Kqueue, [Change])
|
||||||
handleChange kq@(Kqueue h dirmap pruner) fd olddirinfo =
|
handleChange (Kqueue h dirmap pruner) fd olddirinfo =
|
||||||
go =<< catchMaybeIO (getDirInfo $ dirName olddirinfo)
|
go =<< catchMaybeIO (getDirInfo $ dirName olddirinfo)
|
||||||
where
|
where
|
||||||
go (Just newdirinfo) = do
|
go (Just newdirinfo) = do
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue