sim: add stepstable

Annex/Sim.hs

@@ -73,6 +73,7 @@ data SimState t = SimState
 	, simHistory :: [SimCommand]
 	, simVectorClock :: VectorClock
 	, simRootDirectory :: FilePath
+	, simFailed :: Bool
 	}
 	deriving (Show, Read)
 
@@ -95,6 +96,7 @@ emptySimState rngseed rootdir = SimState
 	, simHistory = []
 	, simVectorClock = VectorClock 0
 	, simRootDirectory = rootdir
+	, simFailed = False
 	}
 
 -- State that can vary between different repos in the simulation.
@@ -209,6 +211,7 @@ data SimCommand
 	| CommandAdd RawFilePath ByteSize [RepoName]
 	| CommandAddMulti Int String ByteSize ByteSize [RepoName]
 	| CommandStep Int
+	| CommandStepStable Int
 	| CommandAction SimAction
 	| CommandSeed Int
 	| CommandPresent RepoName RawFilePath
@@ -262,13 +265,19 @@ applySimCommand (CommandPresent repo file) st _ = checkKnownRepo repo st $ \u ->
 				Right $ Right st
 			| otherwise -> missing
 		(Just _, Nothing) -> missing
-		(Nothing, _) -> Left $ "Expected " ++ fromRawFilePath file
+		(Nothing, _) -> Right $ Left $ do
-			++ " to be present in " ++ fromRepoName repo 
+			showLongNote $ UnquotedString $
-			++ ", but the simulation does not include that file."
+				"Expected " ++ fromRawFilePath file
+					++ " to be present in " ++ fromRepoName repo 
+					++ ", but the simulation does not include that file."
+			return $ st { simFailed = True }
   where
-	missing = Left $ "Expected " ++ fromRawFilePath file
+	missing = Right $ Left $ do
-		++ " to be present in " 
+		showLongNote $ UnquotedString $
-		++ fromRepoName repo ++ ", but it is not."
+			"Expected " ++ fromRawFilePath file
+				++ " to be present in " 
+				++ fromRepoName repo ++ ", but it is not."
+		return $ st { simFailed = True }
 applySimCommand (CommandNotPresent repo file) st _ = checkKnownRepo repo st $ \u ->
 	case (M.lookup file (simFiles st), M.lookup u (simRepoState st)) of
 		(Just k, Just rst)
@@ -276,13 +285,19 @@ applySimCommand (CommandNotPresent repo file) st _ = checkKnownRepo repo st $ \u
 				Right $ Right st
 			| otherwise -> present
 		(Just _, Nothing) -> present
-		(Nothing, _) -> Left $ "Expected " ++ fromRawFilePath file
+		(Nothing, _) -> Right $ Left $ do
-			++ " to not be present in " ++ fromRepoName repo 
+			showLongNote $ UnquotedString $ 
-			++ ", but the simulation does not include that file."
+				"Expected " ++ fromRawFilePath file
+					++ " to not be present in " ++ fromRepoName repo 
+					++ ", but the simulation does not include that file."
+			return $ st { simFailed = True }
   where
-	present = Left $ "Expected " ++ fromRawFilePath file 
+	present = Right $ Left $ do
-		++ " not to be present in " 
+		showLongNote $ UnquotedString $
-		++ fromRepoName repo ++ ", but it is present."
+			"Expected " ++ fromRawFilePath file 
+			++ " not to be present in " 
+			++ fromRepoName repo ++ ", but it is present."
+		return $ st { simFailed = True }
 applySimCommand c@(CommandVisit repo cmdparams) st _ =
 	checkKnownRepo repo st $ \u -> Right $ Left $ do
 		st' <- liftIO $ updateSimRepos st
