git-annex sim command is working

Had to add Read instances to Key and NumCopies and some other similar
types. I only expect to use those in serializing a sim. Of course, this
risks that implementation changes break reading old data. For a sim,
that would not be a big problem.
This commit is contained in:
Joey Hess 2024-09-12 16:07:44 -04:00
parent 7e8274c6b7
commit 52891711d2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
10 changed files with 284 additions and 155 deletions

View file

@ -12,9 +12,11 @@ module Command.Sim where
import Command
import Annex.Sim
import Annex.Sim.File
import Utility.Tmp.Dir
import Annex.Perms
import Utility.Env
import System.Random
import qualified Data.Map as M
cmd :: Command
cmd = command "sim" SectionTesting
@ -22,19 +24,78 @@ cmd = command "sim" SectionTesting
paramCommand (withParams seek)
seek :: CmdParams -> CommandSeek
seek _ = do
rng <- initStdGen
repobyname <- mkGetExistingRepoByName
withTmpDir "sim" $ \tmpdir -> do
let getpath = GetSimRepoPath $ \u -> tmpdir </> fromUUID u
let st = emptySimState rng repobyname getpath
st' <- runSimCommand (CommandInit (RepoName "foo")) st
>>= runSimCommand (CommandUse (RepoName "bar") "here")
>>= runSimCommand (CommandAdd "bigfile" 1000000 [RepoName "foo"])
>>= runSimCommand (CommandAction (RepoName "bar") (ActionGitPull (RemoteName "foo")))
>>= runSimCommand (CommandAction (RepoName "bar") (ActionGetWanted (RemoteName "foo")))
st'' <- liftIO $ updateSimRepos st'
liftIO $ print tmpdir
_ <- liftIO $ getLine
return ()
seek ("start":[]) = start Nothing
seek ("start":simfile:[]) = start (Just simfile)
seek ("end":[]) = do
simdir <- fromRepo gitAnnexSimDir
liftIO $ removeDirectoryRecursive $ fromRawFilePath simdir
seek ("visit":reponame:[]) = do
simdir <- fromRepo gitAnnexSimDir
liftIO (restoreSim simdir) >>= \case
Left err -> giveup err
Right st -> case M.lookup (RepoName reponame) (simRepos st) of
Just u -> do
let dir = simRepoDirectory st u
unlessM (liftIO $ doesDirectoryExist dir) $
giveup "Simulated repository unavailable."
showLongNote "Starting a shell in the simulated repository."
shellcmd <- liftIO $ fromMaybe "sh" <$> getEnv "SHELL"
exitcode <- liftIO $
safeSystem' shellcmd []
(\p -> p { cwd = Just dir })
showLongNote "Finished visit to simulated repository."
liftIO $ exitWith exitcode
Nothing -> giveup $ unwords
[ "There is no simulated repository with that name."
, "Choose from:"
, unwords $ map fromRepoName $ M.keys (simRepos st)
]
seek ps = case parseSimCommand ps of
Left err -> giveup err
Right simcmd -> do
repobyname <- mkGetExistingRepoByName
simdir <- fromRepo gitAnnexSimDir
liftIO (restoreSim simdir) >>= \case
Left err -> giveup err
Right st ->
runSimCommand simcmd repobyname st
>>= liftIO . saveState
start :: Maybe FilePath -> CommandSeek
start simfile = do
simdir <- fromRawFilePath <$> fromRepo gitAnnexSimDir
whenM (liftIO $ doesDirectoryExist simdir) $
giveup "A sim was previously started. Use `git-annex sim end` to stop it before starting a new one."
let simlogfile = case simfile of
Nothing -> simdir </> "log.sim"
Just f -> simdir </> takeFileName f
rng <- fst . random <$> initStdGen
let st = (emptySimState rng simdir)
{ simFile = Just simlogfile }
case simfile of
Nothing -> startup simdir st []
Just f -> case parseSimFile f of
Left err -> giveup err
Right cs -> startup simdir st cs
showLongNote $ UnquotedString "Sim started, logging to sim file "
<> QuotedPath (toRawFilePath simlogfile)
where
startup simdir st cs = do
repobyname <- mkGetExistingRepoByName
createAnnexDirectory (toRawFilePath simdir)
st' <- go st repobyname cs
liftIO $ saveState st'
go st _ [] = return st
go st repobyname (c:cs) = do
st' <- runSimCommand c repobyname st
go st' repobyname cs
saveState :: SimState SimRepo -> IO ()
saveState st = do
suspendSim st
case simFile st of
Just f -> writeFile f $ generateSimFile $ reverse $ simHistory st
Nothing -> noop