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 :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> content) -> Annex ()
|
||||||
change ru file f = lockJournal $ \jl -> f <$> getToChange ru file >>= set jl ru file
|
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. -}
|
{- Applies a function which can modify the content of a file, or not.
|
||||||
maybeChange :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> Maybe content) -> Annex ()
|
-
|
||||||
|
- 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
|
maybeChange ru file f = lockJournal $ \jl -> do
|
||||||
v <- getToChange ru file
|
v <- getToChange ru file
|
||||||
case f v of
|
case f v of
|
||||||
Just jv ->
|
Just jv ->
|
||||||
let b = journalableByteString jv
|
let b = journalableByteString jv
|
||||||
in when (v /= b) $ set jl ru file b
|
in if v /= b
|
||||||
_ -> noop
|
then do
|
||||||
|
set jl ru file b
|
||||||
|
return True
|
||||||
|
else return False
|
||||||
|
_ -> return False
|
||||||
|
|
||||||
data ChangeOrAppend t = Change t | Append t
|
data ChangeOrAppend t = Change t | Append t
|
||||||
|
|
||||||
|
|
|
@ -12,6 +12,7 @@ module Annex.RepoSize (
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
|
import Annex.RepoSize.LiveUpdate
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Annex.Branch (UnmergedBranches(..), getBranch)
|
import Annex.Branch (UnmergedBranches(..), getBranch)
|
||||||
import Types.RepoSize
|
import Types.RepoSize
|
||||||
|
@ -86,17 +87,3 @@ journalledRepoSizes startmap branchsha =
|
||||||
accumsizes k (newlocs, removedlocs) m = return $
|
accumsizes k (newlocs, removedlocs) m = return $
|
||||||
let m' = foldl' (flip $ M.alter $ addKeyRepoSize k) m newlocs
|
let m' = foldl' (flip $ M.alter $ addKeyRepoSize k) m newlocs
|
||||||
in foldl' (flip $ M.alter $ removeKeyRepoSize k) m' removedlocs
|
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
|
recordContentIdentifier (RemoteStateHandle u) cid k = do
|
||||||
c <- currentVectorClock
|
c <- currentVectorClock
|
||||||
config <- Annex.getGitConfig
|
config <- Annex.getGitConfig
|
||||||
Annex.Branch.maybeChange
|
void $ Annex.Branch.maybeChange
|
||||||
(Annex.Branch.RegardingUUID [u])
|
(Annex.Branch.RegardingUUID [u])
|
||||||
(remoteContentIdentifierLogFile config k)
|
(remoteContentIdentifierLogFile config k)
|
||||||
(addcid c . parseLog)
|
(addcid c . parseLog)
|
||||||
|
|
|
@ -40,6 +40,7 @@ module Logs.Location (
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
import qualified Annex.Branch
|
import qualified Annex.Branch
|
||||||
import Annex.Branch (FileContents)
|
import Annex.Branch (FileContents)
|
||||||
|
import Annex.RepoSize.LiveUpdate
|
||||||
import Logs
|
import Logs
|
||||||
import Logs.Presence
|
import Logs.Presence
|
||||||
import Types.Cluster
|
import Types.Cluster
|
||||||
|
@ -81,11 +82,13 @@ logChange key u@(UUID _) s
|
||||||
| isClusterUUID u = noop
|
| isClusterUUID u = noop
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
config <- Annex.getGitConfig
|
config <- Annex.getGitConfig
|
||||||
maybeAddLog
|
changed <- maybeAddLog
|
||||||
(Annex.Branch.RegardingUUID [u])
|
(Annex.Branch.RegardingUUID [u])
|
||||||
(locationLogFile config key)
|
(locationLogFile config key)
|
||||||
s
|
s
|
||||||
(LogInfo (fromUUID u))
|
(LogInfo (fromUUID u))
|
||||||
|
when changed $
|
||||||
|
updateRepoSize u key s
|
||||||
logChange _ NoUUID _ = noop
|
logChange _ NoUUID _ = noop
|
||||||
|
|
||||||
{- Returns a list of repository UUIDs that, according to the log, have
|
{- Returns a list of repository UUIDs that, according to the log, have
|
||||||
|
@ -162,14 +165,15 @@ setDead key = do
|
||||||
ls <- compactLog <$> readLog logfile
|
ls <- compactLog <$> readLog logfile
|
||||||
mapM_ (go logfile) (filter (\l -> status l == InfoMissing) ls)
|
mapM_ (go logfile) (filter (\l -> status l == InfoMissing) ls)
|
||||||
where
|
where
|
||||||
go logfile l =
|
go logfile l = do
|
||||||
let u = toUUID (fromLogInfo (info l))
|
let u = toUUID (fromLogInfo (info l))
|
||||||
c = case date l of
|
c = case date l of
|
||||||
VectorClock v -> CandidateVectorClock $
|
VectorClock v -> CandidateVectorClock $
|
||||||
v + realToFrac (picosecondsToDiffTime 1)
|
v + realToFrac (picosecondsToDiffTime 1)
|
||||||
Unknown -> CandidateVectorClock 0
|
Unknown -> CandidateVectorClock 0
|
||||||
in addLog' (Annex.Branch.RegardingUUID [u]) logfile InfoDead
|
addLog' (Annex.Branch.RegardingUUID [u]) logfile InfoDead
|
||||||
(info l) c
|
(info l) c
|
||||||
|
updateRepoSize u key InfoDead
|
||||||
|
|
||||||
data Unchecked a = Unchecked (Annex (Maybe a))
|
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
|
{- When a LogLine already exists with the same status and info, but an
|
||||||
- older timestamp, that LogLine is preserved, rather than updating the log
|
- older timestamp, that LogLine is preserved, rather than updating the log
|
||||||
- with a newer timestamp.
|
- 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
|
maybeAddLog ru file logstatus loginfo = do
|
||||||
c <- currentVectorClock
|
c <- currentVectorClock
|
||||||
Annex.Branch.maybeChange ru file $ \b ->
|
Annex.Branch.maybeChange ru file $ \b ->
|
||||||
|
|
|
@ -32,11 +32,6 @@ Planned schedule of work:
|
||||||
|
|
||||||
* Implement [[track_free_space_in_repos_via_git-annex_branch]]:
|
* 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
|
* When calling journalledRepoSizes make sure that the current
|
||||||
process is prevented from making changes to the journal in another
|
process is prevented from making changes to the journal in another
|
||||||
thread. Probably lock the journal? (No need to worry about changes made
|
thread. Probably lock the journal? (No need to worry about changes made
|
||||||
|
|
|
@ -575,6 +575,7 @@ Executable git-annex
|
||||||
Annex.ReplaceFile
|
Annex.ReplaceFile
|
||||||
Annex.RemoteTrackingBranch
|
Annex.RemoteTrackingBranch
|
||||||
Annex.RepoSize
|
Annex.RepoSize
|
||||||
|
Annex.RepoSize.LiveUpdate
|
||||||
Annex.SafeDropProof
|
Annex.SafeDropProof
|
||||||
Annex.SpecialRemote
|
Annex.SpecialRemote
|
||||||
Annex.SpecialRemote.Config
|
Annex.SpecialRemote.Config
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue