simulated repository construction working

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index 0a94d36fb4e0fe63bcb5cb2195b1f86f2d45bba2..27f2ca01f7e00757b1d4dbe743855b0af2afa460 100644 (file)
--- 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 bf5a163a412f51dc9cb4d2200f14c309d65351da..8baf5ae6f28609a417906643d57a730942f6834f 100644 (file)
--- 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 ()
+