started work on getLiveRepoSizes
Doesn't quite compile
This commit is contained in:
Joey Hess
parent
db89e39df6
commit
21608716bd
3 changed files with 186 additions and 36 deletions
|
|
@ -25,11 +25,10 @@ module Database.RepoSize (
|
|||
closeDb,
|
||||
getRepoSizes,
|
||||
setRepoSizes,
|
||||
getLiveSizeChanges,
|
||||
getLiveRepoSizes,
|
||||
startingLiveSizeChange,
|
||||
successfullyFinishedLiveSizeChange,
|
||||
staleLiveSizeChange,
|
||||
getSizeChanges,
|
||||
removeStaleLiveSizeChange,
|
||||
) where
|
||||
|
||||
import Annex.Common
|
||||
|
|
@ -46,7 +45,8 @@ import qualified Utility.RawFilePath as R
|
|||
import Database.Persist.Sql hiding (Key)
|
||||
import Database.Persist.TH
|
||||
import qualified System.FilePath.ByteString as P
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
share [mkPersist sqlSettings, mkMigrate "migrateRepoSizes"] [persistLowerCase|
|
||||
-- Corresponds to location log information from the git-annex branch.
|
||||
|
|
@ -73,6 +73,13 @@ SizeChanges
|
|||
repo UUID
|
||||
rollingtotal FileSize
|
||||
UniqueRepoRollingTotal repo
|
||||
-- The most recent size changes that were removed from LiveSizeChanges
|
||||
-- upon successful completion.
|
||||
RecentChanges
|
||||
repo UUID
|
||||
key Key
|
||||
change SizeChange
|
||||
UniqueRecentChange repo key
|
||||
|]
|
||||
|
||||
{- Gets a handle to the database. It's cached in Annex state. -}
|
||||
|
|
@ -115,19 +122,21 @@ closeDb :: RepoSizeHandle -> Annex ()
|
|||
closeDb (RepoSizeHandle (Just h)) = liftIO $ H.closeDb h
|
||||
closeDb (RepoSizeHandle Nothing) = noop
|
||||
|
||||
{- Gets the sizes of repositories as of a commit to the git-annex
|
||||
- branch. -}
|
||||
getRepoSizes :: RepoSizeHandle -> IO (M.Map UUID RepoSize, Maybe Sha)
|
||||
getRepoSizes (RepoSizeHandle (Just h)) = H.queryDb h $ do
|
||||
sizemap <- M.fromList . map conv <$> getRepoSizes'
|
||||
sizemap <- M.fromList <$> getRepoSizes'
|
||||
annexbranchsha <- getAnnexBranchCommit
|
||||
return (sizemap, annexbranchsha)
|
||||
getRepoSizes (RepoSizeHandle Nothing) = return (mempty, Nothing)
|
||||
|
||||
getRepoSizes' :: SqlPersistM [(UUID, RepoSize)]
|
||||
getRepoSizes' = map conv <$> selectList [] []
|
||||
where
|
||||
conv entity =
|
||||
let RepoSizes u sz = entityVal entity
|
||||
in (u, RepoSize sz)
|
||||
getRepoSizes (RepoSizeHandle Nothing) = return (mempty, Nothing)
|
||||
|
||||
getRepoSizes' :: SqlPersistM [Entity RepoSizes]
|
||||
getRepoSizes' = selectList [] []
|
||||
|
||||
getAnnexBranchCommit :: SqlPersistM (Maybe Sha)
|
||||
getAnnexBranchCommit = do
|
||||
|
|
@ -149,8 +158,8 @@ getAnnexBranchCommit = do
|
|||
setRepoSizes :: RepoSizeHandle -> M.Map UUID RepoSize -> Sha -> IO ()
|
||||
setRepoSizes (RepoSizeHandle (Just h)) sizemap branchcommitsha =
|
||||
H.commitDb h $ do
|
||||
l <- getRepoSizes'
|
||||
forM_ (map entityVal l) $ \(RepoSizes u _) ->
|
||||
l <- getRepoSizes'
|
||||
forM_ (map fst l) $ \u ->
|
||||
unless (M.member u sizemap) $
|
||||
unsetRepoSize u
|
||||
forM_ (M.toList sizemap) $
|
||||
|
|
@ -173,8 +182,6 @@ recordAnnexBranchCommit branchcommitsha = do
|
|||
deleteWhere ([] :: [Filter AnnexBranch])
|
||||
void $ insertUniqueFast $ AnnexBranch $ toSSha branchcommitsha
|
||||
|
||||
{- If there is already a size change for the same UUID, Key,
|
||||
- and SizeChangeId, it is overwritten with the new size change. -}
|
||||
startingLiveSizeChange :: RepoSizeHandle -> UUID -> Key -> SizeChange -> SizeChangeId -> IO ()
|
||||
startingLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
|
||||
H.commitDb h $ void $ upsertBy
|
||||
|
|
@ -188,10 +195,11 @@ startingLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop
|
|||
successfullyFinishedLiveSizeChange :: RepoSizeHandle -> UUID -> Key -> SizeChange -> SizeChangeId -> IO ()
|
||||
successfullyFinishedLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
|
||||
H.commitDb h $ do
|
||||
-- Update the rolling total and remove the live change in the
|
||||
-- same transaction.
|
||||
-- Update the rolling total, add as a recent change,
|
||||
-- and remove the live change in the same transaction.
|
||||
rollingtotal <- getSizeChangeFor u
|
||||
setSizeChangeFor u (updaterollingtotal rollingtotal)
|
||||
setSizeChangeFor u (updateRollingTotal rollingtotal sc k)
|
||||
addRecentChange u k sc
|
||||
removeLiveSizeChange u k sc sid
|
||||
where
|
||||
updaterollingtotal t = case sc of
|
||||
|
|
@ -200,10 +208,17 @@ successfullyFinishedLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
|
|||
ksz = fromMaybe 0 $ fromKey keySize k
|
||||
successfullyFinishedLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop
|
||||
|
||||
staleLiveSizeChange :: RepoSizeHandle -> UUID -> Key -> SizeChange -> SizeChangeId -> IO ()
|
||||
staleLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
|
||||
updateRollingTotal :: FileSize -> SizeChange -> Key -> FileSize
|
||||
updateRollingTotal t sc k = case sc of
|
||||
AddingKey -> t + ksz
|
||||
RemovingKey -> t - ksz
|
||||
where
|
||||
ksz = fromMaybe 0 $ fromKey keySize k
|
||||
|
||||
removeStaleLiveSizeChange :: RepoSizeHandle -> UUID -> Key -> SizeChange -> SizeChangeId -> IO ()
|
||||
removeStaleLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
|
||||
H.commitDb h $ removeLiveSizeChange u k sc sid
|
||||
staleLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop
|
||||
removeStaleLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop
|
||||
|
||||
removeLiveSizeChange :: UUID -> Key -> SizeChange -> SizeChangeId -> SqlPersistM ()
|
||||
removeLiveSizeChange u k sc sid =
|
||||
|
|
@ -214,25 +229,15 @@ removeLiveSizeChange u k sc sid =
|
|||
, LiveSizeChangesChange ==. sc
|
||||
]
|
||||
|
||||
getLiveSizeChanges :: RepoSizeHandle -> IO (M.Map UUID (Key, SizeChange, SizeChangeId))
|
||||
getLiveSizeChanges (RepoSizeHandle (Just h)) = H.queryDb h $ do
|
||||
m <- M.fromList . map conv <$> getLiveSizeChanges'
|
||||
return m
|
||||
getLiveSizeChanges :: SqlPersistM (M.Map UUID [(Key, (SizeChange, SizeChangeId))])
|
||||
getLiveSizeChanges = M.fromListWith (++) . map conv <$> selectList [] []
|
||||
where
|
||||
conv entity =
|
||||
let LiveSizeChanges u k sid sc = entityVal entity
|
||||
in (u, (k, sc, sid))
|
||||
getLiveSizeChanges (RepoSizeHandle Nothing) = return mempty
|
||||
in (u, [(k, (sc, sid))])
|
||||
|
||||
getLiveSizeChanges' :: SqlPersistM [Entity LiveSizeChanges]
|
||||
getLiveSizeChanges' = selectList [] []
|
||||
|
||||
getSizeChanges :: RepoSizeHandle -> IO (M.Map UUID FileSize)
|
||||
getSizeChanges (RepoSizeHandle (Just h)) = H.queryDb h getSizeChanges'
|
||||
getSizeChanges (RepoSizeHandle Nothing) = return mempty
|
||||
|
||||
getSizeChanges' :: SqlPersistM (M.Map UUID FileSize)
|
||||
getSizeChanges' = M.fromList . map conv <$> selectList [] []
|
||||
getSizeChanges :: SqlPersistM (M.Map UUID FileSize)
|
||||
getSizeChanges = M.fromList . map conv <$> selectList [] []
|
||||
where
|
||||
conv entity =
|
||||
let SizeChanges u n = entityVal entity
|
||||
|
|
@ -251,3 +256,96 @@ setSizeChangeFor u sz =
|
|||
(UniqueRepoRollingTotal u)
|
||||
(SizeChanges u sz)
|
||||
[SizeChangesRollingtotal =. sz]
|
||||
|
||||
addRecentChange :: UUID -> Key -> SizeChange -> SqlPersistM ()
|
||||
addRecentChange u k sc =
|
||||
void $ upsertBy
|
||||
(UniqueRecentChange u k)
|
||||
(RecentChanges u k sc)
|
||||
[RecentChangesChange =. sc]
|
||||
|
||||
getRecentChange :: UUID -> Key -> SqlPersistM (Maybe SizeChange)
|
||||
getRecentChange u k = do
|
||||
l <- selectList
|
||||
[ RecentChangesRepo ==. u
|
||||
, RecentChangesKey ==. k
|
||||
] []
|
||||
return $ case l of
|
||||
(s:_) -> Just $ recentChangesChange $ entityVal s
|
||||
[] -> Nothing
|
||||
|
||||
{- Gets the sizes of Repos as of a commit to the git-annex branch
|
||||
- (which is not necessarily the current commit), adjusted with all
|
||||
- live changes that have happened since then or are happening now.
|
||||
-
|
||||
- This does not necessarily include all changes that have been journalled,
|
||||
- only ones that had startingLiveSizeChange called for them will be
|
||||
- included. Also live changes or recent changes that were to a UUID not in
|
||||
- the RepoSizes map are not included.
|
||||
-
|
||||
- In the unlikely case where two live changes are occurring, one
|
||||
- adding a key and the other removing the same key, the one
|
||||
- adding the key is used, in order to err on the side of a larger
|
||||
- RepoSize.
|
||||
-
|
||||
- Omits live changes that are redundant due to a recent change already
|
||||
- being recorded for the same change.
|
||||
-
|
||||
- This is only expensive when there are a lot of live changes happening at
|
||||
- the same time.
|
||||
-}
|
||||
getLiveRepoSizes :: RepoSizeHandle -> IO (M.Map UUID RepoSize, Maybe Sha)
|
||||
getLiveRepoSizes (RepoSizeHandle (Just h)) = H.queryDb h $ do
|
||||
sizechanges <- getSizeChanges
|
||||
livechanges <- getLiveSizeChanges
|
||||
reposizes <- getRepoSizes'
|
||||
annexbranchsha <- getAnnexBranchCommit
|
||||
m <- M.fromList <$> forM reposizes (go sizechanges livechanges)
|
||||
return (m, annexbranchsha)
|
||||
where
|
||||
go
|
||||
:: M.Map UUID FileSize
|
||||
-> M.Map UUID [(Key, (SizeChange, SizeChangeId))]
|
||||
-> (UUID, RepoSize)
|
||||
-> SqlPersistM (UUID, RepoSize)
|
||||
go sizechanges livechanges (u, RepoSize startsize) = do
|
||||
let livechangesbykey =
|
||||
M.fromListWith (++) $ maybe [] (\v -> [v]) $
|
||||
M.lookup u livechanges
|
||||
livechanges' <- combinelikelivechanges <$>
|
||||
filterM (nonredundantlivechange livechangesbykey u)
|
||||
(fromMaybe [] $ M.lookup u livechanges)
|
||||
let sizechange = foldl'
|
||||
(\t (k, sc) -> updateRollingTotal t sc k)
|
||||
(fromMaybe 0 (M.lookup u sizechanges))
|
||||
livechanges'
|
||||
return (u, RepoSize (startsize + sizechange))
|
||||
|
||||
combinelikelivechanges =
|
||||
S.elems
|
||||
. S.fromList
|
||||
. map (\(k, (sc, _)) -> (k, sc))
|
||||
|
||||
nonredundantlivechange
|
||||
:: M.Map Key [(SizeChange, SizeChangeId)]
|
||||
-> UUID
|
||||
-> (Key, (SizeChange, SizeChangeId))
|
||||
-> SqlPersistM Bool
|
||||
nonredundantlivechange livechangesbykey u (k, (sc, cid))
|
||||
| null (competinglivechanges livechangesbykey k sc cid) =
|
||||
getRecentChange u k >>= pure . \case
|
||||
Nothing -> True
|
||||
Just sc' -> sc /= sc'
|
||||
| otherwise = pure False
|
||||
|
||||
competinglivechanges
|
||||
:: M.Map Key [(SizeChange, SizeChangeId)]
|
||||
-> Key
|
||||
-> SizeChange
|
||||
-> SizeChangeId
|
||||
-> [(SizeChange, SizeChangeId)]
|
||||
competinglivechanges livechangesbykey k RemovingKey cid =
|
||||
filter (\(sc', cid') -> cid /= cid' && sc' == AddingKey)
|
||||
(fromMaybe [] $ M.lookup k livechangesbykey)
|
||||
competinglivechanges _ _ AddingKey _ = []
|
||||
getLiveRepoSizes (RepoSizeHandle Nothing) = return mempty
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue