merge with git-repair

Command/SendKey.hs

@@ -46,6 +46,4 @@ fieldTransfer direction key a = do
 	ok <- maybe (a $ const noop)
 		(\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a)
 		=<< Fields.getField Fields.remoteUUID
-	liftIO $ if ok
+	liftIO $ exitBool ok
-		then exitSuccess
-		else exitFailure

Command/TransferKey.hs

@@ -56,4 +56,4 @@ fromPerform remote key file = go $
 		getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
 
 go :: Annex Bool -> CommandPerform
-go a = ifM a ( liftIO exitSuccess,  liftIO exitFailure)
+go a = a >>= liftIO . exitBool

Git/Repair.hs

@@ -8,6 +8,7 @@
 module Git.Repair (
 	runRepair,
 	runRepairOf,
+	successfulRepair,
 	cleanCorruptObjects,
 	retrieveMissingObjects,
 	resetLocalBranches,
@@ -452,6 +453,9 @@ runRepair forced g = do
 			putStrLn "No problems found."
 			return (True, S.empty, [])
 
+successfulRepair :: (Bool, MissingObjects, [Branch]) -> Bool
+successfulRepair = fst3
+
 runRepairOf :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, MissingObjects, [Branch])
 runRepairOf fsckresult forced referencerepo g = do
 	missing <- cleanCorruptObjects fsckresult g

Utility/Misc.hs

@@ -15,6 +15,7 @@ import Foreign
 import Data.Char
 import Data.List
 import Control.Applicative
+import System.Exit
 #ifndef mingw32_HOST_OS
 import System.Posix.Process (getAnyProcessStatus)
 import Utility.Exception
@@ -136,3 +137,7 @@ reapZombies = do
 #else
 reapZombies = return ()
 #endif
+
+exitBool :: Bool -> IO a
+exitBool False = exitFailure
+exitBool True = exitSuccess

Utility/Tmp.hs

@@ -62,7 +62,7 @@ withTmpDirIn :: FilePath -> Template -> (FilePath -> IO a) -> IO a
 withTmpDirIn tmpdir template = bracket create remove
   where
 	remove d = whenM (doesDirectoryExist d) $
-		removeDirectoryRecursive d
+		return () -- removeDirectoryRecursive d
 	create = do
 		createDirectoryIfMissing True tmpdir
 		makenewdir (tmpdir </> template) (0 :: Int)