diff options
| -rw-r--r-- | Branch.hs | 9 | ||||
| -rw-r--r-- | Command/Unused.hs | 4 | ||||
| -rw-r--r-- | LocationLog.hs | 21 |
3 files changed, 12 insertions, 22 deletions
@@ -11,7 +11,7 @@ module Branch ( get, change, commit, - shortref + files ) where import Control.Monad (unless, when, liftM) @@ -222,3 +222,10 @@ cmdOutput cmd params = do let rv = seq retval retval _ <- getProcessStatus True False pid return rv + +{- Lists all files on the branch. -} +files :: Annex [FilePath] +files = withIndexUpdate $ do + g <- Annex.gitRepo + liftIO $ Git.pipeNullSplit g + [Params "ls-tree --name-only -r -z", Param fullname] diff --git a/Command/Unused.hs b/Command/Unused.hs index 5d4e433ad..51964cc57 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -66,10 +66,8 @@ checkRemoteUnused name = do checkRemoteUnused' :: Remote.Remote Annex -> Annex () checkRemoteUnused' r = do showNote $ "checking for unused data..." - g <- Annex.gitRepo referenced <- getKeysReferenced - logged <- loggedKeys g - remotehas <- filterM isthere logged + remotehas <- filterM isthere =<< loggedKeys let remoteunused = remotehas `exclude` referenced let list = number 0 remoteunused writeUnusedFile "" list diff --git a/LocationLog.hs b/LocationLog.hs index 8dbeb729c..4e2caca95 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -26,7 +26,6 @@ module LocationLog ( import Data.Time.Clock.POSIX import Data.Time import System.Locale -import System.Directory import System.FilePath import qualified Data.Map as Map import Control.Monad (when) @@ -35,7 +34,6 @@ import Control.Monad.State (liftIO) import qualified GitRepo as Git import qualified Branch -import Utility import UUID import Types import Locations @@ -148,19 +146,6 @@ mapLog m l = {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} -loggedKeys :: Git.Repo -> Annex [Key] -loggedKeys repo = do - _ <- error "FIXME.. does not look in git-annex branch yet" - exists <- liftIO $ doesDirectoryExist dir - if exists - then do - -- 2 levels of hashing - levela <- liftIO $ dirContents dir - levelb <- mapM tryDirContents levela - files <- mapM tryDirContents (concat levelb) - return $ catMaybes $ - map (logFileKey . takeFileName) (concat files) - else return [] - where - tryDirContents d = liftIO $ catch (dirContents d) (return . const []) - dir = gitStateDir repo +loggedKeys :: Annex [Key] +loggedKeys = + return . catMaybes . map (logFileKey . takeFileName) =<< Branch.files |