finished where indentation changes
This commit is contained in:
Joey Hess
parent
b77290cecc
commit
f87a781aa6
68 changed files with 1619 additions and 1628 deletions
|
|
@ -78,44 +78,44 @@ getDirInfo dir = do
|
|||
l <- filter (not . dirCruft) <$> getDirectoryContents dir
|
||||
contents <- S.fromList . catMaybes <$> mapM getDirEnt l
|
||||
return $ DirInfo dir contents
|
||||
where
|
||||
getDirEnt f = catchMaybeIO $ do
|
||||
s <- getFileStatus (dir </> f)
|
||||
return $ DirEnt f (fileID s) (isDirectory s)
|
||||
where
|
||||
getDirEnt f = catchMaybeIO $ do
|
||||
s <- getFileStatus (dir </> f)
|
||||
return $ DirEnt f (fileID s) (isDirectory s)
|
||||
|
||||
{- Difference between the dirCaches of two DirInfos. -}
|
||||
(//) :: DirInfo -> DirInfo -> [Change]
|
||||
oldc // newc = deleted ++ added
|
||||
where
|
||||
deleted = calc gendel oldc newc
|
||||
added = calc genadd newc oldc
|
||||
gendel x = (if isSubDir x then DeletedDir else Deleted) $
|
||||
dirName oldc </> dirEnt x
|
||||
genadd x = Added $ dirName newc </> dirEnt x
|
||||
calc a x y = map a $ S.toList $
|
||||
S.difference (dirCache x) (dirCache y)
|
||||
where
|
||||
deleted = calc gendel oldc newc
|
||||
added = calc genadd newc oldc
|
||||
gendel x = (if isSubDir x then DeletedDir else Deleted) $
|
||||
dirName oldc </> dirEnt x
|
||||
genadd x = Added $ dirName newc </> dirEnt x
|
||||
calc a x y = map a $ S.toList $
|
||||
S.difference (dirCache x) (dirCache y)
|
||||
|
||||
{- Builds a map of directories in a tree, possibly pruning some.
|
||||
- Opens each directory in the tree, and records its current contents. -}
|
||||
scanRecursive :: FilePath -> Pruner -> IO DirMap
|
||||
scanRecursive topdir prune = M.fromList <$> walk [] [topdir]
|
||||
where
|
||||
walk c [] = return c
|
||||
walk c (dir:rest)
|
||||
| prune dir = walk c rest
|
||||
| otherwise = do
|
||||
minfo <- catchMaybeIO $ getDirInfo dir
|
||||
case minfo of
|
||||
Nothing -> walk c rest
|
||||
Just info -> do
|
||||
mfd <- catchMaybeIO $
|
||||
openFd dir ReadOnly Nothing defaultFileFlags
|
||||
case mfd of
|
||||
Nothing -> walk c rest
|
||||
Just fd -> do
|
||||
let subdirs = map (dir </>) . map dirEnt $
|
||||
S.toList $ dirCache info
|
||||
walk ((fd, info):c) (subdirs ++ rest)
|
||||
where
|
||||
walk c [] = return c
|
||||
walk c (dir:rest)
|
||||
| prune dir = walk c rest
|
||||
| otherwise = do
|
||||
minfo <- catchMaybeIO $ getDirInfo dir
|
||||
case minfo of
|
||||
Nothing -> walk c rest
|
||||
Just info -> do
|
||||
mfd <- catchMaybeIO $
|
||||
openFd dir ReadOnly Nothing defaultFileFlags
|
||||
case mfd of
|
||||
Nothing -> walk c rest
|
||||
Just fd -> do
|
||||
let subdirs = map (dir </>) . map dirEnt $
|
||||
S.toList $ dirCache info
|
||||
walk ((fd, info):c) (subdirs ++ rest)
|
||||
|
||||
{- 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
|
||||
|
|
@ -131,16 +131,16 @@ removeSubDir :: DirMap -> FilePath -> IO DirMap
|
|||
removeSubDir dirmap dir = do
|
||||
mapM_ closeFd $ M.keys toremove
|
||||
return rest
|
||||
where
|
||||
(toremove, rest) = M.partition (dirContains dir . dirName) dirmap
|
||||
where
|
||||
(toremove, rest) = M.partition (dirContains dir . dirName) dirmap
|
||||
|
||||
findDirContents :: DirMap -> FilePath -> [FilePath]
|
||||
findDirContents dirmap dir = concatMap absolutecontents $ search
|
||||
where
|
||||
absolutecontents i = map (dirName i </>)
|
||||
(map dirEnt $ S.toList $ dirCache i)
|
||||
search = map snd $ M.toList $
|
||||
M.filter (\i -> dirName i == dir) dirmap
|
||||
where
|
||||
absolutecontents i = map (dirName i </>)
|
||||
(map dirEnt $ S.toList $ dirCache i)
|
||||
search = map snd $ M.toList $
|
||||
M.filter (\i -> dirName i == dir) dirmap
|
||||
|
||||
foreign import ccall safe "libkqueue.h init_kqueue" c_init_kqueue
|
||||
:: IO Fd
|
||||
|
|
@ -181,8 +181,8 @@ waitChange kq@(Kqueue h _ dirmap _) = do
|
|||
else case M.lookup changedfd dirmap of
|
||||
Nothing -> nochange
|
||||
Just info -> handleChange kq changedfd info
|
||||
where
|
||||
nochange = return (kq, [])
|
||||
where
|
||||
nochange = return (kq, [])
|
||||
|
||||
{- The kqueue interface does not tell what type of change took place in
|
||||
- the directory; it could be an added file, a deleted file, a renamed
|
||||
|
|
@ -196,36 +196,36 @@ waitChange kq@(Kqueue h _ dirmap _) = do
|
|||
handleChange :: Kqueue -> Fd -> DirInfo -> IO (Kqueue, [Change])
|
||||
handleChange kq@(Kqueue _ _ dirmap pruner) fd olddirinfo =
|
||||
go =<< catchMaybeIO (getDirInfo $ dirName olddirinfo)
|
||||
where
|
||||
go (Just newdirinfo) = do
|
||||
let changes = filter (not . pruner . changedFile) $
|
||||
olddirinfo // newdirinfo
|
||||
let (added, deleted) = partition isAdd changes
|
||||
where
|
||||
go (Just newdirinfo) = do
|
||||
let changes = filter (not . pruner . changedFile) $
|
||||
olddirinfo // newdirinfo
|
||||
let (added, deleted) = partition isAdd changes
|
||||
|
||||
-- Scan newly added directories to add to the map.
|
||||
-- (Newly added files will fail getDirInfo.)
|
||||
newdirinfos <- catMaybes <$>
|
||||
mapM (catchMaybeIO . getDirInfo . changedFile) added
|
||||
newmap <- addSubDirs dirmap pruner $ map dirName newdirinfos
|
||||
-- Scan newly added directories to add to the map.
|
||||
-- (Newly added files will fail getDirInfo.)
|
||||
newdirinfos <- catMaybes <$>
|
||||
mapM (catchMaybeIO . getDirInfo . changedFile) added
|
||||
newmap <- addSubDirs dirmap pruner $ map dirName newdirinfos
|
||||
|
||||
-- Remove deleted directories from the map.
|
||||
newmap' <- foldM removeSubDir newmap (map changedFile deleted)
|
||||
-- Remove deleted directories from the map.
|
||||
newmap' <- foldM removeSubDir newmap (map changedFile deleted)
|
||||
|
||||
-- Update the cached dirinfo just looked up.
|
||||
let newmap'' = M.insertWith' const fd newdirinfo newmap'
|
||||
-- Update the cached dirinfo just looked up.
|
||||
let newmap'' = M.insertWith' const fd newdirinfo newmap'
|
||||
|
||||
-- When new directories were added, need to update
|
||||
-- the kqueue to watch them.
|
||||
let kq' = kq { kqueueMap = newmap'' }
|
||||
unless (null newdirinfos) $
|
||||
updateKqueue kq'
|
||||
-- When new directories were added, need to update
|
||||
-- the kqueue to watch them.
|
||||
let kq' = kq { kqueueMap = newmap'' }
|
||||
unless (null newdirinfos) $
|
||||
updateKqueue kq'
|
||||
|
||||
return (kq', changes)
|
||||
go Nothing = do
|
||||
-- The directory has been moved or deleted, so
|
||||
-- remove it from our map.
|
||||
newmap <- removeSubDir dirmap (dirName olddirinfo)
|
||||
return (kq { kqueueMap = newmap }, [])
|
||||
return (kq', changes)
|
||||
go Nothing = do
|
||||
-- The directory has been moved or deleted, so
|
||||
-- remove it from our map.
|
||||
newmap <- removeSubDir dirmap (dirName olddirinfo)
|
||||
return (kq { kqueueMap = newmap }, [])
|
||||
|
||||
{- Processes changes on the Kqueue, calling the hooks as appropriate.
|
||||
- Never returns. -}
|
||||
|
|
@ -235,35 +235,33 @@ runHooks kq hooks = do
|
|||
-- to catch any files created beforehand.
|
||||
recursiveadd (kqueueMap kq) (Added $ kqueueTop kq)
|
||||
loop kq
|
||||
where
|
||||
loop q = do
|
||||
(q', changes) <- waitChange q
|
||||
forM_ changes $ dispatch (kqueueMap q')
|
||||
loop q'
|
||||
where
|
||||
loop q = do
|
||||
(q', changes) <- waitChange q
|
||||
forM_ changes $ dispatch (kqueueMap q')
|
||||
loop q'
|
||||
|
||||
dispatch _ change@(Deleted _) =
|
||||
callhook delHook Nothing change
|
||||
dispatch _ change@(DeletedDir _) =
|
||||
callhook delDirHook Nothing change
|
||||
dispatch dirmap change@(Added _) =
|
||||
withstatus change $ dispatchadd dirmap
|
||||
dispatch _ change@(Deleted _) =
|
||||
callhook delHook Nothing change
|
||||
dispatch _ change@(DeletedDir _) =
|
||||
callhook delDirHook Nothing change
|
||||
dispatch dirmap change@(Added _) =
|
||||
withstatus change $ dispatchadd dirmap
|
||||
|
||||
dispatchadd dirmap change s
|
||||
| Files.isSymbolicLink s =
|
||||
callhook addSymlinkHook (Just s) change
|
||||
| Files.isDirectory s = recursiveadd dirmap change
|
||||
| Files.isRegularFile s =
|
||||
callhook addHook (Just s) change
|
||||
| otherwise = noop
|
||||
dispatchadd dirmap change s
|
||||
| Files.isSymbolicLink s = callhook addSymlinkHook (Just s) change
|
||||
| Files.isDirectory s = recursiveadd dirmap change
|
||||
| Files.isRegularFile s = callhook addHook (Just s) change
|
||||
| otherwise = noop
|
||||
|
||||
recursiveadd dirmap change = do
|
||||
let contents = findDirContents dirmap $ changedFile change
|
||||
forM_ contents $ \f ->
|
||||
withstatus (Added f) $ dispatchadd dirmap
|
||||
recursiveadd dirmap change = do
|
||||
let contents = findDirContents dirmap $ changedFile change
|
||||
forM_ contents $ \f ->
|
||||
withstatus (Added f) $ dispatchadd dirmap
|
||||
|
||||
callhook h s change = case h hooks of
|
||||
Nothing -> noop
|
||||
Just a -> a (changedFile change) s
|
||||
callhook h s change = case h hooks of
|
||||
Nothing -> noop
|
||||
Just a -> a (changedFile change) s
|
||||
|
||||
withstatus change a = maybe noop (a change) =<<
|
||||
(catchMaybeIO (getSymbolicLinkStatus (changedFile change)))
|
||||
withstatus change a = maybe noop (a change) =<<
|
||||
(catchMaybeIO (getSymbolicLinkStatus (changedFile change)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue