This commit is contained in:
Joey Hess 2011-06-28 14:14:49 -04:00
parent c90652f015
commit e8068f2ffb

View file

@ -17,7 +17,7 @@ module Branch (
name name
) where ) where
import Control.Monad (unless, when, liftM) import Control.Monad (unless, liftM)
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import System.FilePath import System.FilePath
import System.Directory import System.Directory
@ -39,21 +39,23 @@ import Types
import Messages import Messages
import Locations import Locations
type GitRef = String
{- Name of the branch that is used to store git-annex's information. -} {- Name of the branch that is used to store git-annex's information. -}
name :: String name :: GitRef
name = "git-annex" name = "git-annex"
{- Fully qualified name of the branch. -} {- Fully qualified name of the branch. -}
fullname :: String fullname :: GitRef
fullname = "refs/heads/" ++ name fullname = "refs/heads/" ++ name
{- Branch's name in origin. -} {- Branch's name in origin. -}
originname :: String originname :: GitRef
originname = "origin/" ++ name originname = "origin/" ++ name
{- Converts a fully qualified git ref into a short version for human {- Converts a fully qualified git ref into a short version for human
- consumptiom. -} - consumptiom. -}
shortref :: String -> String shortref :: GitRef -> String
shortref = remove "refs/heads/" . remove "refs/remotes/" shortref = remove "refs/heads/" . remove "refs/remotes/"
where where
remove prefix s remove prefix s
@ -121,24 +123,20 @@ getCache file = getState >>= handle
{- Creates the branch, if it does not already exist. -} {- Creates the branch, if it does not already exist. -}
create :: Annex () create :: Annex ()
create = do create = unlessM (refExists fullname) $ do
exists <- refExists fullname g <- Annex.gitRepo
unless exists $ do e <- hasOrigin
g <- Annex.gitRepo if e
e <- hasOrigin then liftIO $ Git.run g "branch" [Param name, Param originname]
if e else withIndex' True $
then liftIO $ Git.run g "branch" [Param name, Param originname] liftIO $ GitUnionMerge.commit g "branch created" fullname []
else withIndex' True $
liftIO $ GitUnionMerge.commit g "branch created" fullname []
{- Stages the journal, and commits staged changes to the branch. -} {- Stages the journal, and commits staged changes to the branch. -}
commit :: String -> Annex () commit :: String -> Annex ()
commit message = do commit message = whenM stageJournalFiles $ do
staged <- stageJournalFiles g <- Annex.gitRepo
when staged $ do withIndex $ liftIO $
g <- Annex.gitRepo GitUnionMerge.commit g message fullname [fullname]
withIndex $ liftIO $
GitUnionMerge.commit g message fullname [fullname]
{- Ensures that the branch is up-to-date; should be called before {- Ensures that the branch is up-to-date; should be called before
- data is read from it. Runs only once per git-annex run. -} - data is read from it. Runs only once per git-annex run. -}
@ -171,14 +169,14 @@ hasOrigin :: Annex Bool
hasOrigin = refExists originname hasOrigin = refExists originname
{- Checks if a git ref exists. -} {- Checks if a git ref exists. -}
refExists :: String -> Annex Bool refExists :: GitRef -> Annex Bool
refExists ref = do refExists ref = do
g <- Annex.gitRepo g <- Annex.gitRepo
liftIO $ Git.runBool g "show-ref" liftIO $ Git.runBool g "show-ref"
[Param "--verify", Param "-q", Param ref] [Param "--verify", Param "-q", Param ref]
{- Ensures that a given ref has been merged into the index. -} {- Ensures that a given ref has been merged into the index. -}
updateRef :: String -> Annex (Maybe String) updateRef :: GitRef -> Annex (Maybe String)
updateRef ref updateRef ref
| ref == fullname = return Nothing | ref == fullname = return Nothing
| otherwise = do | otherwise = do