This commit is contained in:
Joey Hess 2011-06-21 16:08:09 -04:00
parent a5e6802b5b
commit 7e7428f173
4 changed files with 44 additions and 22 deletions

View file

@ -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. -}

View file

@ -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 $

View file

@ -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" $

View file

@ -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