refactor

Branch.hs

@@ -1,11 +1,14 @@
-{- git-annex branch management
+{- management of the git-annex branch
  -
  - Copyright 2011 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Branch where
+module Branch (
+	update,
+	change
+) where
 
 import Control.Monad (unless)
 import Control.Monad.State (liftIO)
@@ -48,3 +51,10 @@ updateRef ref
 		unless (null diffs) $ do
 			showSideAction "merging " ++ ref ++ " into " ++ name ++ "..."
 			liftIO $ unionMerge g fullname ref fullname
+
+{- Stages the content of a file to be committed to the branch. -}
+change :: FilePath -> String -> Annex ()
+change file content = do
+	update
+
+{- Commits staged changes to the branch. -}

GitRepo.hs

@@ -58,6 +58,7 @@ module GitRepo (
 	typeChangedStagedFiles,
 	repoAbsPath,
 	reap,
+	withIndex,
 
 	prop_idempotent_deencode
 ) where
@@ -82,6 +83,7 @@ import Codec.Binary.UTF8.String (encode)
 import Text.Printf
 import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
 import System.Exit
+import System.Posix.Env (setEnv, unsetEnv)
 
 import Utility
 
@@ -379,6 +381,14 @@ reap = do
 	r <- catch (getAnyProcessStatus False True) (\_ -> return Nothing)
 	maybe (return ()) (const reap) r
 
+{- Runs an action using a specified index file. -}
+withIndex :: FilePath -> IO a -> IO a
+withIndex index a = do
+	setEnv "GIT_INDEX_FILE" index True
+	r <- a
+	unsetEnv "GIT_INDEX_FILE"
+	return r
+
 {- Scans for files that are checked into git at the specified locations. -}
 inRepo :: Repo -> [FilePath] -> IO [FilePath]
 inRepo repo l = pipeNullSplit repo $

GitUnionMerge.hs

@@ -12,7 +12,6 @@ module GitUnionMerge (
 import System.FilePath
 import System.Directory
 import System.Cmd.Utils
-import System.Posix.Env (setEnv, unsetEnv)
 import Control.Monad (when)
 import Data.List
 import Data.Maybe
@@ -21,27 +20,12 @@ import Data.String.Utils
 import qualified GitRepo as Git
 import Utility
 
+{- Performs a union merge. Should be run with a temporary index file
+ - configured by Git.withIndex. -}
 unionMerge :: Git.Repo -> String -> String -> String -> IO ()
 unionMerge g aref bref newref = do
-	setup g
 	stage g aref bref
 	commit g aref bref newref
-	cleanup g
-
-tmpIndex :: Git.Repo -> FilePath
-tmpIndex g = Git.workTree g </> Git.gitDir g </> "index.git-union-merge"
-
-{- Configures git to use a temporary index file. -}
-setup :: Git.Repo -> IO ()
-setup g = do
-	cleanup g -- idempotency
-	setEnv "GIT_INDEX_FILE" (tmpIndex g) True
-
-cleanup :: Git.Repo -> IO ()
-cleanup g = do
-	unsetEnv "GIT_INDEX_FILE"
-	e' <- doesFileExist (tmpIndex g)
-	when e' $ removeFile (tmpIndex g)
 
 {- Stages the content of both refs into the index. -}
 stage :: Git.Repo -> String -> String -> IO ()
@@ -89,7 +73,7 @@ stage g aref bref = do
 					unionmerge content
 			return $ Just $ ls_tree_line sha file
 
-{- Commits the index into the specified branch. -}
+{- Commits the index into the specified branch, as a merge commit. -}
 commit :: Git.Repo -> String -> String -> String -> IO ()
 commit g aref bref newref = do
 	tree <- getSha "write-tree"  $

git-union-merge.hs

@@ -6,6 +6,9 @@
  -}
 
 import System.Environment
+import System.FilePath
+import System.Directory
+import Control.Monad (when)
 
 import GitUnionMerge
 import qualified GitRepo as Git
@@ -16,6 +19,18 @@ header = "Usage: git-union-merge ref ref newref"
 usage :: IO a
 usage = error $ "bad parameters\n\n" ++ header
 
+tmpIndex :: Git.Repo -> FilePath
+tmpIndex g = Git.workTree g </> Git.gitDir g </> "index.git-union-merge"
+
+setup :: Git.Repo -> IO ()
+setup g = do
+	cleanup g -- idempotency
+
+cleanup :: Git.Repo -> IO ()
+cleanup g = do
+	e' <- doesFileExist (tmpIndex g)
+	when e' $ removeFile (tmpIndex g)
+
 parseArgs :: IO [String]
 parseArgs = do
 	args <- getArgs
@@ -27,4 +42,7 @@ main :: IO ()
 main = do
 	[aref, bref, newref] <- parseArgs
 	g <- Git.configRead =<< Git.repoFromCwd
-	unionMerge g aref bref newref
+	Git.withIndex (tmpIndex g) $ do
+		setup g
+		unionMerge g aref bref newref
+		cleanup g