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:
parent
7e8274c6b7
commit
52891711d2
10 changed files with 284 additions and 155 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue