ced91b3fbd
When git-annex transferrer started up, and the journal contained something, it would commit it to the git-annex branch. This caused excess commits to the branch, in cases where normally several changes would be journalled and committed together. That generated some excess git objects and was also just noisy on stdout. Since transferrer uses enableInteractiveBranchAccess, it does not need to commit journalled changes, since the optimisation that avoids checking the journal when reading from the branch is disabled for processes that call that. This commit was sponsored by Svenne Krap on Patreon.
110 lines
3.6 KiB
Haskell
110 lines
3.6 KiB
Haskell
{- git-annex branch state management
|
|
-
|
|
- Runtime state about the git-annex branch, and a small cache.
|
|
-
|
|
- Copyright 2011-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.BranchState where
|
|
|
|
import Annex.Common
|
|
import Types.BranchState
|
|
import qualified Annex
|
|
import Logs
|
|
|
|
import qualified Data.ByteString.Lazy as L
|
|
|
|
getState :: Annex BranchState
|
|
getState = Annex.getState Annex.branchstate
|
|
|
|
changeState :: (BranchState -> BranchState) -> Annex ()
|
|
changeState changer = Annex.changeState $ \s ->
|
|
s { Annex.branchstate = changer (Annex.branchstate s) }
|
|
|
|
{- Runs an action to check that the index file exists, if it's not been
|
|
- checked before in this run of git-annex. -}
|
|
checkIndexOnce :: Annex () -> Annex ()
|
|
checkIndexOnce a = unlessM (indexChecked <$> getState) $ do
|
|
a
|
|
changeState $ \s -> s { indexChecked = True }
|
|
|
|
{- Runs an action to update the branch, if it's not been updated before
|
|
- in this run of git-annex.
|
|
-
|
|
- The action should return True if anything that was in the journal
|
|
- before got staged (or if the journal was empty). That lets an opmisation
|
|
- be done: The journal then does not need to be checked going forward,
|
|
- until new information gets written to it.
|
|
-
|
|
- When interactive access is enabled, the journal is always checked when
|
|
- reading values from the branch, and so this does not need to update
|
|
- the branch.
|
|
-}
|
|
runUpdateOnce :: Annex Bool -> Annex BranchState
|
|
runUpdateOnce a = do
|
|
st <- getState
|
|
if branchUpdated st || needInteractiveAccess st
|
|
then return st
|
|
else do
|
|
journalstaged <- a
|
|
let stf = \st' -> st'
|
|
{ branchUpdated = True
|
|
, journalIgnorable = journalstaged
|
|
}
|
|
changeState stf
|
|
return (stf st)
|
|
|
|
{- 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
|
|
- queried from it being as up-to-date as possible. -}
|
|
disableUpdate :: Annex ()
|
|
disableUpdate = changeState $ \s -> s { branchUpdated = True }
|
|
|
|
{- Called when a change is made to the journal. -}
|
|
journalChanged :: Annex ()
|
|
journalChanged = do
|
|
-- Optimisation: Typically journalIgnorable will already be True
|
|
-- (when one thing gets journalled, often other things do to),
|
|
-- so avoid an unnecessary write to the MVar that changeState
|
|
-- would do.
|
|
--
|
|
-- This assumes that another thread is not changing journalIgnorable
|
|
-- at the same time, but since runUpdateOnce is the only
|
|
-- thing that changes it, and it only runs once, that
|
|
-- should not happen.
|
|
st <- getState
|
|
when (journalIgnorable st) $
|
|
changeState $ \st' -> st' { journalIgnorable = False }
|
|
|
|
{- When git-annex is somehow interactive, eg in --batch mode,
|
|
- and needs to always notice changes made to the journal by other
|
|
- processes, this disables optimisations that avoid normally reading the
|
|
- journal.
|
|
-
|
|
- It also avoids using the cache, so changes committed by other processes
|
|
- will be seen.
|
|
-}
|
|
enableInteractiveBranchAccess :: Annex ()
|
|
enableInteractiveBranchAccess = changeState $
|
|
\s -> s { needInteractiveAccess = True }
|
|
|
|
setCache :: RawFilePath -> L.ByteString -> Annex ()
|
|
setCache file content = changeState $ \s -> s
|
|
{ cachedFileContents = add (cachedFileContents s) }
|
|
where
|
|
add l
|
|
| length l < logFilesToCache = (file, content) : l
|
|
| otherwise = (file, content) : Prelude.init l
|
|
|
|
getCache :: RawFilePath -> Annex (Maybe L.ByteString)
|
|
getCache file = (\st -> go (cachedFileContents st) st) <$> getState
|
|
where
|
|
go [] _ = Nothing
|
|
go ((f,c):rest) state
|
|
| f == file && not (needInteractiveAccess state) = Just c
|
|
| otherwise = go rest state
|
|
|
|
invalidateCache :: Annex ()
|
|
invalidateCache = changeState $ \s -> s { cachedFileContents = [] }
|