finished where indentation changes

This commit is contained in:
Joey Hess 2012-12-13 00:24:19 -04:00
parent b77290cecc
commit f87a781aa6
68 changed files with 1619 additions and 1628 deletions

View file

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