aboutsummaryrefslogtreecommitdiff
path: root/Command/Fsck.hs
blob: 85a26a89b94a959c3f003a89d9f056453f029b08 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
{- 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 = [withString start, withAll withFilesInGit Command.FsckFile.start]

{- Checks the whole annex for problems, only if specific files were not
 - specified. -}
start :: SubCmdStartString
start whatspecified = do
	if (null whatspecified)
		then do
			showStart "fsck" ""
			return $ Just perform
		else do
			showStart "fsck" ""
			showNote "only checking specified files"
			return $ Just $ return $ Just $ return True

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