git-annex/Command/Fsck.hs

{- git-annex command
 -
 - Copyright 2010 Joey Hess <joey@kitenet.net>
 -
 - 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, only if specific files were not
 - specified. -}
start :: SubCmdStartNothing
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