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

implement randomAction

Browse source
This commit is contained in:
Joey Hess 2024-09-09 17:20:13 -04:00
parent 217bc214b3
commit a674a54d87
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 30 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
Annex/Sim.hs
View file

@ -53,7 +53,7 @@ data SimState = SimState
{ simRepos :: M.Map RepoName UUID { simRepos :: M.Map RepoName UUID
, simRepoList :: [RepoName] , simRepoList :: [RepoName]
, simRepoState :: M.Map RepoName SimRepoState , simRepoState :: M.Map RepoName SimRepoState
, simConnections :: M.Map RepoName (S.Set RemoteName) , simConnections :: M.Map UUID (S.Set RemoteName)
, simFiles :: M.Map RawFilePath Key , simFiles :: M.Map RawFilePath Key
, simRng :: StdGen , simRng :: StdGen
, simTrustLevels :: M.Map UUID TrustLevel , simTrustLevels :: M.Map UUID TrustLevel
@ -161,7 +161,7 @@ applySimCommand
applySimCommand (CommandStep n) st applySimCommand (CommandStep n) st
| n > 0 = case randomRepo st of | n > 0 = case randomRepo st of
(Just (_repo, u), st') -> (Just (_repo, u), st') ->
let (act, st'') = randomAction st' let (act, st'') = randomAction u st'
st''' = applySimAction u act st'' st''' = applySimAction u act st''
in applySimCommand (CommandStep (pred n)) st''' in applySimCommand (CommandStep (pred n)) st'''
(Nothing, st') -> Right $ Right st' (Nothing, st') -> Right $ Right st'
@ -189,20 +189,20 @@ applySimCommand' (CommandUse reponame s) st =
++ fromRepoName reponame ++ fromRepoName reponame
++ "\" in the simulation because " ++ msg ++ "\" in the simulation because " ++ msg
applySimCommand' (CommandConnect repo remote) st = applySimCommand' (CommandConnect repo remote) st =
checkKnownRepo repo st $ const $ Right $ Right $ st checkKnownRepo repo st $ \u -> Right $ Right $ st
{ simConnections = { simConnections =
let s = case M.lookup repo (simConnections st) of let s = case M.lookup u (simConnections st) of
Just cs -> S.insert remote cs Just cs -> S.insert remote cs
Nothing -> S.singleton remote Nothing -> S.singleton remote
in M.insert repo s (simConnections st) in M.insert u s (simConnections st)
} }
applySimCommand' (CommandDisconnect repo remote) st = applySimCommand' (CommandDisconnect repo remote) st =
checkKnownRepo repo st $ const $ Right $ Right $ st checkKnownRepo repo st $ \u -> Right $ Right $ st
{ simConnections = { simConnections =
let sc = case M.lookup repo (simConnections st) of let sc = case M.lookup u (simConnections st) of
Just s -> S.delete remote s Just s -> S.delete remote s
Nothing -> S.empty Nothing -> S.empty
in M.insert repo sc (simConnections st) in M.insert u sc (simConnections st)
} }
applySimCommand' (CommandAddTree repo expr) st = applySimCommand' (CommandAddTree repo expr) st =
checkKnownRepo repo st $ const $ checkKnownRepo repo st $ const $
@ -335,8 +335,27 @@ randomRepo st
u <- M.lookup r (simRepos st) u <- M.lookup r (simRepos st)
return (r, u) return (r, u)
randomAction :: SimState -> (SimAction, SimState) randomAction :: UUID -> SimState -> (SimAction, SimState)
randomAction = undefined -- XXX TODO randomAction u st = case M.lookup u (simConnections st) of
Just cs | not (S.null cs) ->
let (mkact, st') = simRandom st (randomR (0, length mkactions - 1))
(mkactions !!)
(remote, st'') = simRandom st' (randomR (0, S.size cs - 1))
(`S.elemAt` cs)
in (mkact remote, st'')
-- When there are no remotes, this is the only possible action.
_ -> (ActionDropUnwanted Nothing, st)
where
mkactions =
[ ActionPull
, ActionPush
, ActionGetWanted
, ActionDropUnwanted . Just
, const (ActionDropUnwanted Nothing)
, ActionSendWanted
, ActionGitPush
, ActionGitPull
]
randomWords :: Int -> StdGen -> ([Word8], StdGen) randomWords :: Int -> StdGen -> ([Word8], StdGen)
randomWords = go [] randomWords = go []
@ -400,7 +419,7 @@ addRepo reponame simrepo st = st
then simRepoList st then simRepoList st
else reponame : simRepoList st else reponame : simRepoList st
, simRepoState = M.insert reponame rst (simRepoState st) , simRepoState = M.insert reponame rst (simRepoState st)
, simConnections = M.insert reponame mempty (simConnections st) , simConnections = M.insert u mempty (simConnections st)
, simGroups = M.insert u (simRepoGroups simrepo) (simGroups st) , simGroups = M.insert u (simRepoGroups simrepo) (simGroups st)
, simTrustLevels = M.insert u , simTrustLevels = M.insert u
(simRepoTrustLevel simrepo) (simRepoTrustLevel simrepo)