diff options
author | Joey Hess <joey@kitenet.net> | 2013-03-11 01:22:56 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-03-11 01:22:56 -0400 |
commit | 5f6a8cd075968bf7014f9b0ef165f2ca3c07a585 (patch) | |
tree | 42da56040bcfea26e02874950f82243020dbdb8e /Command/Unused.hs | |
parent | 3529ab26188f49250ca2b8d254594e72e4aaeabb (diff) |
status: Can now be run with a directory path to show only the status of that directory, rather than the whole annex.
Diffstat (limited to 'Command/Unused.hs')
-rw-r--r-- | Command/Unused.hs | 32 |
1 files changed, 19 insertions, 13 deletions
diff --git a/Command/Unused.hs b/Command/Unused.hs index 64a619b0a..25cd18c63 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -213,36 +213,42 @@ bloomFilter convert l bloom = filter (\k -> convert k `notElemB` bloom) l {- Given an initial value, folds it with each key referenced by - symlinks in the git repo. -} withKeysReferenced :: v -> (Key -> v -> v) -> Annex v -withKeysReferenced initial a = withKeysReferenced' initial folda +withKeysReferenced initial a = withKeysReferenced' Nothing initial folda where - folda k v = return $ a k v + folda k _ v = return $ a k v {- Runs an action on each referenced key in the git repo. -} withKeysReferencedM :: (Key -> Annex ()) -> Annex () -withKeysReferencedM a = withKeysReferenced' () calla +withKeysReferencedM a = withKeysReferenced' Nothing () calla where - calla k _ = a k + calla k _ _ = a k -withKeysReferenced' :: v -> (Key -> v -> Annex v) -> Annex v -withKeysReferenced' initial a = do +{- Folds an action over keys and files referenced in a particular directory. -} +withKeysFilesReferencedIn :: FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v +withKeysFilesReferencedIn = withKeysReferenced' . Just + +withKeysReferenced' :: Maybe FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v +withKeysReferenced' mdir initial a = do (files, clean) <- getfiles r <- go initial files liftIO $ void clean return r where - getfiles = ifM isBareRepo - ( return ([], return True) - , do - top <- fromRepo Git.repoPath - inRepo $ LsFiles.inRepo [top] - ) + getfiles = case mdir of + Nothing -> ifM isBareRepo + ( return ([], return True) + , do + top <- fromRepo Git.repoPath + inRepo $ LsFiles.inRepo [top] + ) + Just dir -> inRepo $ LsFiles.inRepo [dir] go v [] = return v go v (f:fs) = do x <- Backend.lookupFile f case x of Nothing -> go v fs Just (k, _) -> do - !v' <- a k v + !v' <- a k f v go v' fs withKeysReferencedInGit :: (Key -> Annex ()) -> Annex () |