move pull/push/sync into getSimActionComponents

As well as being a more pleasing implementation than I managed
yesterday, this allows for those actions to be run concurrently in the
sim.

Annex/Sim.hs

@@ -239,37 +239,12 @@ runSimCommand (CommandStep n) repobyname st
 				>>= runSimCommand (CommandStep (pred n)) repobyname
 		(Nothing, st') -> return st'
 	| otherwise = return st
-runSimCommand (CommandAction (ActionPull repo remote)) repobyname st =
-	runCompoundSimAction repobyname
-		[ CommandAction (ActionGitPull repo remote)
-		, CommandAction (ActionGetWanted repo remote)
-		, CommandAction (ActionDropUnwanted repo Nothing)
-		] st
-runSimCommand (CommandAction (ActionPush repo remote)) repobyname st =
-	runCompoundSimAction repobyname
-		[ CommandAction (ActionSendWanted repo remote)
-		, CommandAction (ActionDropUnwanted repo (Just remote))
-		, CommandAction (ActionGitPush repo remote)
-		] st
-runSimCommand (CommandAction (ActionSync repo remote)) repobyname st =
-	runCompoundSimAction repobyname
-		[ CommandAction (ActionGitPull repo remote)
-		, CommandAction (ActionGetWanted repo remote)
-		, CommandAction (ActionSendWanted repo remote)
-		, CommandAction (ActionDropUnwanted repo (Just remote))
-		, CommandAction (ActionGitPush repo remote)
-		] st
 runSimCommand cmd repobyname st = 
 	case applySimCommand cmd st repobyname of
 		Left err -> giveup err
 		Right (Right st') -> return st'
 		Right (Left mkst) -> mkst
 
-runCompoundSimAction :: GetExistingRepoByName -> [SimCommand] -> SimState SimRepo -> Annex (SimState SimRepo)
-runCompoundSimAction repobyname (a:as) st = 
-	runSimCommand a repobyname st >>= runCompoundSimAction repobyname as
-runCompoundSimAction _ [] st = return st
-
 applySimCommand
 	:: SimCommand
 	-> SimState SimRepo
@@ -530,11 +505,42 @@ getSimActionComponents (ActionWhile a b) st =
 		in if coinflip
 			then mingle subas (subb:subbs) st'' (suba:c)
 			else mingle (suba:subas) subbs st'' (subb:c)
--- These are handled by runSimCommand
+getSimActionComponents (ActionPull repo remote) st =
--- XXX move to here
+	simActionSequence
-getSimActionComponents (ActionPull _ _) _st = error "applySimAction ActionPull"
+		[ ActionGitPull repo remote
-getSimActionComponents (ActionPush _ _) _st = error "applySimAction ActionPush"
+		, ActionGetWanted repo remote
-getSimActionComponents (ActionSync _ _) _st = error "applySimAction ActionSync"
+		, ActionDropUnwanted repo Nothing
+		] st
+getSimActionComponents (ActionPush repo remote) st =
+	simActionSequence
+		[ ActionSendWanted repo remote
+		, ActionDropUnwanted repo (Just remote)
+		, ActionGitPush repo remote
+		] st
+getSimActionComponents (ActionSync repo remote) st =
+	simActionSequence
+		[ ActionGitPull repo remote
+		, ActionGetWanted repo remote
+		, ActionSendWanted repo remote
+		, ActionDropUnwanted repo (Just remote)
+		, ActionGitPush repo remote
+		] st
+
+simActionSequence
+	:: [SimAction]
+	-> SimState SimRepo
+	-> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (SimState SimRepo))
+simActionSequence [] st = Right (Right st)
+simActionSequence (a:as) st = case getSimActionComponents a st of
+	Left err -> Left err
+	Right (Right st') -> simActionSequence as st'
+	Right (Left (st', subas)) -> go st' subas as
+  where
+	go st' c [] = Right $ Left (st', c)
+	go st' c (a':as') = case getSimActionComponents a' st' of
+		Left err -> Left err
+		Right (Right st'') -> go st'' c as'
+		Right (Left (st'', subas)) -> go st'' (c ++ subas) as'
 
 overFilesRemote
 	:: RepoName

doc/todo/git-annex_proxies.mdwn

@@ -30,11 +30,17 @@ Planned schedule of work:
 
 * Currently working in [[todo/proving_preferred_content_behavior]]
 
-* sim: Add concurrency over actions.
+* sim: Test concurrency over actions.
+
+* sim: Test ActionDropUnwanted Nothing
 
 * sim: Command to create a set of files with random sizes in a specified
   range.
 
+* sim: implement addtree
+
+* sim: implement ActionDropUnwanted
+
 ## items deferred until later for balanced preferred content and maxsize tracking
 
 * `git-annex assist --rebalance` of `balanced=foo:2`