diff options
Diffstat (limited to 'Command/Fsck.hs')
| -rw-r--r-- | Command/Fsck.hs | 33 |
1 files changed, 28 insertions, 5 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs index c86f30ff8..785aecd8a 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -7,10 +7,20 @@ module Command.Fsck where +import qualified Data.Map as M +import System.Directory +import System.Posix.Files +import Monad (filterM) +import Control.Monad.State (liftIO) +import Data.Maybe + import Command import Types import Core -import qualified Data.Map as M +import Locations +import qualified Annex +import qualified GitRepo as Git +import qualified Backend {- Checks the whole annex for problems. -} start :: SubCmdStart @@ -38,10 +48,12 @@ checkUnused = do return False where w u = unlines $ [ - "Some annexed data is no longer pointed to by any file.", + "Some annexed data is no longer pointed to by any files in the repository.", "If this data is no longer needed, it can be removed using git-annex dropkey:" - ] ++ map show u + ] ++ map (\k -> " " ++ show k) u +{- Finds keys whose content is present, but that do not seem to be used + - by any files in the git repo. -} unusedKeys :: Annex [Key] unusedKeys = do present <- getKeysPresent @@ -62,8 +74,19 @@ existsMap l = M.fromList $ map (\k -> (k, 1)) l getKeysPresent :: Annex [Key] getKeysPresent = do - return [] + g <- Annex.gitRepo + let top = annexDir g + contents <- liftIO $ getDirectoryContents top + files <- liftIO $ filterM (isreg top) contents + return $ map fileKey files + where + isreg top f = do + s <- getFileStatus $ top ++ "/" ++ f + return $ isRegularFile s getKeysReferenced :: Annex [Key] getKeysReferenced = do - return [] + g <- Annex.gitRepo + files <- liftIO $ Git.inRepo g $ Git.workTree g + keypairs <- mapM Backend.lookupFile files + return $ map fst $ catMaybes keypairs |