change :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> content) -> Annex ()
change ru file f = lockJournal $ \jl -> f <$> getToChange ru file >>= set jl ru file
-{- Applies a function which can modify the content of a file, or not. -}
-maybeChange :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> Maybe content) -> Annex ()
+{- Applies a function which can modify the content of a file, or not.
+ -
+ - Returns True when the file was modified. -}
+maybeChange :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> Maybe content) -> Annex Bool
maybeChange ru file f = lockJournal $ \jl -> do
v <- getToChange ru file
case f v of
Just jv ->
let b = journalableByteString jv
- in when (v /= b) $ set jl ru file b
- _ -> noop
+ in if v /= b
+ then do
+ set jl ru file b
+ return True
+ else return False
+ _ -> return False
data ChangeOrAppend t = Change t | Append t
) where
import Annex.Common
+import Annex.RepoSize.LiveUpdate
import qualified Annex
import Annex.Branch (UnmergedBranches(..), getBranch)
import Types.RepoSize
accumsizes k (newlocs, removedlocs) m = return $
let m' = foldl' (flip $ M.alter $ addKeyRepoSize k) m newlocs
in foldl' (flip $ M.alter $ removeKeyRepoSize k) m' removedlocs
-
-addKeyRepoSize :: Key -> Maybe RepoSize -> Maybe RepoSize
-addKeyRepoSize k mrs = case mrs of
- Just (RepoSize sz) -> Just $ RepoSize $ sz + ksz
- Nothing -> Just $ RepoSize ksz
- where
- ksz = fromMaybe 0 $ fromKey keySize k
-
-removeKeyRepoSize :: Key -> Maybe RepoSize -> Maybe RepoSize
-removeKeyRepoSize k mrs = case mrs of
- Just (RepoSize sz) -> Just $ RepoSize $ sz - ksz
- Nothing -> Nothing
- where
- ksz = fromMaybe 0 $ fromKey keySize k
--- /dev/null
+{- git-annex repo sizes, live updates
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE BangPatterns #-}
+
+module Annex.RepoSize.LiveUpdate where
+
+import Annex.Common
+import qualified Annex
+import Types.RepoSize
+import Logs.Presence.Pure
+
+import qualified Data.Map.Strict as M
+
+updateRepoSize :: UUID -> Key -> LogStatus -> Annex ()
+updateRepoSize u k s = Annex.getState Annex.reposizes >>= \case
+ Nothing -> noop
+ Just sizemap -> do
+ let !sizemap' = M.adjust
+ (fromMaybe (RepoSize 0) . f k . Just)
+ u sizemap
+ Annex.changeState $ \st -> st
+ { Annex.reposizes = Just sizemap' }
+ where
+ f = case s of
+ InfoPresent -> addKeyRepoSize
+ InfoMissing -> removeKeyRepoSize
+ InfoDead -> removeKeyRepoSize
+
+addKeyRepoSize :: Key -> Maybe RepoSize -> Maybe RepoSize
+addKeyRepoSize k mrs = case mrs of
+ Just (RepoSize sz) -> Just $ RepoSize $ sz + ksz
+ Nothing -> Just $ RepoSize ksz
+ where
+ ksz = fromMaybe 0 $ fromKey keySize k
+
+removeKeyRepoSize :: Key -> Maybe RepoSize -> Maybe RepoSize
+removeKeyRepoSize k mrs = case mrs of
+ Just (RepoSize sz) -> Just $ RepoSize $ sz - ksz
+ Nothing -> Nothing
+ where
+ ksz = fromMaybe 0 $ fromKey keySize k
recordContentIdentifier (RemoteStateHandle u) cid k = do
c <- currentVectorClock
config <- Annex.getGitConfig
- Annex.Branch.maybeChange
+ void $ Annex.Branch.maybeChange
(Annex.Branch.RegardingUUID [u])
(remoteContentIdentifierLogFile config k)
(addcid c . parseLog)
import Annex.Common
import qualified Annex.Branch
import Annex.Branch (FileContents)
+import Annex.RepoSize.LiveUpdate
import Logs
import Logs.Presence
import Types.Cluster
| isClusterUUID u = noop
| otherwise = do
config <- Annex.getGitConfig
- maybeAddLog
+ changed <- maybeAddLog
(Annex.Branch.RegardingUUID [u])
(locationLogFile config key)
s
(LogInfo (fromUUID u))
+ when changed $
+ updateRepoSize u key s
logChange _ NoUUID _ = noop
{- Returns a list of repository UUIDs that, according to the log, have
ls <- compactLog <$> readLog logfile
mapM_ (go logfile) (filter (\l -> status l == InfoMissing) ls)
where
- go logfile l =
+ go logfile l = do
let u = toUUID (fromLogInfo (info l))
c = case date l of
VectorClock v -> CandidateVectorClock $
v + realToFrac (picosecondsToDiffTime 1)
Unknown -> CandidateVectorClock 0
- in addLog' (Annex.Branch.RegardingUUID [u]) logfile InfoDead
+ addLog' (Annex.Branch.RegardingUUID [u]) logfile InfoDead
(info l) c
+ updateRepoSize u key InfoDead
data Unchecked a = Unchecked (Annex (Maybe a))
{- When a LogLine already exists with the same status and info, but an
- older timestamp, that LogLine is preserved, rather than updating the log
- with a newer timestamp.
+ -
+ - Returns True when the log was changed.
-}
-maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()
+maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex Bool
maybeAddLog ru file logstatus loginfo = do
c <- currentVectorClock
Annex.Branch.maybeChange ru file $ \b ->
* Implement [[track_free_space_in_repos_via_git-annex_branch]]:
- * Update Annex.reposizes in Logs.Location.logChange,
- when it makes a change and when Annex.reposizes has a size
- for the UUID. So Annex.reposizes is kept up-to-date
- for each transfer and drop.
-
* When calling journalledRepoSizes make sure that the current
process is prevented from making changes to the journal in another
thread. Probably lock the journal? (No need to worry about changes made
Annex.ReplaceFile
Annex.RemoteTrackingBranch
Annex.RepoSize
+ Annex.RepoSize.LiveUpdate
Annex.SafeDropProof
Annex.SpecialRemote
Annex.SpecialRemote.Config
projects / git-annex.git / commitdiff