fix uninit to delete content from annex when it ended up hard linked back to the work tree

Annex/Content.hs

@@ -1,6 +1,6 @@
 {- git-annex file content managing
  -
- - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -10,6 +10,7 @@
 module Annex.Content (
 	inAnnex,
 	inAnnexSafe,
+	inAnnexCheck,
 	lockContent,
 	getViaTmp,
 	getViaTmpChecked,
@@ -56,7 +57,11 @@ import Annex.ReplaceFile
 
 {- Checks if a given key's content is currently present. -}
 inAnnex :: Key -> Annex Bool
-inAnnex = inAnnex' id False $ liftIO . doesFileExist
+inAnnex key = inAnnexCheck key $ liftIO . doesFileExist
+
+{- Runs an arbitrary check on a key's content. -}
+inAnnexCheck :: Key -> (FilePath -> Annex Bool) -> Annex Bool
+inAnnexCheck key check = inAnnex' id False check key
 
 {- Generic inAnnex, handling both indirect and direct mode.
  -

Command/Uninit.hs

@@ -63,8 +63,8 @@ start :: CommandStart
 start = next $ next $ do
 	annexdir <- fromRepo gitAnnexDir
 	annexobjectdir <- fromRepo gitAnnexObjectDir
-	present <- getKeysPresent
-	if null present
+	leftovers <- removeUnannexed =<< getKeysPresent
+	if null leftovers
 		then liftIO $ removeDirectoryRecursive annexdir
 		else error $ unlines
 			[ "Not fully uninitialized"
@@ -89,3 +89,21 @@ start = next $ next $ do
 	inRepo $ Git.Command.run
 		[Param "branch", Param "-D", Param $ show Annex.Branch.name]
 	liftIO exitSuccess
+
+{- Keys that were moved out of the annex have a hard link still in the
+ - annex, with > 1 link count, and those can be removed.
+ -
+ - Returns keys that cannot be removed. -}
+removeUnannexed :: [Key] -> Annex [Key]
+removeUnannexed = go []
+  where
+  	go c [] = return c
+	go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks)
+		( do
+			removeAnnex k
+			go c ks
+		, go (k:c) ks
+		)
+	enoughlinks f = do
+		s <- getFileStatus f
+		return $ linkCount s > 1