split out Annex/BranchState.hs

This commit is contained in:
Joey Hess 2011-12-12 17:38:46 -04:00
parent b2f934e07a
commit 98dfc0c9b0
3 changed files with 60 additions and 45 deletions

View file

@ -8,7 +8,6 @@
module Annex.Branch ( module Annex.Branch (
create, create,
update, update,
disableUpdate,
get, get,
change, change,
commit, commit,
@ -25,7 +24,7 @@ import qualified Data.ByteString.Lazy.Char8 as L
import Common.Annex import Common.Annex
import Annex.Exception import Annex.Exception
import Types.BranchState import Annex.BranchState
import qualified Git import qualified Git
import qualified Git.UnionMerge import qualified Git.UnionMerge
import qualified Annex import qualified Annex
@ -148,30 +147,6 @@ commitBranch branchref message parents = do
withIndexUpdate :: Annex a -> Annex a withIndexUpdate :: Annex a -> Annex a
withIndexUpdate a = update >> withIndex a withIndexUpdate a = update >> withIndex a
getState :: Annex BranchState
getState = Annex.getState Annex.branchstate
setState :: BranchState -> Annex ()
setState state = Annex.changeState $ \s -> s { Annex.branchstate = state }
setCache :: FilePath -> String -> Annex ()
setCache file content = do
state <- getState
setState state { cachedFile = Just file, cachedContent = content }
invalidateCache :: Annex ()
invalidateCache = do
state <- getState
setState state { cachedFile = Nothing, cachedContent = "" }
getCache :: FilePath -> Annex (Maybe String)
getCache file = getState >>= go
where
go state
| cachedFile state == Just file =
return $ Just $ cachedContent state
| otherwise = return Nothing
{- 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 = do
@ -214,7 +189,7 @@ commit message = whenM journalDirty $ lockJournal $ do
- made. - made.
-} -}
update :: Annex () update :: Annex ()
update = onceonly $ do update = runUpdateOnce $ do
-- ensure branch exists, and get its current ref -- ensure branch exists, and get its current ref
branchref <- getBranch branchref <- getBranch
-- check what needs updating before taking the lock -- check what needs updating before taking the lock
@ -239,11 +214,6 @@ update = onceonly $ do
else commitBranch branchref merge_desc else commitBranch branchref merge_desc
(nub $ fullname:refs) (nub $ fullname:refs)
invalidateCache invalidateCache
where
onceonly a = unlessM (branchUpdated <$> getState) $ do
r <- a
disableUpdate
return r
{- Checks if the second branch has any commits not present on the first {- Checks if the second branch has any commits not present on the first
- branch. -} - branch. -}
@ -294,17 +264,6 @@ tryFastForwardTo (first:rest) = do
(False, True) -> findbest c rs -- worse (False, True) -> findbest c rs -- worse
(False, False) -> findbest c rs -- same (False, False) -> findbest c rs -- same
{- Avoids updating the branch. A useful optimisation when the branch
- is known to have not changed, or git-annex won't be relying on info
- from it. -}
disableUpdate :: Annex ()
disableUpdate = Annex.changeState setupdated
where
setupdated s = s { Annex.branchstate = new }
where
new = old { branchUpdated = True }
old = Annex.branchstate s
{- Checks if a git ref exists. -} {- Checks if a git ref exists. -}
refExists :: Git.Ref -> Annex Bool refExists :: Git.Ref -> Annex Bool
refExists ref = inRepo $ Git.runBool "show-ref" refExists ref = inRepo $ Git.runBool "show-ref"

56
Annex/BranchState.hs Normal file
View file

@ -0,0 +1,56 @@
{- git-annex branch state management
-
- Runtime state about the git-annex branch, including a small read cache.
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.BranchState where
import Common.Annex
import Types.BranchState
import qualified Annex
getState :: Annex BranchState
getState = Annex.getState Annex.branchstate
setState :: BranchState -> Annex ()
setState state = Annex.changeState $ \s -> s { Annex.branchstate = state }
setCache :: FilePath -> String -> Annex ()
setCache file content = do
state <- getState
setState state { cachedFile = Just file, cachedContent = content }
getCache :: FilePath -> Annex (Maybe String)
getCache file = getState >>= go
where
go state
| cachedFile state == Just file =
return $ Just $ cachedContent state
| otherwise = return Nothing
invalidateCache :: Annex ()
invalidateCache = do
state <- getState
setState state { cachedFile = Nothing, cachedContent = "" }
{- Runs an action to update the branch, if it's not been updated before
- in this run of git-annex. -}
runUpdateOnce :: Annex () -> Annex ()
runUpdateOnce a = unlessM (branchUpdated <$> getState) $ do
a
disableUpdate
{- Avoids updating the branch. A useful optimisation when the branch
- is known to have not changed, or git-annex won't be relying on info
- from it. -}
disableUpdate :: Annex ()
disableUpdate = Annex.changeState setupdated
where
setupdated s = s { Annex.branchstate = new }
where
new = old { branchUpdated = True }
old = Annex.branchstate s

View file

@ -19,7 +19,7 @@ import qualified Git
import qualified Annex import qualified Annex
import Annex.UUID import Annex.UUID
import qualified Annex.Content import qualified Annex.Content
import qualified Annex.Branch import qualified Annex.BranchState
import qualified Utility.Url as Url import qualified Utility.Url as Url
import Utility.TempFile import Utility.TempFile
import Config import Config
@ -171,7 +171,7 @@ onLocal r a = do
Annex.eval state $ do Annex.eval state $ do
-- No need to update the branch; its data is not used -- No need to update the branch; its data is not used
-- for anything onLocal is used to do. -- for anything onLocal is used to do.
Annex.Branch.disableUpdate Annex.BranchState.disableUpdate
ret <- a ret <- a
liftIO Git.reap liftIO Git.reap
return ret return ret