summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-11-07 18:22:25 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-11-07 18:22:25 -0400
commit009873e0eb296b6f373f9f2d847659038a1d2bde (patch)
tree3a489ede8f5d70fd2a0cc8232fd75eec6435678c /Command
parent316264f3e8f6dbcbd2c3752566d7d754dbfe9994 (diff)
fsck works
Diffstat (limited to 'Command')
-rw-r--r--Command/Fsck.hs33
1 files changed, 28 insertions, 5 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index c86f30ff8..785aecd8a 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -7,10 +7,20 @@
module Command.Fsck where
+import qualified Data.Map as M
+import System.Directory
+import System.Posix.Files
+import Monad (filterM)
+import Control.Monad.State (liftIO)
+import Data.Maybe
+
import Command
import Types
import Core
-import qualified Data.Map as M
+import Locations
+import qualified Annex
+import qualified GitRepo as Git
+import qualified Backend
{- Checks the whole annex for problems. -}
start :: SubCmdStart
@@ -38,10 +48,12 @@ checkUnused = do
return False
where
w u = unlines $ [
- "Some annexed data is no longer pointed to by any file.",
+ "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 show u
+ ] ++ 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
@@ -62,8 +74,19 @@ existsMap l = M.fromList $ map (\k -> (k, 1)) l
getKeysPresent :: Annex [Key]
getKeysPresent = do
- return []
+ g <- Annex.gitRepo
+ let top = annexDir g
+ contents <- liftIO $ getDirectoryContents top
+ files <- liftIO $ filterM (isreg top) contents
+ return $ map fileKey files
+ where
+ isreg top f = do
+ s <- getFileStatus $ top ++ "/" ++ f
+ return $ isRegularFile s
getKeysReferenced :: Annex [Key]
getKeysReferenced = do
- return []
+ g <- Annex.gitRepo
+ files <- liftIO $ Git.inRepo g $ Git.workTree g
+ keypairs <- mapM Backend.lookupFile files
+ return $ map fst $ catMaybes keypairs