fsck works

2 files changed, 29 insertions, 6 deletions

diff --git a/Backend.hs b/Backend.hs
index e2c8a43b6..456a98bd4 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -107,7 +107,7 @@ retrieveKeyFile backend key dest = (Internals.retrieveKeyFile backend) key dest
 removeKey :: Backend -> Key -> Annex Bool
 removeKey backend key = (Internals.removeKey backend)  key
 
-{- Checks if a backend has its key. -}
+{- Checks if a key is present in its backend. -}
 hasKey :: Key -> Annex Bool
 hasKey key = do
 	bs <- Annex.supportedBackends
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