diff options
author | Joey Hess <joey@kitenet.net> | 2010-11-15 16:35:06 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-11-15 16:35:06 -0400 |
commit | 9dc43d25995b085745c16cc31ad11106a74a9973 (patch) | |
tree | d0a56e33033611ab6b6803549813ec31c9b46290 | |
parent | c305fb2bf318e72ea4f905a38733d93e9a81cc1d (diff) |
unused: New subcommand, finds unused data (the global part of fsck).
-rw-r--r-- | CmdLine.hs | 4 | ||||
-rw-r--r-- | Command/Fsck.hs | 52 | ||||
-rw-r--r-- | Command/Unused.hs | 66 | ||||
-rw-r--r-- | debian/changelog | 1 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 5 |
5 files changed, 78 insertions, 50 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index caf727946..cc163fff5 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -25,6 +25,7 @@ import qualified Command.SetKey import qualified Command.Fix import qualified Command.Init import qualified Command.Fsck +import qualified Command.Unused import qualified Command.Unlock import qualified Command.Lock import qualified Command.PreCommit @@ -62,6 +63,8 @@ subCmds = "fix up symlinks to point to annexed content" , SubCommand "fsck" maybepath Command.Fsck.seek "check for problems" + , SubCommand "unused" nothing Command.Unused.seek + "look for unused file content" , SubCommand "find" maybepath Command.Find.seek "lists available files" ] @@ -70,6 +73,7 @@ subCmds = maybepath = "[PATH ...]" key = "KEY ..." desc = "DESCRIPTION" + nothing = "" -- Each dashed command-line option results in generation of an action -- in the Annex monad that performs the necessary setting. diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 5b731a696..02b66d01a 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -14,55 +14,7 @@ import Types import Core import Messages import qualified Command.FsckFile +import qualified Command.Unused 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 +seek = [withNothing Command.Unused.start, withAll withFilesInGit Command.FsckFile.start] diff --git a/Command/Unused.hs b/Command/Unused.hs new file mode 100644 index 000000000..ed3de5d57 --- /dev/null +++ b/Command/Unused.hs @@ -0,0 +1,66 @@ +{- git-annex command + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Unused where + +import qualified Data.Map as M + +import Command +import Types +import Core +import Messages + +seek :: [SubCmdSeek] +seek = [withNothing start] + +{- Finds unused content in the annex. -} +start :: SubCmdStartNothing +start = do + showStart "unused" "" + 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 diff --git a/debian/changelog b/debian/changelog index 07eceae6c..dcdbe15e2 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,6 +1,7 @@ git-annex (0.07) UNRELEASED; urgency=low * find: New subcommand. + * unused: New subcommand, finds unused data (the global part of fsck). -- Joey Hess <joeyh@debian.org> Sun, 14 Nov 2010 12:34:49 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index c496ca0d8..a522534da 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -166,6 +166,11 @@ Many git-annex subcommands will stage changes for later `git commit` by you. With parameters, only the specified files are checked. +* unused + + Checks the annex for data that is not used by any files currently + in the annex, and prints a report. + * find [path ...] Outputs a list of annexed files whose content is currently present. |