add reflog

Git/RecoverRepository.hs

@@ -23,6 +23,7 @@ import qualified Git.Config
 import qualified Git.Construct
 import qualified Git.LsTree as LsTree
 import qualified Git.Ref as Ref
+import qualified Git.RefLog as RefLog
 import Utility.Tmp
 import Utility.Rsync
 
@@ -186,16 +187,8 @@ resetLocalBranches missing goodcommits r =
 					reset b c
 					go (b:changed) deleted gcs' bs
 			Nothing -> do
-				(mc', gcs'') <- findOldBranch missing gcs' b r
+				nukeBranchRef b r
-				case mc' of
+				go changed (b:deleted) gcs' bs
-					Just c
-						| c == b -> go changed deleted gcs' bs
-						| otherwise -> do
-							reset b c
-							go (b:changed) deleted gcs'' bs
-					Nothing -> do
-						nukeBranchRef b r
-						go changed (b:deleted) gcs'' bs
 	reset b c = do
 		nukeBranchRef b	r
 		void $ runBool
@@ -274,7 +267,9 @@ nukeBranchRef b r = void $ usegit <||> byhand
 {- Finds the most recent commit to a branch that does not need any
  - of the missing objects. If the input branch is good as-is, returns it.
  - Otherwise, tries to traverse the commits in the branch to find one
- - that is ok (might fail, if one of them is corrupt).
+ - that is ok. That might fail, if one of them is corrupt, or if an object
+ - at the root of the branch is missing. Finally, looks for an old version
+ - of the branch from the reflog.
  -}
 findUncorruptedCommit :: MissingObjects -> GoodCommits -> Branch -> Repo -> IO (Maybe Sha, GoodCommits)
 findUncorruptedCommit missing goodcommits branch r = do
@@ -288,7 +283,12 @@ findUncorruptedCommit missing goodcommits branch r = do
 				, Param "--format=%H"
 				, Param (show branch)
 				] r
-			cleanup `after` findfirst goodcommits (catMaybes $ map extractSha ls)
+			let branchshas = catMaybes $ map extractSha ls
+			reflogshas <- RefLog.get branch r
+			-- XXX Could try a bit harder here, and look
+			-- for uncorrupted old commits in branches in the
+			-- reflog.
+			cleanup `after` findfirst goodcommits (branchshas ++ reflogshas)
   where
 	findfirst gcs [] = return (Nothing, gcs)
 	findfirst gcs (c:cs) = do
@@ -297,12 +297,6 @@ findUncorruptedCommit missing goodcommits branch r = do
 			then return (Just c, gcs')
 			else findfirst gcs' cs
 
-{- Looks through the reflog to find an old version of a branch that
- - does not need any of the missing objects.
- -}
-findOldBranch :: MissingObjects -> GoodCommits -> Branch -> Repo -> IO (Maybe Sha, GoodCommits)
-findOldBranch missing goodcommits branch r = error "TODO"
-
 {- Verifies tha none of the missing objects in the set are used by
  - the commit. Also adds to a set of commit shas that have been verified to
  - be good, which can be passed into subsequent calls to avoid

Git/RefLog.hs

@@ -0,0 +1,23 @@
+{- git reflog interface
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.RefLog where
+
+import Common
+import Git
+import Git.Command
+import Git.Sha
+import Git.CatFile
+
+{- Gets the reflog for a given branch. -}
+get :: Branch -> Repo -> IO [Sha]
+get b = mapMaybe extractSha . lines <$$> pipeReadStrict
+	[ Param "log"
+	, Param "-g"
+	, Param "--format=%H"
+	, Param (show b)
+	]

git-recover-repository.hs

@@ -35,7 +35,7 @@ parseArgs = do
 enableDebugOutput :: IO ()
 enableDebugOutput = do
 	s <- setFormatter
-		<$> streamHandler stderr DEBUG -- NOTICE
+		<$> streamHandler stderr NOTICE
 		<*> pure (simpleLogFormatter "$msg")
 	updateGlobalLogger rootLoggerName (setLevel DEBUG . setHandlers [s])