From: Joey Hess Date: Wed, 11 Sep 2024 15:53:25 +0000 (-0400) Subject: started on sim file parser X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~21^2~25^2~57 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=84bbbeae9d9a05a13a60c15314f0cfffb47a5d2a;p=git-annex.git started on sim file parser --- diff --git a/Annex/Sim.hs b/Annex/Sim.hs index 2dbe3a4cc3..14b984da5b 100644 --- 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 index 0000000000..76f78067fc --- /dev/null +++ b/Annex/Sim/File.hs @@ -0,0 +1,94 @@ +{- sim files + - + - Copyright 2024 Joey Hess + - + - 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 437a870d86..9b47e03e85 100644 --- 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 98fe33103a..b88b8b8686 100644 --- 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 f0d3fd5703..caab941e6d 100644 --- 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