started on sim file parser

2024-09-11 11:53:25 -04:00 · 2024-09-11 11:53:25 -04:00 · 84bbbeae9d
commit 84bbbeae9d
parent c4609a73f2
5 changed files with 116 additions and 12 deletions
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@ -36,7 +36,6 @@ import Logs.Location
 import qualified Annex
 import qualified Remote
 import qualified Git.Construct
-import qualified Git.Remote.Remove
 import qualified Annex.Queue

 import System.Random
@ -161,7 +160,7 @@ data SimCommand
 	| CommandConnect RepoName RemoteName
 	| CommandDisconnect RepoName RemoteName
 	| CommandAddTree RepoName PreferredContentExpression
-	| CommandAdd RawFilePath ByteSize RepoName
+	| CommandAdd RawFilePath ByteSize [RepoName]
 	| CommandStep Int
 	| CommandAction RepoName SimAction
 	| CommandSeed Int
@ -177,6 +176,8 @@ data SimCommand
 	| CommandGroupWanted Group PreferredContentExpression
 	| CommandMaxSize RepoName MaxSize
 	| CommandRebalance Bool
+	| CommandComment String
+	| CommandBlank
 	deriving (Show)

 data SimAction
@ -207,11 +208,11 @@ applySimCommand
 	:: SimCommand
 	-> SimState
 	-> Either String (Either (Annex SimState) SimState)
-applySimCommand c st = 
-	applySimCommand' c $ flip addHistory c $ st
+applySimCommand cmd st = 
+	applySimCommand' cmd $ flip addHistory cmd $ st
 		{ simVectorClock = 
-			let (VectorClock c) = simVectorClock st 
-			in VectorClock (succ c)
+			let (VectorClock clk) = simVectorClock st 
+			in VectorClock (succ clk)
 		}

 applySimCommand'
@ -253,11 +254,16 @@ applySimCommand' (CommandAddTree repo expr) st =
 	checkKnownRepo repo st $ const $
 		checkValidPreferredContentExpression expr $ Left $
 			error "TODO" -- XXX
