1{- git-annex branch state management
2 -
3 - Runtime state about the git-annex branch, and a small cache.
4 -
5 - Copyright 2011-2020 Joey Hess <id@joeyh.name>
6 -
7 - Licensed under the GNU AGPL version 3 or higher.
8 -}
9
10module Annex.BranchState where
11
12import Annex.Common
13import Types.BranchState
14import qualified Annex
15import Logs
16
17import qualified Data.ByteString.Lazy as L
18
19getState :: Annex BranchState
20getState = Annex.getState Annex.branchstate
21
22changeState :: (BranchState -> BranchState) -> Annex ()
23changeState changer = Annex.changeState $ \s ->
24	s { Annex.branchstate = changer (Annex.branchstate s) }
25
26{- Runs an action to check that the index file exists, if it's not been
27 - checked before in this run of git-annex. -}
28checkIndexOnce :: Annex () -> Annex ()
29checkIndexOnce a = unlessM (indexChecked <$> getState) $ do
30	a
31	changeState $ \s -> s { indexChecked = True }
32
33{- Runs an action to update the branch, if it's not been updated before
34 - in this run of git-annex.
35 -
36 - The action should return True if anything that was in the journal
37 - before got staged (or if the journal was empty). That lets an opmisation
38 - be done: The journal then does not need to be checked going forward,
39 - until new information gets written to it.
40 -
41 - When interactive access is enabled, the journal is always checked when
42 - reading values from the branch, and so this does not need to update
43 - the branch.
44 -}
45runUpdateOnce :: Annex Bool -> Annex BranchState
46runUpdateOnce a = do
47	st <- getState
48	if branchUpdated st || needInteractiveAccess st
49		then return st
50		else do
51			journalstaged <- a
52			let stf = \st' -> st'
53				{ branchUpdated = True
54				, journalIgnorable = journalstaged
55				}
56			changeState stf
57			return (stf st)
58
59{- Avoids updating the branch. A useful optimisation when the branch
60 - is known to have not changed, or git-annex won't be relying on info
61 - queried from it being as up-to-date as possible. -}
62disableUpdate :: Annex ()
63disableUpdate = changeState $ \s -> s { branchUpdated = True }
64
65{- Called when a change is made to the journal. -}
66journalChanged :: Annex ()
67journalChanged = do
68	-- Optimisation: Typically journalIgnorable will already be True
69	-- (when one thing gets journalled, often other things do to),
70	-- so avoid an unnecessary write to the MVar that changeState
71	-- would do.
72	--
73	-- This assumes that another thread is not changing journalIgnorable
74	-- at the same time, but since runUpdateOnce is the only
75	-- thing that changes it, and it only runs once, that
76	-- should not happen.
77	st <- getState
78	when (journalIgnorable st) $
79		changeState $ \st' -> st' { journalIgnorable = False }
80
81{- When git-annex is somehow interactive, eg in --batch mode,
82 - and needs to always notice changes made to the journal by other
83 - processes, this disables optimisations that avoid normally reading the
84 - journal.
85 -
86 - It also avoids using the cache, so changes committed by other processes
87 - will be seen.
88 -}
89enableInteractiveBranchAccess :: Annex ()
90enableInteractiveBranchAccess = changeState $
91	\s -> s { needInteractiveAccess = True }
92
93setCache :: RawFilePath -> L.ByteString -> Annex ()
94setCache file content = changeState $ \s -> s
95	{ cachedFileContents = add (cachedFileContents s) }
96  where
97	add l
98		| length l < logFilesToCache = (file, content) : l
99		| otherwise = (file, content) : Prelude.init l
100
101getCache :: RawFilePath -> Annex (Maybe L.ByteString)
102getCache file = (\st -> go (cachedFileContents st) st) <$> getState
103  where
104	go [] _ = Nothing
105	go ((f,c):rest) state
106		| f == file && not (needInteractiveAccess state) = Just c
107		| otherwise = go rest state
108
109invalidateCache :: Annex ()
110invalidateCache = changeState $ \s -> s { cachedFileContents = [] }
111