broke out Git/Branch.hs and reorganized

2 files changed, 207 insertions, 190 deletions

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index c8a538acd..42940f4ff 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -6,15 +6,15 @@
  -}
 
 module Annex.Branch (
+	name,
+	hasOrigin,
+	hasSibling,
 	create,
 	update,
 	get,
 	change,
 	commit,
 	files,
-	name,
-	hasOrigin,
-	hasSibling,
 ) where
 
 import System.Exit
@@ -27,6 +27,7 @@ import Annex.Journal
 import qualified Git
 import qualified Git.UnionMerge
 import qualified Git.Ref
+import qualified Git.Branch
 import Annex.CatFile
 
 {- Name of the branch that is used to store git-annex's information. -}
@@ -41,110 +42,18 @@ fullname = Git.Ref $ "refs/heads/" ++ show name
 originname :: Git.Ref
 originname = Git.Ref $ "origin/" ++ show name
 
-{- Populates the branch's index file with the current branch contents.
- - 
- - This is only done when the index doesn't yet exist, and the index 
- - is used to build up changes to be commited to the branch, and merge
- - in changes from other branches.
- -}
-genIndex :: Git.Repo -> IO ()
-genIndex g = Git.UnionMerge.stream_update_index g
-	[Git.UnionMerge.ls_tree fullname g]
-
-{- Merges the specified branches into the index.
- - Any changes staged in the index will be preserved. -}
-mergeIndex :: [Git.Ref] -> Annex ()
-mergeIndex branches = do
-	h <- catFileHandle
-	inRepo $ \g -> Git.UnionMerge.merge_index h g branches
-
-{- Runs an action using the branch's index file. -}
-withIndex :: Annex a -> Annex a
-withIndex = withIndex' False
-withIndex' :: Bool -> Annex a -> Annex a
-withIndex' bootstrapping a = do
-	f <- fromRepo gitAnnexIndex
-	bracketIO (Git.useIndex f) id $ do
-		unlessM (liftIO $ doesFileExist f) $ do
-			unless bootstrapping create
-			liftIO $ createDirectoryIfMissing True $ takeDirectory f
-			unless bootstrapping $ inRepo genIndex
-		a
-
-{- Updates the branch's index to reflect the current contents of the branch.
- - Any changes staged in the index will be preserved.
- -
- - Compares the ref stored in the lock file with the current
- - ref of the branch to see if an update is needed.
- -}
-updateIndex :: Git.Ref -> Annex ()
-updateIndex branchref = do
-	lock <- fromRepo gitAnnexIndexLock
-	lockref <- Git.Ref . firstLine <$>
-		liftIO (catchDefaultIO (readFileStrict lock) "")
-	when (lockref /= branchref) $ do
-		withIndex $ mergeIndex [fullname]
-		setIndexSha branchref
-
-{- Record that the branch's index has been updated to correspond to a
- - given ref of the branch. -}
-setIndexSha :: Git.Ref -> Annex ()
-setIndexSha ref = do
-        lock <- fromRepo gitAnnexIndexLock
-	liftIO $ writeFile lock $ show ref ++ "\n"
+{- Does origin/git-annex exist? -}
+hasOrigin :: Annex Bool
+hasOrigin = inRepo $ Git.Ref.exists originname
 
-{- Commits the staged changes in the index to the branch.
- - 
- - Ensures that the branch's index file is first updated to the state
- - of the brannch at branchref, before running the commit action. This
- - is needed because the branch may have had changes pushed to it, that
- - are not yet reflected in the index.
- -
- - Also safely handles a race that can occur if a change is being pushed
- - into the branch at the same time. When the race happens, the commit will
- - be made on top of the newly pushed change, but without the index file
- - being updated to include it. The result is that the newly pushed
- - change is reverted. This race is detected and another commit made
- - to fix it.
- - 
- - The branchref value can have been obtained using getBranch at any
- - previous point, though getting it a long time ago makes the race
- - more likely to occur.
- -}
-commitBranch :: Git.Ref -> String -> [Git.Ref] -> Annex ()
-commitBranch branchref message parents = do
-	updateIndex branchref
-	committedref <- inRepo $ Git.commit message fullname parents
-	setIndexSha committedref
-	parentrefs <- commitparents <$> catObject committedref
-	when (racedetected branchref parentrefs) $
-		fixrace committedref parentrefs
-	where
-		-- look for "parent ref" lines and return the refs
-		commitparents = map (Git.Ref . snd) . filter isparent .
-			map (toassoc . L.unpack) . L.lines
-		toassoc = separate (== ' ')
-		isparent (k,_) = k == "parent"
-		
- 		{- The race can be detected by checking the commit's
-		 - parent, which will be the newly pushed branch,
-		 - instead of the expected ref that the index was updated to. -}
-		racedetected expectedref parentrefs
-			| expectedref `elem` parentrefs = False -- good parent
-			| otherwise = True -- race!
-		
-		{- To recover from the race, union merge the lost refs
-		 - into the index, and recommit on top of the bad commit. -}
-		fixrace committedref lostrefs = do
-			mergeIndex lostrefs
-			commitBranch committedref racemessage [committedref]
-		
-		racemessage = message ++ " (recovery from race)"
+{- Does the git-annex branch or a sibling foo/git-annex branch exist? -}
+hasSibling :: Annex Bool
+hasSibling = not . null <$> siblingBranches
 
-{- Runs an action using the branch's index file, first making sure that
- - the branch and index are up-to-date. -}
-withIndexUpdate :: Annex a -> Annex a
-withIndexUpdate a = update >> withIndex a
+{- List of git-annex (refs, branches), including the main one and any
+ - from remotes. Duplicate refs are filtered out. -}
+siblingBranches :: Annex [(Git.Ref, Git.Branch)]
+siblingBranches = inRepo $ Git.Ref.matching name
 
 {- Creates the branch, if it does not already exist. -}
 create :: Annex ()
@@ -168,13 +77,6 @@ getBranch = maybe (hasOrigin >>= go >>= use) (return) =<< branchsha
 			return sha
 		branchsha = inRepo $ Git.Ref.sha fullname
 
-{- Stages the journal, and commits staged changes to the branch. -}
-commit :: String -> Annex ()
-commit message = whenM journalDirty $ lockJournal $ do
-	stageJournal
-	ref <- getBranch
-	withIndex $ commitBranch ref message [fullname]
-
 {- Ensures that the branch and index are is up-to-date; should be
  - called before data is read from it. Runs only once per git-annex run.
  -
@@ -194,8 +96,7 @@ update = runUpdateOnce $ do
 	branchref <- getBranch
 	-- check what needs updating before taking the lock
 	dirty <- journalDirty
-	c <- filterM (changedBranch fullname . snd) =<< siblingBranches
-	let (refs, branches) = unzip c
+	(refs, branches) <- unzip <$> newerSiblings
 	if (not dirty && null refs)
 		then updateIndex branchref
 		else withIndex $ lockJournal $ do
@@ -208,88 +109,17 @@ update = runUpdateOnce $ do
 			unless (null branches) $ do
 				showSideAction merge_desc
 				mergeIndex branches
-			ff <- if dirty then return False else tryFastForwardTo refs
+			ff <- if dirty
+				then return False
+				else inRepo $ Git.Branch.fastForward fullname refs
 			if ff
 				then updateIndex branchref
 				else commitBranch branchref merge_desc
 					(nub $ fullname:refs)
 			invalidateCache
-
-{- Checks if the second branch has any commits not present on the first
- - branch. -}
-changedBranch :: Git.Branch -> Git.Branch -> Annex Bool
-changedBranch origbranch newbranch
-	| origbranch == newbranch = return False
-	| otherwise = not . L.null <$> diffs
-	where
-		diffs = inRepo $ Git.pipeRead
-			[ Param "log"
-			, Param (show origbranch ++ ".." ++ show newbranch)
-			, Params "--oneline -n1"
-			]
-
-{- Given a set of refs that are all known to have commits not
- - on the git-annex branch, tries to update the branch by a
- - fast-forward.
- -
- - In order for that to be possible, one of the refs must contain
- - every commit present in all the other refs, as well as in the
- - git-annex branch.
- -}
-tryFastForwardTo :: [Git.Ref] -> Annex Bool
-tryFastForwardTo [] = return True
-tryFastForwardTo (first:rest) = do
-	-- First, check that the git-annex branch does not contain any
-	-- new commits that are not in the first other branch. If it does,
-	-- cannot fast-forward.
-	diverged <- changedBranch first fullname
-	if diverged
-		then no_ff
-		else maybe no_ff do_ff =<< findbest first rest
 	where
-		no_ff = return False
-		do_ff branch = do
-			inRepo $ Git.run "update-ref"
-				[Param $ show fullname, Param $ show branch]
-			return True
-		findbest c [] = return $ Just c
-		findbest c (r:rs)
-			| c == r = findbest c rs
-			| otherwise = do
-			better <- changedBranch c r
-			worse <- changedBranch r c
-			case (better, worse) of
-				(True, True) -> return Nothing -- divergent fail
-				(True, False) -> findbest r rs -- better
-				(False, True) -> findbest c rs -- worse
-				(False, False) -> findbest c rs -- same
-			
-{- Does origin/git-annex exist? -}
-hasOrigin :: Annex Bool
-hasOrigin = inRepo $ Git.Ref.exists originname
-
-{- Does the git-annex branch or a sibling foo/git-annex branch exist? -}
-hasSibling :: Annex Bool
-hasSibling = not . null <$> siblingBranches
-
-{- List of git-annex (refs, branches), including the main one and any
- - from remotes. Duplicate refs are filtered out. -}
-siblingBranches :: Annex [(Git.Ref, Git.Branch)]
-siblingBranches = inRepo $ Git.Ref.matching name
-
-{- Applies a function to modifiy the content of a file.
- -
- - Note that this does not cause the branch to be merged, it only
- - modifes the current content of the file on the branch.
- -}
-change :: FilePath -> (String -> String) -> Annex ()
-change file a = lockJournal $ getStale file >>= return . a >>= set file
-
-{- Records new content of a file into the journal and cache. -}
-set :: FilePath -> String -> Annex ()
-set file content = do
-	setJournalFile file content
-	setCache file content
+		newerSiblings = filterM isnewer =<< siblingBranches
+		isnewer (_, b) = inRepo $ Git.Branch.changed fullname b
 
 {- Gets the content of a file on the branch, or content from the journal, or
  - staged in the index.
@@ -318,6 +148,75 @@ get' staleok file = fromcache =<< getCache file
 			setCache file content
 			return content
 
+{- Applies a function to modifiy the content of a file.
+ -
+ - Note that this does not cause the branch to be merged, it only
+ - modifes the current content of the file on the branch.
+ -}
+change :: FilePath -> (String -> String) -> Annex ()
+change file a = lockJournal $ getStale file >>= return . a >>= set file
+
+{- Records new content of a file into the journal and cache. -}
+set :: FilePath -> String -> Annex ()
+set file content = do
+	setJournalFile file content
+	setCache file content
+
+{- Stages the journal, and commits staged changes to the branch. -}
+commit :: String -> Annex ()
+commit message = whenM journalDirty $ lockJournal $ do
+	stageJournal
+	ref <- getBranch
+	withIndex $ commitBranch ref message [fullname]
+
+{- Commits the staged changes in the index to the branch.
+ - 
+ - Ensures that the branch's index file is first updated to the state
+ - of the brannch at branchref, before running the commit action. This
+ - is needed because the branch may have had changes pushed to it, that
+ - are not yet reflected in the index.
+ -
+ - Also safely handles a race that can occur if a change is being pushed
+ - into the branch at the same time. When the race happens, the commit will
+ - be made on top of the newly pushed change, but without the index file
+ - being updated to include it. The result is that the newly pushed
+ - change is reverted. This race is detected and another commit made
+ - to fix it.
+ - 
+ - The branchref value can have been obtained using getBranch at any
+ - previous point, though getting it a long time ago makes the race
+ - more likely to occur.
+ -}
+commitBranch :: Git.Ref -> String -> [Git.Ref] -> Annex ()
+commitBranch branchref message parents = do
+	updateIndex branchref
+	committedref <- inRepo $ Git.commit message fullname parents
+	setIndexSha committedref
+	parentrefs <- commitparents <$> catObject committedref
+	when (racedetected branchref parentrefs) $
+		fixrace committedref parentrefs
+	where
+		-- look for "parent ref" lines and return the refs
+		commitparents = map (Git.Ref . snd) . filter isparent .
+			map (toassoc . L.unpack) . L.lines
+		toassoc = separate (== ' ')
+		isparent (k,_) = k == "parent"
+		
+ 		{- The race can be detected by checking the commit's
+		 - parent, which will be the newly pushed branch,
+		 - instead of the expected ref that the index was updated to. -}
+		racedetected expectedref parentrefs
+			| expectedref `elem` parentrefs = False -- good parent
+			| otherwise = True -- race!
+		
+		{- To recover from the race, union merge the lost refs
+		 - into the index, and recommit on top of the bad commit. -}
+		fixrace committedref lostrefs = do
+			mergeIndex lostrefs
+			commitBranch committedref racemessage [committedref]
+		
+		racemessage = message ++ " (recovery from race)"
+
 {- Lists all files on the branch. There may be duplicates in the list. -}
 files :: Annex [FilePath]
 files = withIndexUpdate $ do
@@ -326,6 +225,64 @@ files = withIndexUpdate $ do
 	jfiles <- getJournalledFiles
 	return $ jfiles ++ bfiles
 
+
+{- Populates the branch's index file with the current branch contents.
+ - 
+ - This is only done when the index doesn't yet exist, and the index 
+ - is used to build up changes to be commited to the branch, and merge
+ - in changes from other branches.
+ -}
+genIndex :: Git.Repo -> IO ()
+genIndex g = Git.UnionMerge.stream_update_index g
+	[Git.UnionMerge.ls_tree fullname g]
+
+{- Merges the specified branches into the index.
+ - Any changes staged in the index will be preserved. -}
+mergeIndex :: [Git.Ref] -> Annex ()
+mergeIndex branches = do
+	h <- catFileHandle
+	inRepo $ \g -> Git.UnionMerge.merge_index h g branches
+
+{- Runs an action using the branch's index file. -}
+withIndex :: Annex a -> Annex a
+withIndex = withIndex' False
+withIndex' :: Bool -> Annex a -> Annex a
+withIndex' bootstrapping a = do
+	f <- fromRepo gitAnnexIndex
+	bracketIO (Git.useIndex f) id $ do
+		unlessM (liftIO $ doesFileExist f) $ do
+			unless bootstrapping create
+			liftIO $ createDirectoryIfMissing True $ takeDirectory f
+			unless bootstrapping $ inRepo genIndex
+		a
+
+{- Runs an action using the branch's index file, first making sure that
+ - the branch and index are up-to-date. -}
+withIndexUpdate :: Annex a -> Annex a
+withIndexUpdate a = update >> withIndex a
+
+{- Updates the branch's index to reflect the current contents of the branch.
+ - Any changes staged in the index will be preserved.
+ -
+ - Compares the ref stored in the lock file with the current
+ - ref of the branch to see if an update is needed.
+ -}
+updateIndex :: Git.Ref -> Annex ()
+updateIndex branchref = do
+	lock <- fromRepo gitAnnexIndexLock
+	lockref <- Git.Ref . firstLine <$>
+		liftIO (catchDefaultIO (readFileStrict lock) "")
+	when (lockref /= branchref) $ do
+		withIndex $ mergeIndex [fullname]
+		setIndexSha branchref
+
+{- Record that the branch's index has been updated to correspond to a
+ - given ref of the branch. -}
+setIndexSha :: Git.Ref -> Annex ()
+setIndexSha ref = do
+        lock <- fromRepo gitAnnexIndexLock
+	liftIO $ writeFile lock $ show ref ++ "\n"
+
 {- Stages the journal into the index. -}
 stageJournal :: Annex ()
 stageJournal = do
diff --git a/Git/Branch.hs b/Git/Branch.hs
new file mode 100644
index 000000000..e69e96f28
--- /dev/null
+++ b/Git/Branch.hs
@@ -0,0 +1,60 @@
+{- git branch stuff
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Branch where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+
+import Common
+import Git
+
+{- Checks if the second branch has any commits not present on the first
+ - branch. -}
+changed :: Branch -> Branch -> Repo -> IO Bool
+changed origbranch newbranch repo
+	| origbranch == newbranch = return False
+	| otherwise = not . L.null <$> diffs
+	where
+		diffs = Git.pipeRead
+			[ Param "log"
+			, Param (show origbranch ++ ".." ++ show newbranch)
+			, Params "--oneline -n1"
+			] repo
+
+{- Given a set of refs that are all known to have commits not
+ - on the branch, tries to update the branch by a fast-forward.
+ -
+ - In order for that to be possible, one of the refs must contain
+ - every commit present in all the other refs.
+ -}
+fastForward :: Branch -> [Ref] -> Repo -> IO Bool
+fastForward _ [] _ = return True
+fastForward branch (first:rest) repo = do
+	-- First, check that the branch does not contain any
+	-- new commits that are not in the first ref. If it does,
+	-- cannot fast-forward.
+	diverged <- changed first branch repo
+	if diverged
+		then no_ff
+		else maybe no_ff do_ff =<< findbest first rest
+	where
+		no_ff = return False
+		do_ff to = do
+			Git.run "update-ref"
+				[Param $ show branch, Param $ show to] repo
+			return True
+		findbest c [] = return $ Just c
+		findbest c (r:rs)
+			| c == r = findbest c rs
+			| otherwise = do
+			better <- changed c r repo
+			worse <- changed r c repo
+			case (better, worse) of
+				(True, True) -> return Nothing -- divergent fail
+				(True, False) -> findbest r rs -- better
+				(False, True) -> findbest c rs -- worse
+				(False, False) -> findbest c rs -- same