improve alwayscommit=false mode

Now changes are staged into the branch's index, but not committed,
which avoids growing a large journal. And sync and merge always
explicitly commit, ensuring that even when they do nothing else,
they commit the staged changes.

Added a flag file to indicate that the branch's journal contains
uncommitted changes. (Could use git ls-files, but don't want to run
that every time.)

In the future, this ability to have uncommitted changes staged in the
journal might be used on remotes after a series of oneshot commands.
This commit is contained in:
Joey Hess 2012-02-25 16:11:47 -04:00
parent b49c0c2633
commit 1f73db3469
6 changed files with 44 additions and 7 deletions

View file

@ -18,6 +18,7 @@ module Annex.Branch (
get,
change,
commit,
stage,
files,
) where
@ -114,7 +115,7 @@ updateTo pairs = do
-- ensure branch exists, and get its current ref
branchref <- getBranch
-- check what needs updating before taking the lock
dirty <- journalDirty
dirty <- unCommitted
(refs, branches) <- unzip <$> filterM isnewer pairs
if not dirty && null refs
then updateIndex branchref
@ -182,11 +183,17 @@ set file content = do
{- Stages the journal, and commits staged changes to the branch. -}
commit :: String -> Annex ()
commit message = whenM journalDirty $ lockJournal $ do
commit message = whenM unCommitted $ lockJournal $ do
stageJournal
ref <- getBranch
withIndex $ commitBranch ref message [fullname]
{- Stages the journal, not making a commit to the branch. -}
stage :: Annex ()
stage = whenM journalDirty $ lockJournal $ do
stageJournal
setUnCommitted
{- Commits the staged changes in the index to the branch.
-
- Ensures that the branch's index file is first updated to the state
@ -213,6 +220,7 @@ commitBranch branchref message parents = do
parentrefs <- commitparents <$> catObject committedref
when (racedetected branchref parentrefs) $
fixrace committedref parentrefs
setCommitted
where
-- look for "parent ref" lines and return the refs
commitparents = map (Git.Ref . snd) . filter isparent .
@ -301,6 +309,25 @@ setIndexSha ref = do
lock <- fromRepo gitAnnexIndexLock
liftIO $ writeFile lock $ show ref ++ "\n"
{- Checks if there are uncommitted changes in the branch's index or journal. -}
unCommitted :: Annex Bool
unCommitted = do
d <- liftIO . doesFileExist =<< fromRepo gitAnnexIndexDirty
if d
then return d
else journalDirty
setUnCommitted :: Annex ()
setUnCommitted = do
file <- fromRepo gitAnnexIndexDirty
liftIO $ writeFile file "1"
setCommitted :: Annex ()
setCommitted = do
file <- fromRepo gitAnnexIndexDirty
_ <- liftIO $ tryIO $ removeFile file
return ()
{- Stages the journal into the index. -}
stageJournal :: Annex ()
stageJournal = do

View file

@ -312,9 +312,11 @@ getKeysPresent' dir = do
saveState :: Bool -> Annex ()
saveState oneshot = do
Annex.Queue.flush False
alwayscommit <- Git.configTrue <$> fromRepo (Git.Config.get "annex.alwayscommit" "true")
unless (oneshot || not alwayscommit) $ do
Annex.Branch.commit "update"
unless oneshot $ do
alwayscommit <- Git.configTrue <$> fromRepo (Git.Config.get "annex.alwayscommit" "true")
if alwayscommit
then Annex.Branch.commit "update"
else Annex.Branch.stage
{- Downloads content from any of a list of urls. -}
downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool

View file

@ -26,4 +26,6 @@ start = do
perform :: CommandPerform
perform = do
Annex.Branch.update
-- commit explicitly, in case no remote branches were merged
Annex.Branch.commit "update"
next $ return True

View file

@ -75,6 +75,7 @@ commit = do
showStart "commit" ""
next $ next $ do
showOutput
Annex.Branch.commit "update"
-- Commit will fail when the tree is clean, so ignore failure.
_ <- inRepo $ Git.Command.runBool "commit"
[Param "-a", Param "-m", Param "git-annex automatic sync"]

View file

@ -22,6 +22,7 @@ module Locations (
gitAnnexJournalLock,
gitAnnexIndex,
gitAnnexIndexLock,
gitAnnexIndexDirty,
gitAnnexSshDir,
isLinkToAnnex,
annexHashes,
@ -143,6 +144,10 @@ gitAnnexIndex r = gitAnnexDir r </> "index"
gitAnnexIndexLock :: Git.Repo -> FilePath
gitAnnexIndexLock r = gitAnnexDir r </> "index.lck"
{- Flag file for .git/annex/index. -}
gitAnnexIndexDirty :: Git.Repo -> FilePath
gitAnnexIndexDirty r = gitAnnexDir r </> "index.dirty"
{- .git/annex/ssh/ is used for ssh connection caching -}
gitAnnexSshDir :: Git.Repo -> FilePath
gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r </> "ssh"