unused: Now also lists files fsck places in .git/annex/bad/

1 files changed, 44 insertions, 32 deletions

diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 1eec68820..b129235e1 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -21,54 +21,66 @@ import qualified Annex
 import qualified Command.Drop
 import qualified Command.Move
 import qualified Remote
+import qualified GitRepo as Git
 import Backend
 import Key
 
+type UnusedMap = M.Map String Key
+
 command :: [Command]
 command = [repoCommand "dropunused" (paramRepeating paramNumber) seek
 	"drop unused file content"]
 
 seek :: [CommandSeek]
-seek = [withUnusedMap]
+seek = [withUnusedMaps]
 
-{- Read unusedlog once, and pass the map to each start action. -}
-withUnusedMap :: CommandSeek
-withUnusedMap params = do
-	m <- readUnusedLog
-	return $ map (start m) params
+{- Read unused logs once, and pass the maps to each start action. -}
+withUnusedMaps :: CommandSeek
+withUnusedMaps params = do
+	unused <- readUnusedLog ""
+	unusedbad <- readUnusedLog "bad"
+	unusedtmp <- readUnusedLog "tmp"
+	return $ map (start (unused, unusedbad, unusedtmp)) params
 
-start :: M.Map String Key -> CommandStartString
-start m s = notBareRepo $ do
-	case M.lookup s m of
-		Nothing -> return Nothing
-		Just key -> do
-			showStart "dropunused" s
-			from <- Annex.getState Annex.fromremote
-			case from of
-				Just name -> do
-					r <- Remote.byName name
-					return $ Just $ performRemote r key
-				_ -> return $ Just $ perform key
+start :: (UnusedMap, UnusedMap, UnusedMap) -> CommandStartString
+start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
+	[ (unused, perform)
+	, (unusedbad, performOther gitAnnexBadLocation)
+	, (unusedtmp, performOther gitAnnexTmpLocation)
+	]
+	where
+		search [] = return Nothing
+		search ((m, a):rest) = do
+			case M.lookup s m of
+				Nothing -> search rest
+				Just key -> do
+					showStart "dropunused" s
+					return $ Just $ a key
 
-{- drop both content in the backend and any tmp file for the key -}
 perform :: Key -> CommandPerform
 perform key = do
-	g <- Annex.gitRepo
-	let tmp = gitAnnexTmpLocation g key
-	tmp_exists <- liftIO $ doesFileExist tmp
-	when tmp_exists $ liftIO $ removeFile tmp
-	backend <- keyBackend key
-	Command.Drop.perform key backend (Just 0) -- force drop
+	from <- Annex.getState Annex.fromremote
+	case from of
+		Just name -> do
+			r <- Remote.byName name
+			showNote $ "from " ++ Remote.name r ++ "..."
+			return $ Just $ Command.Move.fromCleanup r True key
+		_ -> do
+			backend <- keyBackend key
+			Command.Drop.perform key backend (Just 0) -- force drop
 
-performRemote :: Remote.Remote Annex -> Key -> CommandPerform
-performRemote r key = do
-	showNote $ "from " ++ Remote.name r ++ "..."
-	return $ Just $ Command.Move.fromCleanup r True key
+performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
+performOther filespec key = do
+	g <- Annex.gitRepo
+	let f = filespec g key
+	e <- liftIO $ doesFileExist f
+	when e $ liftIO $ removeFile f
+	return $ Just $ return True
 
-readUnusedLog :: Annex (M.Map String Key)
-readUnusedLog = do
+readUnusedLog :: FilePath -> Annex UnusedMap
+readUnusedLog prefix = do
 	g <- Annex.gitRepo
-	let f = gitAnnexUnusedLog g
+	let f = gitAnnexUnusedLog prefix g
 	e <- liftIO $ doesFileExist f
 	if e
 		then do