update Annex.reposizes when changing location logs
The live update is only needed when Annex.reposizes has already been populated.
This commit is contained in:
parent
c376b1bd7e
commit
06064f897c
8 changed files with 69 additions and 28 deletions
|
@ -410,15 +410,21 @@ getRef ref file = withIndex $ catFile ref file
|
|||
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
|
||||
|
||||
|
|
|
@ -12,6 +12,7 @@ module Annex.RepoSize (
|
|||
) where
|
||||
|
||||
import Annex.Common
|
||||
import Annex.RepoSize.LiveUpdate
|
||||
import qualified Annex
|
||||
import Annex.Branch (UnmergedBranches(..), getBranch)
|
||||
import Types.RepoSize
|
||||
|
@ -86,17 +87,3 @@ journalledRepoSizes startmap branchsha =
|
|||
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
|
||||
|
|
46
Annex/RepoSize/LiveUpdate.hs
Normal file
46
Annex/RepoSize/LiveUpdate.hs
Normal file
|
@ -0,0 +1,46 @@
|
|||
{- 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
|
|
@ -32,7 +32,7 @@ recordContentIdentifier :: RemoteStateHandle -> ContentIdentifier -> Key -> Anne
|
|||
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)
|
||||
|
|
|
@ -40,6 +40,7 @@ module Logs.Location (
|
|||
import Annex.Common
|
||||
import qualified Annex.Branch
|
||||
import Annex.Branch (FileContents)
|
||||
import Annex.RepoSize.LiveUpdate
|
||||
import Logs
|
||||
import Logs.Presence
|
||||
import Types.Cluster
|
||||
|
@ -81,11 +82,13 @@ logChange key u@(UUID _) s
|
|||
| 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
|
||||
|
@ -162,14 +165,15 @@ setDead key = do
|
|||
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))
|
||||
|
||||
|
|
|
@ -49,8 +49,10 @@ addLog' ru file logstatus loginfo c =
|
|||
{- 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 ->
|
||||
|
|
|
@ -32,11 +32,6 @@ Planned schedule of work:
|
|||
|
||||
* 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
|
||||
|
|
|
@ -575,6 +575,7 @@ Executable git-annex
|
|||
Annex.ReplaceFile
|
||||
Annex.RemoteTrackingBranch
|
||||
Annex.RepoSize
|
||||
Annex.RepoSize.LiveUpdate
|
||||
Annex.SafeDropProof
|
||||
Annex.SpecialRemote
|
||||
Annex.SpecialRemote.Config
|
||||
|
|
Loading…
Add table
Reference in a new issue