mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

set location logs in simulated repos

Browse source
This commit is contained in:
Joey Hess 2024-09-09 14:52:24 -04:00
parent 52c6434b87
commit 21da5aadec
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 49 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

82
Annex/Sim.hs
View file

@ -23,7 +23,6 @@ import Annex.UUID
import Annex.FileMatcher import Annex.FileMatcher
import Annex.Init import Annex.Init
import Annex.Startup import Annex.Startup
import Annex.Locations
import Annex.Link import Annex.Link
import Logs.Group import Logs.Group
import Logs.Trust import Logs.Trust
@ -33,6 +32,7 @@ import Logs.Remote
import Logs.MaxSize import Logs.MaxSize
import Logs.Difference import Logs.Difference
import Logs.UUID import Logs.UUID
import Logs.Location
import qualified Annex import qualified Annex
import qualified Remote import qualified Remote
import qualified Git.Construct import qualified Git.Construct
@ -97,7 +97,7 @@ emptySimState rng repobyname = SimState
-- State that can vary between different repos in the simulation. -- State that can vary between different repos in the simulation.
data SimRepoState = SimRepoState data SimRepoState = SimRepoState
{ simLocations :: M.Map Key (S.Set RepoName) { simLocations :: M.Map Key (S.Set UUID)
, simIsSpecialRemote :: Bool , simIsSpecialRemote :: Bool
, simRepo :: Maybe SimRepo , simRepo :: Maybe SimRepo
} }
@ -105,10 +105,10 @@ data SimRepoState = SimRepoState
instance Show SimRepoState where instance Show SimRepoState where
show _ = "SimRepoState" show _ = "SimRepoState"
setPresentKey :: RepoName -> Key -> SimRepoState -> SimRepoState setPresentKey :: UUID -> Key -> SimRepoState -> SimRepoState
setPresentKey repo k rst = rst setPresentKey u k rst = rst
{ simLocations = { simLocations =
M.insertWith S.union k (S.singleton repo) (simLocations rst) M.insertWith S.union k (S.singleton u) (simLocations rst)
} }
newtype RepoName = RepoName { fromRepoName :: String } newtype RepoName = RepoName { fromRepoName :: String }
@ -183,13 +183,13 @@ applySimCommand (CommandAddTree repo expr) st =
checkKnownRepo repo st $ const $ checkKnownRepo repo st $ const $
checkValidPreferredContentExpression expr $ Left $ checkValidPreferredContentExpression expr $ Left $
error "TODO" -- XXX error "TODO" -- XXX
applySimCommand (CommandAdd file sz repo) st = checkKnownRepo repo st $ const $ applySimCommand (CommandAdd file sz repo) st = checkKnownRepo repo st $ \u ->
let (k, st') = genSimKey sz st let (k, st') = genSimKey sz st
in Right $ Right $ st' in Right $ Right $ st'
{ simFiles = M.insert (toRawFilePath file) k (simFiles st') { simFiles = M.insert (toRawFilePath file) k (simFiles st')
, simRepoState = case M.lookup repo (simRepoState st') of , simRepoState = case M.lookup repo (simRepoState st') of
Just rst -> M.insert repo Just rst -> M.insert repo
(setPresentKey repo k rst) (setPresentKey u k rst)
(simRepoState st') (simRepoState st')
Nothing -> error "no simRepoState in applySimCommand CommandAdd" Nothing -> error "no simRepoState in applySimCommand CommandAdd"
} }
@ -201,10 +201,10 @@ applySimCommand (CommandStep n) st
applySimCommand (CommandSeed rngseed) st = Right $ Right $ st applySimCommand (CommandSeed rngseed) st = Right $ Right $ st
{ simRng = mkStdGen rngseed { simRng = mkStdGen rngseed
} }
applySimCommand (CommandPresent repo file) st = checkKnownRepo repo st $ const $ applySimCommand (CommandPresent repo file) st = checkKnownRepo repo st $ \u ->
case (M.lookup (toRawFilePath file) (simFiles st), M.lookup repo (simRepoState st)) of case (M.lookup (toRawFilePath file) (simFiles st), M.lookup repo (simRepoState st)) of
(Just k, Just rst) -> case M.lookup k (simLocations rst) of (Just k, Just rst) -> case M.lookup k (simLocations rst) of
Just locs | S.member repo locs -> Right $ Right st Just locs | S.member u locs -> Right $ Right st
_ -> missing _ -> missing
(Just _, Nothing) -> missing (Just _, Nothing) -> missing
(Nothing, _) -> Left $ "Expected " ++ file (Nothing, _) -> Left $ "Expected " ++ file
@ -213,10 +213,10 @@ applySimCommand (CommandPresent repo file) st = checkKnownRepo repo st $ const $
where where
missing = Left $ "Expected " ++ file ++ " to be present in " missing = Left $ "Expected " ++ file ++ " to be present in "
++ fromRepoName repo ++ ", but it is not." ++ fromRepoName repo ++ ", but it is not."
applySimCommand (CommandNotPresent repo file) st = checkKnownRepo repo st $ const $ applySimCommand (CommandNotPresent repo file) st = checkKnownRepo repo st $ \u ->
case (M.lookup (toRawFilePath file) (simFiles st), M.lookup repo (simRepoState st)) of case (M.lookup (toRawFilePath file) (simFiles st), M.lookup repo (simRepoState st)) of
(Just k, Just rst) -> case M.lookup k (simLocations rst) of (Just k, Just rst) -> case M.lookup k (simLocations rst) of
Just locs | S.notMember repo locs -> Right $ Right st Just locs | S.notMember u locs -> Right $ Right st
_ -> present _ -> present
(Just _, Nothing) -> present (Just _, Nothing) -> present
(Nothing, _) -> Left $ "Expected " ++ file (Nothing, _) -> Left $ "Expected " ++ file
@ -418,6 +418,7 @@ data SimRepo = SimRepo
{ simRepoGitRepo :: Repo { simRepoGitRepo :: Repo
, simRepoAnnex :: (Annex.AnnexState, Annex.AnnexRead) , simRepoAnnex :: (Annex.AnnexState, Annex.AnnexRead)
, simRepoCurrState :: SimState , simRepoCurrState :: SimState
, simRepoName :: RepoName
} }
{- Clones and updates SimRepos to reflect the SimState. -} {- Clones and updates SimRepos to reflect the SimState. -}
@ -494,6 +495,7 @@ cloneSimRepo simreponame u parent dest st = do
, simRepoCurrState = emptySimState , simRepoCurrState = emptySimState
(simRng st) (simRng st)
(simGetExistingRepoByName st) (simGetExistingRepoByName st)
, simRepoName = simreponame
} }
simulatedRepositoryDescription :: RepoName -> String simulatedRepositoryDescription :: RepoName -> String
@ -508,49 +510,57 @@ updateSimRepoState newst sr = do
((), (ast, ard)) <- Annex.run (simRepoAnnex sr) $ doQuietAction $ do ((), (ast, ard)) <- Annex.run (simRepoAnnex sr) $ doQuietAction $ do
let oldst = simRepoCurrState sr let oldst = simRepoCurrState sr
updateField oldst newst simRepos $ DiffUpdate updateField oldst newst simRepos $ DiffUpdate
{ replaceDiff = setdesc { replaceDiff = const . setdesc
, addDiff = setdesc , addDiff = setdesc
, removeDiff = const noop , removeDiff = const $ const noop
} }
updateField oldst newst simTrustLevels $ DiffUpdate updateField oldst newst simTrustLevels $ DiffUpdate
{ replaceDiff = trustSet { replaceDiff = const . trustSet
, addDiff = trustSet , addDiff = trustSet
, removeDiff = flip trustSet def , removeDiff = const . flip trustSet def
} }
when (simNumCopies oldst /= simNumCopies newst) $ when (simNumCopies oldst /= simNumCopies newst) $
setGlobalNumCopies (simNumCopies newst) setGlobalNumCopies (simNumCopies newst)
when (simMinCopies oldst /= simMinCopies newst) $ when (simMinCopies oldst /= simMinCopies newst) $
setGlobalMinCopies (simMinCopies newst) setGlobalMinCopies (simMinCopies newst)
updateField oldst newst simGroups $ DiffUpdate updateField oldst newst simGroups $ DiffUpdate
{ replaceDiff = \u -> groupChange u . const { replaceDiff = \u -> const . groupChange u . const
, addDiff = \u -> groupChange u . const , addDiff = \u -> groupChange u . const
, removeDiff = flip groupChange (const mempty) , removeDiff = const . flip groupChange (const mempty)
} }
updateField oldst newst simWanted $ DiffUpdate updateField oldst newst simWanted $ DiffUpdate
{ replaceDiff = preferredContentSet { replaceDiff = const . preferredContentSet
, addDiff = preferredContentSet , addDiff = preferredContentSet
, removeDiff = flip preferredContentSet mempty , removeDiff = const . flip preferredContentSet mempty
} }
updateField oldst newst simRequired $ DiffUpdate updateField oldst newst simRequired $ DiffUpdate
{ replaceDiff = requiredContentSet { replaceDiff = const . requiredContentSet
, addDiff = requiredContentSet , addDiff = requiredContentSet
, removeDiff = flip requiredContentSet mempty , removeDiff = const . flip requiredContentSet mempty
} }
updateField oldst newst simGroupWanted $ DiffUpdate updateField oldst newst simGroupWanted $ DiffUpdate
{ replaceDiff = groupPreferredContentSet { replaceDiff = const . groupPreferredContentSet
, addDiff = groupPreferredContentSet , addDiff = groupPreferredContentSet
, removeDiff = flip groupPreferredContentSet mempty , removeDiff = const . flip groupPreferredContentSet mempty
} }
updateField oldst newst simMaxSize $ DiffUpdate updateField oldst newst simMaxSize $ DiffUpdate
{ replaceDiff = recordMaxSize { replaceDiff = const . recordMaxSize
, addDiff = recordMaxSize , addDiff = recordMaxSize
, removeDiff = flip recordMaxSize (MaxSize 0) , removeDiff = const . flip recordMaxSize (MaxSize 0)
}
updateField oldst newst getlocations $ DiffUpdate
{ replaceDiff = \k oldls newls -> do
setlocations InfoPresent k
(S.difference newls oldls)
setlocations InfoMissing k
(S.difference oldls newls)
, addDiff = setlocations InfoPresent
, removeDiff = setlocations InfoMissing
} }
-- XXX TODO update location logs from simLocations
updateField oldst newst simFiles $ DiffUpdate updateField oldst newst simFiles $ DiffUpdate
{ replaceDiff = stageannexedfile { replaceDiff = const . stageannexedfile
, addDiff = stageannexedfile , addDiff = stageannexedfile
, removeDiff = unstageannexedfile , removeDiff = const . unstageannexedfile
} }
Annex.Queue.flush Annex.Queue.flush
let ard' = ard { Annex.rebalance = simRebalance newst } let ard' = ard { Annex.rebalance = simRebalance newst }
@ -569,11 +579,17 @@ updateSimRepoState newst sr = do
liftIO $ removeWhenExistsWith R.removeLink $ liftIO $ removeWhenExistsWith R.removeLink $
annexedfilepath f annexedfilepath f
annexedfilepath f = repoPath (simRepoGitRepo sr) P.</> f annexedfilepath f = repoPath (simRepoGitRepo sr) P.</> f
getlocations = maybe mempty simLocations
. M.lookup (simRepoName sr)
. simRepoState
setlocations s k ls =
mapM_ (\l -> logChange NoLiveUpdate k l s) (S.toList ls)
data DiffUpdate a b m = DiffUpdate data DiffUpdate a b m = DiffUpdate
{ replaceDiff :: a -> b -> m () { replaceDiff :: a -> b -> b -> m ()
-- ^ The first value is the new one, the second is the old one.
, addDiff :: a -> b -> m () , addDiff :: a -> b -> m ()
, removeDiff :: a -> m () , removeDiff :: a -> b -> m ()
} }
updateMap updateMap
@ -586,11 +602,11 @@ updateMap old new diffupdate = do
forM_ (M.toList $ M.intersectionWith (,) new old) $ forM_ (M.toList $ M.intersectionWith (,) new old) $
\(k, (newv, oldv))-> \(k, (newv, oldv))->
when (newv /= oldv) $ when (newv /= oldv) $
replaceDiff diffupdate k newv replaceDiff diffupdate k newv oldv
forM_ (M.toList $ M.difference new old) $ forM_ (M.toList $ M.difference new old) $
uncurry (addDiff diffupdate) uncurry (addDiff diffupdate)
forM_ (M.keys $ M.difference old new) $ forM_ (M.toList $ M.difference old new) $
removeDiff diffupdate \(k, oldv) -> removeDiff diffupdate k oldv
updateField updateField
:: (Monad m, Ord a, Eq b) :: (Monad m, Ord a, Eq b)