refactor
This commit is contained in:
parent
a5e6802b5b
commit
7e7428f173
4 changed files with 44 additions and 22 deletions
14
Branch.hs
14
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. -}
|
||||
|
|
10
GitRepo.hs
10
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 $
|
||||
|
|
|
@ -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" $
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue