bd3d327d8a
Only invalidate a just-written file in the cache, not the whole cache.
This will avoid the possibly performance impact of cache invalidation
mentioned in commit 770aac97a7
144 lines
4.4 KiB
Haskell
144 lines
4.4 KiB
Haskell
{- git-annex branch state management
|
|
-
|
|
- Runtime state about the git-annex branch, and a small cache.
|
|
-
|
|
- Copyright 2011-2024 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 Types.Transitions
|
|
import qualified Annex
|
|
import Logs
|
|
import qualified Git
|
|
|
|
import Control.Concurrent
|
|
import qualified Data.ByteString.Lazy as L
|
|
|
|
getState :: Annex BranchState
|
|
getState = do
|
|
v <- Annex.getRead Annex.branchstate
|
|
liftIO $ readMVar v
|
|
|
|
changeState :: (BranchState -> BranchState) -> Annex ()
|
|
changeState changer = do
|
|
v <- Annex.getRead Annex.branchstate
|
|
liftIO $ modifyMVar_ v $ return . changer
|
|
|
|
{- 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 }
|
|
|
|
data UpdateMade
|
|
= UpdateMade
|
|
{ refsWereMerged :: Bool
|
|
, journalClean :: Bool
|
|
}
|
|
| UpdateFailedPermissions
|
|
{ refsUnmerged :: [Git.Sha]
|
|
, newTransitions :: [TransitionCalculator]
|
|
}
|
|
|
|
{- Runs an action to update the branch, if it's not been updated before
|
|
- in this run of git-annex.
|
|
-
|
|
- 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.
|
|
-
|
|
- When the action leaves the journal clean, by staging anything that
|
|
- was in it, an optimisation is enabled: The journal does not need to
|
|
- be checked going forward, until new information gets written to it.
|
|
-
|
|
- When the action is unable to update the branch due to a permissions
|
|
- problem, the journal is still read every time.
|
|
-}
|
|
runUpdateOnce :: Annex UpdateMade -> Annex BranchState
|
|
runUpdateOnce update = do
|
|
st <- getState
|
|
if branchUpdated st || needInteractiveAccess st
|
|
then return st
|
|
else do
|
|
um <- update
|
|
let stf = case um of
|
|
UpdateMade {} -> \st' -> st'
|
|
{ branchUpdated = True
|
|
, journalIgnorable = journalClean um
|
|
}
|
|
UpdateFailedPermissions {} -> \st' -> st'
|
|
{ branchUpdated = True
|
|
, journalIgnorable = False
|
|
, unmergedRefs = refsUnmerged um
|
|
, unhandledTransitions = newTransitions um
|
|
, cachedFileContents = []
|
|
}
|
|
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 setting journalIgnorable
|
|
-- at the same time, but since runUpdateOnce is the only
|
|
-- thing that sets 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
|
|
, journalIgnorable = False
|
|
}
|
|
|
|
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 -> BranchState -> Maybe L.ByteString
|
|
getCache file state = go (cachedFileContents state)
|
|
where
|
|
go [] = Nothing
|
|
go ((f,c):rest)
|
|
| f == file && not (needInteractiveAccess state) = Just c
|
|
| otherwise = go rest
|
|
|
|
invalidateCache :: RawFilePath -> Annex ()
|
|
invalidateCache f = changeState $ \s -> s
|
|
{ cachedFileContents = filter (\(f', _) -> f' /= f)
|
|
(cachedFileContents s)
|
|
}
|
|
|
|
invalidateCacheAll :: Annex ()
|
|
invalidateCacheAll = changeState $ \s -> s { cachedFileContents = [] }
|