split out Annex/BranchState.hs
This commit is contained in:
parent
b2f934e07a
commit
98dfc0c9b0
3 changed files with 60 additions and 45 deletions
|
@ -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
56
Annex/BranchState.hs
Normal 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
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue