{- git-annex command - - Copyright 2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE OverloadedStrings #-} module Command.Sim where import Command import Annex.Sim import Annex.Sim.File import Annex.Perms import System.Random cmd :: Command cmd = command "sim" SectionTesting "simulate a network of repositories" paramCommand (withParams seek) seek :: CmdParams -> CommandSeek seek ("start":[]) = startsim Nothing seek ("start":simfile:[]) = startsim (Just simfile) seek ("end":[]) = endsim seek ("show":[]) = do simdir <- fromRepo gitAnnexSimDir liftIO (restoreSim simdir) >>= \case Left err -> giveup err Right st -> showsim st seek ("run":simfile:[]) = startsim' (Just simfile) >>= cleanup where cleanup st = do st' <- liftIO $ quiesceSim st endsim when (simFailed st') $ do showsim st' giveup "Simulation shown above had errors." 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 -> do st' <- runSimCommand simcmd repobyname st liftIO $ suspendSim st' when (simFailed st' && not (simFailed st)) $ giveup "Simulation had errors." 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 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." showLongNote $ UnquotedString "Sim started." rng <- liftIO $ fst . random <$> getStdGen let st = emptySimState rng simdir case simfile of Nothing -> startup simdir st [] Just f -> liftIO (readFile f) >>= \c -> case parseSimFile c of Left err -> giveup err Right cs -> startup simdir st cs where startup simdir st cs = do repobyname <- mkGetExistingRepoByName createAnnexDirectory (toRawFilePath simdir) let st' = recordSeed st cs go st' repobyname cs go st _ [] = return st go st repobyname (c:cs) = do st' <- runSimCommand c repobyname st go st' repobyname cs 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