tweaks
This commit is contained in:
parent
c90652f015
commit
e8068f2ffb
1 changed files with 20 additions and 22 deletions
42
Branch.hs
42
Branch.hs
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue