3e6eb2a58d
Plan is to run this when populating Annex.reposizes on demand. So Annex.reposizes will be up-to-date with the journal, including crucially journal entries for private repositories. But also anything that has been written to the journal by another process, especially if the process was ran with annex.alwayscommit=false. From there, Annex.reposizes can be kept up to date with changes made by the running process.
64 lines
2.1 KiB
Haskell
64 lines
2.1 KiB
Haskell
{- git-annex repo sizes
|
|
-
|
|
- Copyright 2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.RepoSize where
|
|
|
|
import Annex.Common
|
|
import Annex.Branch (UnmergedBranches(..))
|
|
import Types.RepoSize
|
|
import Logs.Location
|
|
import Logs.UUID
|
|
import Git.Types (Sha)
|
|
|
|
import qualified Data.Map.Strict as M
|
|
|
|
{- Sum up the sizes of all keys in all repositories, from the information
|
|
- in the git-annex branch, but not the journal. Retuns the sha of the
|
|
- branch commit that was used.
|
|
-
|
|
- The map includes the UUIDs of all known repositories, including
|
|
- repositories that are empty.
|
|
-
|
|
- Note that private repositories, which do not get recorded in
|
|
- the git-annex branch, will have 0 size. journalledRepoSizes
|
|
- takes care of getting repo sizes for those.
|
|
-}
|
|
calcBranchRepoSizes :: Annex (M.Map UUID RepoSize, Sha)
|
|
calcBranchRepoSizes = do
|
|
knownuuids <- M.keys <$> uuidDescMap
|
|
let startmap = M.fromList $ map (\u -> (u, RepoSize 0)) knownuuids
|
|
overLocationLogs True startmap accumsizes >>= \case
|
|
UnmergedBranches v -> return v
|
|
NoUnmergedBranches v -> return v
|
|
where
|
|
accumsizes k locs m = return $
|
|
foldl' (flip $ M.alter $ addKeyRepoSize k) m locs
|
|
|
|
{- Given the RepoSizes calculated from the git-annex branch, updates it with
|
|
- data from journalled location logs.
|
|
-}
|
|
journalledRepoSizes :: M.Map UUID RepoSize -> Sha -> Annex (M.Map UUID RepoSize)
|
|
journalledRepoSizes startmap branchsha =
|
|
overLocationLogsJournal startmap branchsha accumsizes
|
|
where
|
|
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
|