{- git-annex command - - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Command.Fsck where import qualified Data.Map as M import Command import Types import Core import Messages import qualified Command.FsckFile seek :: [SubCmdSeek] seek = [withNothing start, withAll withFilesInGit Command.FsckFile.start] {- Checks the whole annex for problems. -} start :: SubCmdStart start = do showStart "fsck" "" return $ Just perform perform :: SubCmdPerform perform = do ok <- checkUnused if ok then return $ Just $ return True else return Nothing checkUnused :: Annex Bool checkUnused = do showNote "checking for unused data..." unused <- unusedKeys if (null unused) then return True else do showLongNote $ w unused return False where w u = unlines $ [ "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 (\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 referenced <- getKeysReferenced -- Constructing a single map, of the set that tends to be smaller, -- appears more efficient in both memory and CPU than constructing -- and taking the M.difference of two maps. let present_m = existsMap present let unused_m = remove referenced present_m return $ M.keys unused_m where remove [] m = m remove (x:xs) m = remove xs $ M.delete x m existsMap :: Ord k => [k] -> M.Map k Int existsMap l = M.fromList $ map (\k -> (k, 1)) l