started on sim file parser

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index 2dbe3a4cc39fcabc1921cb70ac0e9f8a543d65c6..14b984da5b236b84d33051c630768281ad8ae489 100644 (file)
--- 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

diff --git a/Annex/Sim/File.hs b/Annex/Sim/File.hs
new file mode 100644 (file)
index 0000000..76f7806
--- /dev/null
+++ 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
+

diff --git a/Command/Sim.hs b/Command/Sim.hs
index 437a870d86e09690762842203ec6b429463d7bae..9b47e03e8588cbdd8474f824fc1097e8a85b9bfa 100644 (file)
--- 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'

diff --git a/doc/git-annex-sim.mdwn b/doc/git-annex-sim.mdwn
index 98fe33103acb9f941132039517a72bdfcc6da364..b88b8b8686ea51b3603f2b13910dc49c80bb41bd 100644 (file)
--- 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).
 

diff --git a/git-annex.cabal b/git-annex.cabal
index f0d3fd5703c81472ca597354e07fb1537029dc01..caab941e6dd3bc24d86e638cb2c8fc0b850d134b 100644 (file)
--- 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