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.

Command/Sim.hs

@@ -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