From ec7f1f27362980e50201af6b1ef025627546b1f2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 9 Sep 2024 10:59:01 -0400 Subject: [PATCH] simulated repository construction working --- Annex/Sim.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ Command/Sim.hs | 20 +++++++++++++++++++- 2 files changed, 64 insertions(+), 1 deletion(-) diff --git a/Annex/Sim.hs b/Annex/Sim.hs index 0a94d36fb4..27f2ca01f7 100644 --- a/Annex/Sim.hs +++ b/Annex/Sim.hs @@ -132,6 +132,12 @@ data SimCommand | CommandRebalance Bool deriving (Show) +runSimCommand :: SimCommand -> SimState -> Annex SimState +runSimCommand cmd st = case applySimCommand cmd st of + Left err -> giveup err + Right (Right st') -> return st' + Right (Left mkst) -> mkst + applySimCommand :: SimCommand -> SimState @@ -408,6 +414,44 @@ data SimRepo = SimRepo , simRepoCurrState :: SimState } +{- Clones and updates SimRepos to reflect the SimState. -} +updateSimRepos :: Repo -> (UUID -> FilePath) -> SimState -> IO SimState +updateSimRepos parent getdest st = do + st' <- updateSimRepoStates st + cloneNewSimRepos parent getdest st' + +updateSimRepoStates :: SimState -> IO SimState +updateSimRepoStates st = go st (M.toList $ simRepoState st) + where + go st' [] = return st + go st' ((reponame, rst):rest) = case simRepo rst of + Just sr -> do + sr' <- updateSimRepoState st sr + let rst' = rst { simRepo = Just sr' } + let st'' = st + { simRepoState = M.insert reponame rst' + (simRepoState st) + } + go st'' rest + Nothing -> go st' rest + +cloneNewSimRepos :: Repo -> (UUID -> FilePath) -> SimState -> IO SimState +cloneNewSimRepos parent getdest = \st -> go st (M.toList $ simRepoState st) + where + go st [] = return st + go st ((reponame, rst):rest) = + case (simRepo rst, M.lookup reponame (simRepos st)) of + (Nothing, Just u) -> do + sr <- cloneSimRepo reponame u parent + (getdest u) st + let rst' = rst { simRepo = Just sr } + let st' = st + { simRepoState = M.insert reponame rst' + (simRepoState st) + } + go st' rest + _ -> go st rest + cloneSimRepo :: RepoName -> UUID -> Repo -> FilePath -> SimState -> IO SimRepo cloneSimRepo simreponame u parent dest st = do cloned <- boolSystem "git" @@ -489,6 +533,7 @@ updateSimRepoState newst sr = do , addDiff = recordMaxSize , removeDiff = flip recordMaxSize (MaxSize 0) } + -- XXX TODO update location logs from simLocations let ard' = ard { Annex.rebalance = simRebalance newst } return $ sr { simRepoAnnex = (ast, ard') diff --git a/Command/Sim.hs b/Command/Sim.hs index bf5a163a41..8baf5ae6f2 100644 --- a/Command/Sim.hs +++ b/Command/Sim.hs @@ -9,6 +9,10 @@ module Command.Sim where import Command import Annex.Sim +import qualified Annex +import Utility.Tmp.Dir + +import System.Random cmd :: Command cmd = command "sim" SectionTesting @@ -16,4 +20,18 @@ cmd = command "sim" SectionTesting paramCommand (withParams seek) seek :: CmdParams -> CommandSeek -seek = undefined +seek _ = do + rng <- initStdGen + repobyname <- mkGetExistingRepoByName + r <- Annex.gitRepo + withTmpDir "sim" $ \tmpdir -> do + let st = emptySimState rng repobyname + st' <- runSimCommand (CommandInit (RepoName "foo")) st + >>= runSimCommand (CommandTrustLevel (RepoName "foo") "trusted") + >>= runSimCommand (CommandUse (RepoName "bar") "here") + let simdir = \u -> tmpdir fromUUID u + st'' <- liftIO $ updateSimRepos r simdir st' + liftIO $ print tmpdir + _ <- liftIO $ getLine + return () + -- 2.30.2