From f381b457f2534a1c1e21441604cd31fe473c1410 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 11 Sep 2024 15:59:13 -0400 Subject: [PATCH] sim file parser and generator The generator doesn't emit the best possible connect commands, but it does output something valid. Eg, an input like: connect A <-> B <-> C <-> D becomes: connect A <-> B <-> C connect C <-> D Also: connect A -> B <- C becomes: connect A -> B connect C -> B Which could be improved. Also disconnect commands are not prettified at all, but probably there's no reason to. --- Annex/Sim.hs | 9 +- Annex/Sim/File.hs | 214 ++++++++++++++++++++++++++++++++--------- Command/Sim.hs | 1 - doc/git-annex-sim.mdwn | 2 +- 4 files changed, 172 insertions(+), 54 deletions(-) diff --git a/Annex/Sim.hs b/Annex/Sim.hs index 14b984da5b..05596b6363 100644 --- a/Annex/Sim.hs +++ b/Annex/Sim.hs @@ -168,7 +168,7 @@ data SimCommand | CommandNotPresent RepoName RawFilePath | CommandNumCopies Int | CommandMinCopies Int - | CommandTrustLevel RepoName String + | CommandTrustLevel RepoName TrustLevel | CommandGroup RepoName Group | CommandUngroup RepoName Group | CommandWanted RepoName PreferredContentExpression @@ -305,13 +305,12 @@ applySimCommand' (CommandNumCopies n) st = Right $ Right $ st applySimCommand' (CommandMinCopies n) st = Right $ Right $ st { simMinCopies = configuredMinCopies n } -applySimCommand' (CommandTrustLevel repo s) st = checkKnownRepo repo st $ \u -> - case readTrustLevel s of - Just trustlevel -> Right $ Right $ st +applySimCommand' (CommandTrustLevel repo trustlevel) st = + checkKnownRepo repo st $ \u -> + Right $ Right $ st { simTrustLevels = M.insert u trustlevel (simTrustLevels st) } - Nothing -> Left $ "Unknown trust level \"" ++ s ++ "\"." applySimCommand' (CommandGroup repo groupname) st = checkKnownRepo repo st $ \u -> Right $ Right $ st { simGroups = M.insertWith S.union u diff --git a/Annex/Sim/File.hs b/Annex/Sim/File.hs index 76f78067fc..068a346a96 100644 --- a/Annex/Sim/File.hs +++ b/Annex/Sim/File.hs @@ -8,8 +8,11 @@ module Annex.Sim.File where import Annex.Sim -import Annex.Common +import Annex.Common hiding (group) import Utility.DataUnits +import Types.TrustLevel +import Types.Group +import Git.Config (isTrueFalse) import Data.Char import Text.Read @@ -26,56 +29,173 @@ 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 ++ "\"" + | otherwise = parseSimCommand (words s) + +generateSimFile :: [SimCommand] -> String +generateSimFile = unlines . map unwords . go + where + go [] = [] + go (CommandInit (RepoName name) : rest) = + ["init", name] : go rest + go (CommandInitRemote (RepoName name) : rest) = + ["initremote", name] : go rest + go (CommandUse (RepoName name) what : rest) = + ["use", name, what] : go rest + go (CommandConnect (RepoName name) (RemoteName remote) : rest) = + handleconnect name remote rest + go (CommandDisconnect (RepoName name) (RemoteName remote) : rest) = + ["disconnect", name, "->", remote] : go rest + go (CommandAddTree (RepoName name) expr : rest) = + ["addtree", name, expr] : go rest + go (CommandAdd f sz repos : rest) = + (["add", fromRawFilePath f, showsize sz] ++ map fromRepoName repos) : go rest + go (CommandStep n : rest) = + ["step", show n] : go rest + go (CommandAction (RepoName repo) (ActionPull (RemoteName remote)) : rest) = + ["action", repo, "pull", remote] : go rest + go (CommandAction (RepoName repo) (ActionPush (RemoteName remote)) : rest) = + ["action", repo, "push", remote] : go rest + go (CommandAction (RepoName repo) (ActionGetWanted (RemoteName remote)) : rest) = + ["action", repo, "getwanted", remote] : go rest + go (CommandAction (RepoName repo) (ActionDropUnwanted (Just (RemoteName remote))) : rest) = + ["action", repo, "dropunwanted", remote] : go rest + go (CommandAction (RepoName repo) (ActionDropUnwanted Nothing) : rest) = + ["action", repo, "dropunwanted"] : go rest + go (CommandAction (RepoName repo) (ActionSendWanted (RemoteName remote)) : rest) = + ["action", repo, "sendwanted", remote] : go rest + go (CommandAction (RepoName repo) (ActionGitPush (RemoteName remote)) : rest) = + ["action", repo, "gitpush", remote] : go rest + go (CommandAction (RepoName repo) (ActionGitPull (RemoteName remote)) : rest) = + ["action", repo, "gitpull", remote] : go rest + go (CommandSeed n : rest) = + ["seed", show n] : go rest + go (CommandPresent (RepoName repo) f : rest) = + ["present", repo, fromRawFilePath f] : go rest + go (CommandNotPresent (RepoName repo) f : rest) = + ["notpresent", repo, fromRawFilePath f] : go rest + go (CommandNumCopies n : rest) = + ["numcopies", show n] : go rest + go (CommandMinCopies n : rest) = + ["mincopies", show n] : go rest + go (CommandTrustLevel (RepoName repo) trustlevel : rest) = + ["trustlevel", repo, showTrustLevel trustlevel] : go rest + go (CommandGroup (RepoName repo) group : rest) = + ["group", repo, fromGroup group] : go rest + go (CommandUngroup (RepoName repo) group : rest) = + ["ungroup", repo, fromGroup group] : go rest + go (CommandWanted (RepoName repo) expr : rest) = + ["wanted", repo, expr] : go rest + go (CommandRequired (RepoName repo) expr : rest) = + ["required", repo, expr] : go rest + go (CommandGroupWanted group expr : rest) = + ["groupwanted", fromGroup group, expr] : go rest + go (CommandMaxSize (RepoName repo) maxsize : rest) = + ["maxsize", repo, showsize (fromMaxSize maxsize)] : go rest + go (CommandRebalance b : rest) = + ["rebalance", if b then "on" else "off"] : go rest + go (CommandComment s : rest) = + [s] : go rest + go (CommandBlank : rest) = + [""] : go rest + + handleconnect name remote (CommandConnect (RepoName name2) (RemoteName remote2) : rest) + | name == remote2 && name2 == remote = + let (chain, rest') = chainconnect remote rest + in (["connect", name, "<->", remote] ++ chain) : go rest' + handleconnect name remote rest = + ["connect", name, "->", remote] : go rest + + chainconnect name (CommandConnect (RepoName name2) (RemoteName remote2) : rest) + | name == name2 = case rest of + (CommandConnect (RepoName name3) (RemoteName remote3) : rest') + | remote2 == name3 -> + let (chain, rest'') = chainconnect remote3 rest' + in (["<->", remote2] ++ chain, rest'') + _ -> + let (chain, rest') = chainconnect remote2 rest + in (["->", remote2] ++ chain, rest') + chainconnect _ rest = ([], rest) + + showsize = filter (not . isSpace) . preciseSize storageUnits True + +parseSimCommand :: [String] -> Either String [SimCommand] +parseSimCommand ("init":name:[]) = + Right [CommandInit (RepoName name)] +parseSimCommand ("initremote":name:[]) = + Right [CommandInitRemote (RepoName name)] +parseSimCommand ("use":name:rest) = + Right [CommandUse (RepoName name) (unwords rest)] +parseSimCommand ("connect":rest) = + parseConnect CommandConnect rest +parseSimCommand ("disconnect":rest) = + parseConnect CommandDisconnect rest +parseSimCommand ("addtree":name:rest) = + Right [CommandAddTree(RepoName name) (unwords rest)] +parseSimCommand ("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 ++ "\"" +parseSimCommand ("step":n:[]) = + case readMaybe n of + Just n' -> Right [CommandStep n'] + Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\"" +parseSimCommand ("action":repo:"pull":remote:[]) = + Right [CommandAction (RepoName repo) (ActionPull (RemoteName remote))] +parseSimCommand ("action":repo:"push":remote:[]) = + Right [CommandAction (RepoName repo) (ActionPush (RemoteName remote))] +parseSimCommand ("action":repo:"getwanted":remote:[]) = + Right [CommandAction (RepoName repo) (ActionGetWanted (RemoteName remote))] +parseSimCommand ("action":repo:"dropunwanted":[]) = + Right [CommandAction (RepoName repo) (ActionDropUnwanted Nothing)] +parseSimCommand ("action":repo:"dropunwanted":remote:[]) = + Right [CommandAction (RepoName repo) (ActionDropUnwanted (Just (RemoteName remote)))] +parseSimCommand ("action":repo:"gitpush":remote:[]) = + Right [CommandAction (RepoName repo) (ActionGitPush (RemoteName remote))] +parseSimCommand ("action":repo:"gitpull":remote:[]) = + Right [CommandAction (RepoName repo) (ActionGitPull (RemoteName remote))] +parseSimCommand ("seed":n:[]) = + case readMaybe n of + Just n' -> Right [CommandSeed n'] + Nothing -> Left $ "Unable to parse seed value \"" ++ n ++ "\"" +parseSimCommand ("present":repo:file:[]) = + Right [CommandPresent (RepoName repo) (toRawFilePath file)] +parseSimCommand ("notpresent":repo:file:[]) = + Right [CommandNotPresent (RepoName repo) (toRawFilePath file)] +parseSimCommand ("numcopies":n:[]) = + case readMaybe n of + Just n' -> Right [CommandNumCopies n'] + Nothing -> Left $ "Unable to parse numcopies value \"" ++ n ++ "\"" +parseSimCommand ("mincopies":n:[]) = + case readMaybe n of + Just n' -> Right [CommandMinCopies n'] + Nothing -> Left $ "Unable to parse mincopies value \"" ++ n ++ "\"" +parseSimCommand ("trustlevel":repo:s:[]) = + case readTrustLevel s of + Just trustlevel -> Right [CommandTrustLevel (RepoName repo) trustlevel] + Nothing -> Left $ "Unknown trust level \"" ++ s ++ "\"." +parseSimCommand ("group":repo:group:[]) = + Right [CommandGroup (RepoName repo) (toGroup group)] +parseSimCommand ("ungroup":repo:group:[]) = + Right [CommandUngroup (RepoName repo) (toGroup group)] +parseSimCommand ("wanted":repo:expr) = + Right [CommandWanted (RepoName repo) (unwords expr)] +parseSimCommand ("required":repo:expr) = + Right [CommandRequired (RepoName repo) (unwords expr)] +parseSimCommand ("groupwanted":group:expr) = + Right [CommandGroupWanted (toGroup group) (unwords expr)] +parseSimCommand ("maxsize":repo:size:[]) = + case readSize dataUnits size of + Just sz -> Right [CommandMaxSize (RepoName repo) (MaxSize sz)] + Nothing -> Left $ "Unable to parse maxsize \"" ++ size ++ "\"" +parseSimCommand ("rebalance":onoff:[]) = case isTrueFalse onoff of + Just b -> Right [CommandRebalance b] + Nothing -> Left $ "Unable to parse rebalance value \"" ++ onoff ++ "\"" +parseSimCommand ws = Left $ "Unable to parse sim command: \"" ++ unwords ws ++ "\"" parseConnect :: (RepoName -> RemoteName -> SimCommand) -> [String] -> Either String [SimCommand] parseConnect mk = go [] where - go c [] = Right c + go c [] = Right (reverse c) go c (r1:"->":r2:rest) = go (mk (RepoName r1) (RemoteName r2):c) (chain r2 rest) diff --git a/Command/Sim.hs b/Command/Sim.hs index 9b47e03e85..3b629bc64d 100644 --- a/Command/Sim.hs +++ b/Command/Sim.hs @@ -29,7 +29,6 @@ seek _ = do let getpath = GetSimRepoPath $ \u -> tmpdir fromUUID u let st = emptySimState rng repobyname getpath st' <- runSimCommand (CommandInit (RepoName "foo")) st - >>= runSimCommand (CommandTrustLevel (RepoName "foo") "trusted") >>= runSimCommand (CommandUse (RepoName "bar") "here") >>= runSimCommand (CommandConnect (RepoName "foo") (RemoteName "bar")) >>= runSimCommand (CommandConnect (RepoName "bar") (RemoteName "foo")) diff --git a/doc/git-annex-sim.mdwn b/doc/git-annex-sim.mdwn index b88b8b8686..59237a8ad0 100644 --- a/doc/git-annex-sim.mdwn +++ b/doc/git-annex-sim.mdwn @@ -79,7 +79,7 @@ Here is an example sim file: # remove foo's remote bar and see if a new file added to foo reaches bar disconnect foo -> bar - add foo foo.mp3 2mb + add foo.mp3 2mb foo step 5 # SIM COMMANDS