add live size changes to RepoSize database
Not yet used.
This commit is contained in:
parent
dad1fb150f
commit
4885073377
2 changed files with 54 additions and 0 deletions
|
@ -6,6 +6,7 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
|
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
|
||||||
{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
|
{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
|
||||||
|
@ -24,6 +25,9 @@ module Database.RepoSize (
|
||||||
closeDb,
|
closeDb,
|
||||||
getRepoSizes,
|
getRepoSizes,
|
||||||
setRepoSizes,
|
setRepoSizes,
|
||||||
|
getLiveSizeChanges,
|
||||||
|
startingLiveSizeChange,
|
||||||
|
finishedLiveSizeChange,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
|
@ -40,6 +44,7 @@ import Database.Persist.Sql hiding (Key)
|
||||||
import Database.Persist.TH
|
import Database.Persist.TH
|
||||||
import qualified System.FilePath.ByteString as P
|
import qualified System.FilePath.ByteString as P
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
newtype RepoSizeHandle = RepoSizeHandle (Maybe H.DbHandle)
|
newtype RepoSizeHandle = RepoSizeHandle (Maybe H.DbHandle)
|
||||||
|
|
||||||
|
@ -53,6 +58,12 @@ RepoSizes
|
||||||
AnnexBranch
|
AnnexBranch
|
||||||
commit SSha
|
commit SSha
|
||||||
UniqueCommit commit
|
UniqueCommit commit
|
||||||
|
-- Changes that are currently being made that affect repo sizes.
|
||||||
|
LiveSizeChanges
|
||||||
|
repo UUID
|
||||||
|
key Key
|
||||||
|
change SizeChange
|
||||||
|
UniqueLiveSizeChange repo key
|
||||||
|]
|
|]
|
||||||
|
|
||||||
{- Opens the database, creating it if it doesn't exist yet.
|
{- Opens the database, creating it if it doesn't exist yet.
|
||||||
|
@ -143,3 +154,45 @@ recordAnnexBranchCommit :: Sha -> SqlPersistM ()
|
||||||
recordAnnexBranchCommit branchcommitsha = do
|
recordAnnexBranchCommit branchcommitsha = do
|
||||||
deleteWhere ([] :: [Filter AnnexBranch])
|
deleteWhere ([] :: [Filter AnnexBranch])
|
||||||
void $ insertUniqueFast $ AnnexBranch $ toSSha branchcommitsha
|
void $ insertUniqueFast $ AnnexBranch $ toSSha branchcommitsha
|
||||||
|
|
||||||
|
data SizeChange = AddingKey | RemovingKey
|
||||||
|
|
||||||
|
{- If there is already a size change for the same UUID and Key, it is
|
||||||
|
- overwritten with the new size change. -}
|
||||||
|
startingLiveSizeChange :: UUID -> Key -> SizeChange -> SqlPersistM ()
|
||||||
|
startingLiveSizeChange u k sc =
|
||||||
|
void $ upsertBy
|
||||||
|
(UniqueLiveSizeChange u k)
|
||||||
|
(LiveSizeChanges u k sc)
|
||||||
|
[LiveSizeChangesChange =. sc]
|
||||||
|
|
||||||
|
finishedLiveSizeChange :: UUID -> Key -> SizeChange -> SqlPersistM ()
|
||||||
|
finishedLiveSizeChange u k sc = deleteWhere
|
||||||
|
[ LiveSizeChangesRepo ==. u
|
||||||
|
, LiveSizeChangesKey ==. k
|
||||||
|
, LiveSizeChangesChange ==. sc
|
||||||
|
]
|
||||||
|
|
||||||
|
getLiveSizeChanges :: RepoSizeHandle -> IO (M.Map UUID (Key, SizeChange))
|
||||||
|
getLiveSizeChanges (RepoSizeHandle (Just h)) = H.queryDb h $ do
|
||||||
|
m <- M.fromList . map conv <$> getLiveSizeChanges'
|
||||||
|
return m
|
||||||
|
where
|
||||||
|
conv entity =
|
||||||
|
let LiveSizeChanges u k sc = entityVal entity
|
||||||
|
in (u, (k, sc))
|
||||||
|
getLiveSizeChanges (RepoSizeHandle Nothing) = return mempty
|
||||||
|
|
||||||
|
getLiveSizeChanges' :: SqlPersistM [Entity LiveSizeChanges]
|
||||||
|
getLiveSizeChanges' = selectList [] []
|
||||||
|
|
||||||
|
instance PersistField SizeChange where
|
||||||
|
toPersistValue AddingKey = toPersistValue (1 :: Int)
|
||||||
|
toPersistValue RemovingKey = toPersistValue (-1 :: Int)
|
||||||
|
fromPersistValue b = fromPersistValue b >>= \case
|
||||||
|
(1 :: Int) -> Right AddingKey
|
||||||
|
-1 -> Right RemovingKey
|
||||||
|
v -> Left $ T.pack $ "bad serialized SizeChange "++ show v
|
||||||
|
|
||||||
|
instance PersistFieldSql SizeChange where
|
||||||
|
sqlType _ = SqlInt32
|
||||||
|
|
|
@ -79,6 +79,7 @@ Planned schedule of work:
|
||||||
|
|
||||||
Add to reposizes db a table for live updates.
|
Add to reposizes db a table for live updates.
|
||||||
Listing process ID, thread ID, UUID, key, addition or removal
|
Listing process ID, thread ID, UUID, key, addition or removal
|
||||||
|
(done)
|
||||||
|
|
||||||
Make checking the balanced preferred content limit record a
|
Make checking the balanced preferred content limit record a
|
||||||
live update in the table and use other live updates in making its
|
live update in the table and use other live updates in making its
|
||||||
|
|
Loading…
Reference in a new issue