robustness fixes

This commit is contained in:
Joey Hess 2012-06-19 02:13:26 +00:00
parent 3d163f5ff9
commit e164553272

View file

@ -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