better setup of git-annex branch pushing on upgrade

This commit is contained in:
Joey Hess 2011-06-24 11:59:34 -04:00
parent 50354a4916
commit ad38c0dfad
3 changed files with 55 additions and 21 deletions

View file

@ -11,7 +11,10 @@ module Branch (
get,
change,
commit,
files
files,
refExists,
hasOrigin,
name
) where
import Control.Monad (unless, when, liftM)
@ -44,6 +47,10 @@ name = "git-annex"
fullname :: String
fullname = "refs/heads/" ++ name
{- Branch's name in origin. -}
originname :: String
originname = "origin/" ++ name
{- Converts a fully qualified git ref into a short version for human
- consumptiom. -}
shortref :: String -> String
@ -114,20 +121,14 @@ getCache file = getState >>= handle
{- Creates the branch, if it does not already exist. -}
create :: Annex ()
create = do
exists <- refexists fullname
exists <- refExists fullname
unless exists $ do
g <- Annex.gitRepo
inorigin <- refexists origin
if inorigin
then liftIO $ Git.run g "branch" [Param name, Param origin]
e <- hasOrigin
if e
then liftIO $ Git.run g "branch" [Param name, Param originname]
else withIndex' True $
liftIO $ GitUnionMerge.commit g "branch created" fullname []
where
origin = "origin/" ++ name
refexists ref = do
g <- Annex.gitRepo
liftIO $ Git.runBool g "show-ref"
[Param "--verify", Param "-q", Param ref]
{- Stages the journal, and commits staged changes to the branch. -}
commit :: String -> Annex ()
@ -164,6 +165,17 @@ update = do
Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } }
invalidateCache
{- Does origin/git-annex exist? -}
hasOrigin :: Annex Bool
hasOrigin = refExists originname
{- Checks if a git ref exists. -}
refExists :: String -> Annex Bool
refExists ref = do
g <- Annex.gitRepo
liftIO $ Git.runBool g "show-ref"
[Param "--verify", Param "-q", Param ref]
{- Ensures that a given ref has been merged into the index. -}
updateRef :: String -> Annex (Maybe String)
updateRef ref

View file

@ -9,8 +9,7 @@ module Upgrade.V2 where
import System.Directory
import System.FilePath
import Control.Monad.State (liftIO)
import Control.Monad.State (unless)
import Control.Monad.State (unless, liftIO)
import List
import Data.Maybe
@ -58,12 +57,7 @@ upgrade = do
unless bare $ gitAttributesUnWrite g
saveState
unless bare $ do
showLongNote $
"git-annex branch created\n" ++
"Now you should push the new branch: git push origin git-annex\n"
showProgress
unless bare $ push
return True
@ -90,6 +84,36 @@ logFiles :: FilePath -> Annex [FilePath]
logFiles dir = return . filter (".log" `isSuffixOf`)
=<< liftIO (getDirectoryContents dir)
push :: Annex ()
push = do
origin_master <- Branch.refExists "origin/master"
origin_gitannex <- Branch.hasOrigin
case (origin_master, origin_gitannex) of
(_, True) -> do
-- Merge in the origin's git-annex branch,
-- so that pushing the git-annex branch
-- will immediately work. Not pushed here,
-- because it's less obnoxious to let the user
-- push.
Branch.update
(True, False) -> do
-- push git-annex to origin, so that
-- "git push" will from then on
-- automatically push it
Branch.update -- just in case
showNote "pushing new git-annex branch to origin"
showProgress
g <- Annex.gitRepo
liftIO $ Git.run g "push" [Param "origin", Param Branch.name]
_ -> do
-- no origin exists, so just let the user
-- know about the new branch
Branch.update
showLongNote $
"git-annex branch created\n" ++
"Be sure to push this branch when pushing to remotes.\n"
showProgress
{- Old .gitattributes contents, not needed anymore. -}
attrLines :: [String]
attrLines =
@ -110,4 +134,3 @@ stateDir :: FilePath
stateDir = addTrailingPathSeparator $ ".git-annex"
gitStateDir :: Git.Repo -> FilePath
gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir

View file

@ -34,7 +34,6 @@ Example upgrade process:
git pull
git annex upgrade
git commit -m "upgrade v2 to v3"
git push origin git-annex master
git gc
### v1 -> v2 (git-annex version 0.20110316)