9483b10469
My worry was that a preferred content expression that matches on metadata would have removed the location log from cache, causing an expensive re-read when a Seek action later checked the location log. Especially when the --all optimisation in the previous commit pre-cached the location log. This also means that the --all optimisation could cache the metadata log too, if it wanted too, but not currently done. The cache is a list, with the most recently accessed file first. That optimises it for the common case of reading the same file twice, eg a get, examine, followed by set reads it twice. And sync --content reads the location log 3 times in a row commonly. But, as a list, it should not be made to be too long. I thought about expanding it to 5 items, but that seemed unlikely to be a win commonly enough to outweigh the extra time spent checking the cache. Clearly there could be some further benchmarking and tuning here.
107 lines
3.4 KiB
Haskell
107 lines
3.4 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.
|
|
-}
|
|
runUpdateOnce :: Annex Bool -> Annex BranchState
|
|
runUpdateOnce a = do
|
|
st <- getState
|
|
if branchUpdated st
|
|
then return st
|
|
else do
|
|
journalstaged <- a
|
|
let stf = \st' -> st'
|
|
{ branchUpdated = True
|
|
, journalIgnorable = journalstaged
|
|
&& not (needInteractiveAccess st')
|
|
}
|
|
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
|
|
- from it. -}
|
|
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 = [] }
|