-applySimCommand' (CommandAdd file sz repo) st = checkKnownRepo repo st $ \u ->
+applySimCommand' (CommandAdd file sz repos) st = 
 	let (k, st') = genSimKey sz st
-	in Right $ Right $ setPresentKey u k repo $ st'
-		{ simFiles = M.insert file k (simFiles st')
-		}
+	in go k st' repos
+  where
+	go k st' [] = Right $ Right st
+	go k st' (repo:rest) = checkKnownRepo repo st' $ \u ->
+		let st'' = setPresentKey u k repo $ st'
+			{ simFiles = M.insert file k (simFiles st')
+			}
+		in go k st'' rest
 applySimCommand' (CommandStep _) _ = error "applySimCommand' CommandStep"
 applySimCommand' (CommandAction repo act) st =
 	checkKnownRepo repo st $ \u -> 
@ -335,6 +341,8 @@ applySimCommand' (CommandMaxSize repo sz) st = checkKnownRepo repo st $ \u ->
 applySimCommand' (CommandRebalance b) st = Right $ Right $ st
 	{ simRebalance = b
 	}
+applySimCommand' (CommandComment _) st = Right $ Right st
+applySimCommand' CommandBlank st = Right $ Right st

 applySimAction
 	:: RepoName
--- a/Annex/Sim/File.hs
+++ b/Annex/Sim/File.hs
@ -0,0 +1,94 @@
+{- sim files
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Annex.Sim.File where
+
+import Annex.Sim
+import Annex.Common
+import Utility.DataUnits
+
+import Data.Char
+import Text.Read
+
+parseSimFile :: String -> Either String [SimCommand]
+parseSimFile = go [] . lines
+  where
+	go c [] = Right c
+	go c (l:ls) = case parseSimFileLine l of
+		Right cs -> go (c ++ cs) ls
+		Left err -> Left err
+
+parseSimFileLine :: String -> Either String [SimCommand]
+parseSimFileLine s
+	| "#" `isPrefixOf` s = Right [CommandComment s]
+	| all isSpace s = Right [CommandBlank]
+	| otherwise = case words s of
+		("init":name:[]) ->
+			Right [CommandInit (RepoName name)]
+		("initremote":name:[]) ->
+			Right [CommandInitRemote (RepoName name)]
+		("use":name:rest) ->
+			Right [CommandUse (RepoName name) (unwords rest)]
+		("connect":rest) ->
+			parseConnect CommandConnect rest
+		("disconnect":rest) ->
+			parseConnect CommandDisconnect rest
+		("addtree":name:rest) ->
+			Right [CommandAddTree(RepoName name) (unwords rest)]
+		("add":filename:size:repos) ->
+			case readSize dataUnits size of
+				Just sz -> Right [CommandAdd (toRawFilePath filename) sz (map RepoName repos)]
+				Nothing -> Left $ "Unable to parse file size \"" ++ size ++ "\""
+		("step":n:[]) ->
+			case readMaybe n of
+				Just n' -> Right [CommandStep n']
+				Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\""
+		("action":repo:"pull":remote:[]) ->
+			Right [CommandAction (RepoName repo) (ActionPull (RemoteName remote))]
+		("action":repo:"push":remote:[]) ->
+			Right [CommandAction (RepoName repo) (ActionPush (RemoteName remote))]
+		("action":repo:"getwanted":remote:[]) ->
+			Right [CommandAction (RepoName repo) (ActionGetWanted (RemoteName remote))]
+		("action":repo:"dropunwanted":[]) ->
+			Right [CommandAction (RepoName repo) (ActionDropUnwanted Nothing)]
+		("action":repo:"dropunwanted":remote:[]) ->
+			Right [CommandAction (RepoName repo) (ActionDropUnwanted (Just (RemoteName remote)))]
+		("action":repo:"gitpush":remote:[]) ->
+			Right [CommandAction (RepoName repo) (ActionGitPush (RemoteName remote))]
+		("action":repo:"gitpull":remote:[]) ->
+			Right [CommandAction (RepoName repo) (ActionGitPull (RemoteName remote))]
+		("seed":n:[]) ->
+			case readMaybe n of
+				Just n' -> Right [CommandSeed n']
+				Nothing -> Left $ "Unable to parse seed value \"" ++ n ++ "\""
+		("present":repo:file:[]) ->
+			Right [CommandPresent (RepoName repo) (toRawFilePath file)]
+		("notpresent":repo:file:[]) ->
+			Right [CommandNotPresent (RepoName repo) (toRawFilePath file)]
+		-- TODO rest
+		_ -> Left $ "Unable to parse sim file line: \"" ++ s ++ "\""
+
+parseConnect :: (RepoName -> RemoteName -> SimCommand) -> [String] -> Either String [SimCommand]
+parseConnect mk = go []
+  where
+	go c [] = Right c
+	go c (r1:"->":r2:rest) = 
+		go (mk (RepoName r1) (RemoteName r2):c)
+			(chain r2 rest)
+	go c (r1:"<-":r2:rest) = 
+		go (mk (RepoName r2) (RemoteName r1):c)
+			(chain r2 rest)
+	go c (r1:"<->":r2:rest) = 
+		go (mk (RepoName r2) (RemoteName r1)
+			: mk (RepoName r1) (RemoteName r2)
+			: c
+			)
+			(chain r2 rest)
+	go _ rest = Left $ "Bad connect syntax near \"" ++ unwords rest ++ "\""
+
+	chain v rest = if null rest then rest else v:rest
+
--- a/Command/Sim.hs
+++ b/Command/Sim.hs
@ -11,6 +11,7 @@ module Command.Sim where

 import Command
 import Annex.Sim
+import Annex.Sim.File
 import Utility.Tmp.Dir

 import System.Random
@ -32,7 +33,7 @@ seek _ = do
 			>>= runSimCommand (CommandUse (RepoName "bar") "here")
 			>>= runSimCommand (CommandConnect (RepoName "foo") (RemoteName "bar"))
 			>>= runSimCommand (CommandConnect (RepoName "bar") (RemoteName "foo"))
-			>>= runSimCommand (CommandAdd "bigfile" 1000000 (RepoName "foo"))
+			>>= runSimCommand (CommandAdd "bigfile" 1000000 [RepoName "foo"])
 			>>= runSimCommand (CommandAction (RepoName "bar") (ActionGitPull (RemoteName "foo")))
 			>>= runSimCommand (CommandAction (RepoName "bar") (ActionGetWanted (RemoteName "foo")))
 		st'' <- liftIO $ updateSimRepos st'
--- a/doc/git-annex-sim.mdwn
+++ b/doc/git-annex-sim.mdwn
@ -167,7 +167,7 @@ as passed to "git annex sim" while a simulation is running.

  Simulate the equivilant of [[git-annex-pull]](1).

-* `action repo pull remote`
+* `action repo push remote`
  
  Simulate the equivilant of [[git-annex-push]](1).

--- a/git-annex.cabal
+++ b/git-annex.cabal
@ -578,6 +578,7 @@ Executable git-annex
    Annex.RepoSize.LiveUpdate
    Annex.SafeDropProof
    Annex.Sim
+    Annex.Sim.File
    Annex.SpecialRemote
    Annex.SpecialRemote.Config
    Annex.Ssh