summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-11-15 16:35:06 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-11-15 16:35:06 -0400
commit9dc43d25995b085745c16cc31ad11106a74a9973 (patch)
treed0a56e33033611ab6b6803549813ec31c9b46290
parentc305fb2bf318e72ea4f905a38733d93e9a81cc1d (diff)
unused: New subcommand, finds unused data (the global part of fsck).
-rw-r--r--CmdLine.hs4
-rw-r--r--Command/Fsck.hs52
-rw-r--r--Command/Unused.hs66
-rw-r--r--debian/changelog1
-rw-r--r--doc/git-annex.mdwn5
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.