2024-09-04 19:10:39 +00:00
|
|
|
{- git-annex command
|
|
|
|
-
|
|
|
|
- Copyright 2024 Joey Hess <id@joeyh.name>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2024-09-11 14:32:04 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2024-09-04 19:10:39 +00:00
|
|
|
module Command.Sim where
|
|
|
|
|
|
|
|
import Command
|
|
|
|
import Annex.Sim
|
2024-09-11 15:53:25 +00:00
|
|
|
import Annex.Sim.File
|
2024-09-12 20:07:44 +00:00
|
|
|
import Annex.Perms
|
2024-09-09 14:59:01 +00:00
|
|
|
|
|
|
|
import System.Random
|
2024-09-04 19:10:39 +00:00
|
|
|
|
|
|
|
cmd :: Command
|
|
|
|
cmd = command "sim" SectionTesting
|
|
|
|
"simulate a network of repositories"
|
|
|
|
paramCommand (withParams seek)
|
|
|
|
|
|
|
|
seek :: CmdParams -> CommandSeek
|
2024-09-24 16:01:54 +00:00
|
|
|
seek ("start":[]) = startsim Nothing
|
|
|
|
seek ("start":simfile:[]) = startsim (Just simfile)
|
|
|
|
seek ("end":[]) = endsim
|
2024-09-17 17:43:11 +00:00
|
|
|
seek ("show":[]) = do
|
|
|
|
simdir <- fromRepo gitAnnexSimDir
|
|
|
|
liftIO (restoreSim simdir) >>= \case
|
|
|
|
Left err -> giveup err
|
2024-09-24 16:01:54 +00:00
|
|
|
Right st -> showsim st
|
|
|
|
seek ("run":simfile:[]) = startsim' (Just simfile) >>= cleanup
|
|
|
|
where
|
|
|
|
cleanup st = do
|
2024-09-24 20:46:09 +00:00
|
|
|
st' <- liftIO $ quiesceSim st
|
2024-09-24 16:01:54 +00:00
|
|
|
endsim
|
2024-09-24 20:46:09 +00:00
|
|
|
when (simFailed st') $ do
|
|
|
|
showsim st'
|
2024-09-24 16:01:54 +00:00
|
|
|
giveup "Simulation shown above had errors."
|
2024-09-12 20:07:44 +00:00
|
|
|
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
|
2024-09-24 15:47:20 +00:00
|
|
|
Right st -> do
|
|
|
|
st' <- runSimCommand simcmd repobyname st
|
|
|
|
liftIO $ suspendSim st'
|
|
|
|
when (simFailed st' && not (simFailed st)) $
|
|
|
|
giveup "Simulation had errors."
|
2024-09-09 14:59:01 +00:00
|
|
|
|
2024-09-24 16:01:54 +00:00
|
|
|
startsim :: Maybe FilePath -> CommandSeek
|
|
|
|
startsim simfile = startsim' simfile >>= cleanup
|
|
|
|
where
|
|
|
|
cleanup st = do
|
|
|
|
liftIO $ suspendSim st
|
|
|
|
when (simFailed st) $
|
|
|
|
giveup "Simulation had errors."
|
|
|
|
|
|
|
|
startsim' :: Maybe FilePath -> Annex (SimState SimRepo)
|
|
|
|
startsim' simfile = do
|
2024-09-12 20:07:44 +00:00
|
|
|
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."
|
|
|
|
|
2024-09-20 19:39:52 +00:00
|
|
|
showLongNote $ UnquotedString "Sim started."
|
2024-09-30 18:56:06 +00:00
|
|
|
rng <- fst . random <$> getStdGen
|
2024-09-20 18:57:55 +00:00
|
|
|
let st = emptySimState rng simdir
|
2024-09-12 20:07:44 +00:00
|
|
|
case simfile of
|
|
|
|
Nothing -> startup simdir st []
|
2024-09-12 20:39:44 +00:00
|
|
|
Just f -> liftIO (readFile f) >>= \c ->
|
|
|
|
case parseSimFile c of
|
|
|
|
Left err -> giveup err
|
|
|
|
Right cs -> startup simdir st cs
|
2024-09-12 20:07:44 +00:00
|
|
|
where
|
|
|
|
startup simdir st cs = do
|
|
|
|
repobyname <- mkGetExistingRepoByName
|
|
|
|
createAnnexDirectory (toRawFilePath simdir)
|
2024-09-17 17:49:50 +00:00
|
|
|
let st' = recordSeed st cs
|
2024-09-24 16:01:54 +00:00
|
|
|
go st' repobyname cs
|
2024-09-12 20:07:44 +00:00
|
|
|
|
|
|
|
go st _ [] = return st
|
|
|
|
go st repobyname (c:cs) = do
|
|
|
|
st' <- runSimCommand c repobyname st
|
|
|
|
go st' repobyname cs
|
2024-09-24 16:01:54 +00:00
|
|
|
|
|
|
|
endsim :: CommandSeek
|
|
|
|
endsim = do
|
|
|
|
simdir <- fromRawFilePath <$> fromRepo gitAnnexSimDir
|
|
|
|
whenM (liftIO $ doesDirectoryExist simdir) $ do
|
|
|
|
liftIO $ removeDirectoryRecursive simdir
|
|
|
|
showLongNote $ UnquotedString "Sim ended."
|
|
|
|
|
|
|
|
showsim :: SimState SimRepo -> Annex ()
|
|
|
|
showsim = liftIO . putStr . generateSimFile . reverse . simHistory
|