@@ -425,7 +440,9 @@ applySimCommand' (CommandAddMulti n suffix minsz maxsz repos) st repobyname =
 				n' -> applySimCommand' (CommandAddMulti n' suffix minsz maxsz repos) st'' repobyname
 		Right (Left _) -> error "applySimCommand' CommandAddMulti"
 applySimCommand' (CommandStep n) st _ = 
-	Right $ Left $ handleStep n n st
+	Right $ Left $ handleStep False n n st
+applySimCommand' (CommandStepStable n) st _ = 
+	Right $ Left $ handleStep True n n st
 applySimCommand' (CommandAction act) st _ =
 	case getSimActionComponents act st of
 		Left err -> Left err
@@ -512,8 +529,8 @@ applySimCommand' (CommandVisit _ _) _ _ = error "applySimCommand' CommandVisit"
 applySimCommand' (CommandPresent _ _) _ _ = error "applySimCommand' CommandPresent"
 applySimCommand' (CommandNotPresent _ _) _ _ = error "applySimCommand' CommandNotPresent"
 
-handleStep :: Int -> Int -> SimState SimRepo -> Annex (SimState SimRepo)
+handleStep :: Bool -> Int -> Int -> SimState SimRepo -> Annex (SimState SimRepo)
-handleStep startn n st
+handleStep muststabilize startn n st
 	| n > 0 = do
 		let (st', actions) = getactions unsyncactions st
 		(st'', restactions) <- runoneaction actions st'
@@ -530,14 +547,22 @@ handleStep startn n st
 						return st''''
 					else runrest restactions' st'''' (pred n)
 			else runrest restactions st'' (pred n)
-	| otherwise = return st
+	| otherwise = checkstabalized st
   where
 	runrest actions st' n'
 		| n' > 0 = do
 			(st'', restactions) <- runoneaction actions st'
 			if null restactions
-				then handleStep startn n' st'
+				then handleStep muststabilize startn n' st'
 				else runrest restactions st'' (pred n')
+		| otherwise = checkstabalized st'
+
+	checkstabalized st'
+		| muststabilize = do
+			showLongNote $ UnquotedString $ 
+				"Simulation failed to stabilize after "
+					++ show startn ++ " steps."
+			return $ st' { simFailed = True }
 		| otherwise = return st'
 
 	unsyncactions = 

Annex/Sim/File.hs

@@ -53,6 +53,8 @@ generateSimFile = unlines . map unwords . go
 		(["addmulti", show n, suffix, showsize minsz, showsize maxsz] ++ map fromRepoName repos) : go rest
 	go (CommandStep n : rest) =
 		["step", show n] : go rest
+	go (CommandStepStable n : rest) =
+		["stepstable", show n] : go rest
 	go (CommandAction act : rest) = formatAction act : go rest
 	go (CommandSeed n : rest) =
 		["seed", show n] : go rest
@@ -151,6 +153,10 @@ parseSimCommand ("step":n:[]) =
 	case readMaybe n of
 			Just n' -> Right $ CommandStep n'
 			Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\""
+parseSimCommand ("stepstable":n:[]) =
+	case readMaybe n of
+			Just n' -> Right $ CommandStepStable n'
+			Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\""
 parseSimCommand l@("action":_) = case parseSimAction l of
 	Right act -> Right $ CommandAction act
 	Left err -> Left err

Command/Sim.hs

@@ -42,9 +42,11 @@ seek ps = case parseSimCommand ps of
 		simdir <- fromRepo gitAnnexSimDir
 		liftIO (restoreSim simdir) >>= \case
 			Left err -> giveup err
-			Right st -> 
+			Right st -> do
-				runSimCommand simcmd repobyname st
+				st' <- runSimCommand simcmd repobyname st
-					>>= liftIO . suspendSim
+				liftIO $ suspendSim st'
+				when (simFailed st' && not (simFailed st)) $
+					giveup "Simulation had errors."
 
 start :: Maybe FilePath -> CommandSeek
 start simfile = do
@@ -68,6 +70,8 @@ start simfile = do
 		let st' = recordSeed st cs
 		st'' <- go st' repobyname cs
 		liftIO $ suspendSim st''
+		when (simFailed st'') $
+			giveup "Simulation had errors."
 
 	go st _ [] = return st
 	go st repobyname (c:cs) = do

doc/git-annex-sim.mdwn

@@ -196,6 +196,14 @@ as passed to "git annex sim" while a simulation is running.
   This also simulates git pull and git push being run in each repository,
   as needed in order to find additional things to do.
 
+* `stepstable N`
+
+  Run the simulation forward by this many steps, at which point it is
+  expected to have stabilized.
+
+  If the simulation does not stabilize, the command will exit with a
+  nonzero exit state.
+
 * `action repo getwanted remote`
 
   Simulate the repository getting files it wants from the remote.