mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

sim file parser and generator

Browse source 
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.
This commit is contained in:
Joey Hess 2024-09-11 15:59:13 -04:00
parent 84bbbeae9d
commit f381b457f2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 172 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
Annex/Sim.hs
View file

@ -168,7 +168,7 @@ data SimCommand
| CommandNotPresent RepoName RawFilePath | CommandNotPresent RepoName RawFilePath
| CommandNumCopies Int | CommandNumCopies Int
| CommandMinCopies Int | CommandMinCopies Int
| CommandTrustLevel RepoName String | CommandTrustLevel RepoName TrustLevel
| CommandGroup RepoName Group | CommandGroup RepoName Group
| CommandUngroup RepoName Group | CommandUngroup RepoName Group
| CommandWanted RepoName PreferredContentExpression | CommandWanted RepoName PreferredContentExpression
@ -305,13 +305,12 @@ applySimCommand' (CommandNumCopies n) st = Right $ Right $ st
applySimCommand' (CommandMinCopies n) st = Right $ Right $ st applySimCommand' (CommandMinCopies n) st = Right $ Right $ st
{ simMinCopies = configuredMinCopies n { simMinCopies = configuredMinCopies n
} }
applySimCommand' (CommandTrustLevel repo s) st = checkKnownRepo repo st $ \u -> applySimCommand' (CommandTrustLevel repo trustlevel) st =
case readTrustLevel s of checkKnownRepo repo st $ \u ->
Just trustlevel -> Right $ Right $ st Right $ Right $ st
{ simTrustLevels = M.insert u trustlevel { simTrustLevels = M.insert u trustlevel
(simTrustLevels st) (simTrustLevels st)
} }
Nothing -> Left $ "Unknown trust level \"" ++ s ++ "\"."
applySimCommand' (CommandGroup repo groupname) st = checkKnownRepo repo st $ \u -> applySimCommand' (CommandGroup repo groupname) st = checkKnownRepo repo st $ \u ->
Right $ Right $ st Right $ Right $ st
{ simGroups = M.insertWith S.union u { simGroups = M.insertWith S.union u

214
Annex/Sim/File.hs
View file

@ -8,8 +8,11 @@
module Annex.Sim.File where module Annex.Sim.File where
import Annex.Sim import Annex.Sim
import Annex.Common import Annex.Common hiding (group)
import Utility.DataUnits import Utility.DataUnits
import Types.TrustLevel
import Types.Group
import Git.Config (isTrueFalse)
import Data.Char import Data.Char
import Text.Read import Text.Read
@ -26,56 +29,173 @@ parseSimFileLine :: String -> Either String [SimCommand]
parseSimFileLine s parseSimFileLine s
| "#" `isPrefixOf` s = Right [CommandComment s] | "#" `isPrefixOf` s = Right [CommandComment s]
| all isSpace s = Right [CommandBlank] | all isSpace s = Right [CommandBlank]
| otherwise = case words s of | otherwise = parseSimCommand (words s)
("init":name:[]) ->
Right [CommandInit (RepoName name)] generateSimFile :: [SimCommand] -> String
("initremote":name:[]) -> generateSimFile = unlines . map unwords . go
Right [CommandInitRemote (RepoName name)] where
("use":name:rest) -> go [] = []
Right [CommandUse (RepoName name) (unwords rest)] go (CommandInit (RepoName name) : rest) =
("connect":rest) -> ["init", name] : go rest
parseConnect CommandConnect rest go (CommandInitRemote (RepoName name) : rest) =
("disconnect":rest) -> ["initremote", name] : go rest
parseConnect CommandDisconnect rest go (CommandUse (RepoName name) what : rest) =
("addtree":name:rest) -> ["use", name, what] : go rest
Right [CommandAddTree(RepoName name) (unwords rest)] go (CommandConnect (RepoName name) (RemoteName remote) : rest) =
("add":filename:size:repos) -> handleconnect name remote rest
case readSize dataUnits size of go (CommandDisconnect (RepoName name) (RemoteName remote) : rest) =
Just sz -> Right [CommandAdd (toRawFilePath filename) sz (map RepoName repos)] ["disconnect", name, "->", remote] : go rest
Nothing -> Left $ "Unable to parse file size \"" ++ size ++ "\"" go (CommandAddTree (RepoName name) expr : rest) =
("step":n:[]) -> ["addtree", name, expr] : go rest
case readMaybe n of go (CommandAdd f sz repos : rest) =
Just n' -> Right [CommandStep n'] (["add", fromRawFilePath f, showsize sz] ++ map fromRepoName repos) : go rest
Nothing -> Left $ "Unable to parse step value \"" ++ n ++ "\"" go (CommandStep n : rest) =
("action":repo:"pull":remote:[]) -> ["step", show n] : go rest
Right [CommandAction (RepoName repo) (ActionPull (RemoteName remote))] go (CommandAction (RepoName repo) (ActionPull (RemoteName remote)) : rest) =
("action":repo:"push":remote:[]) -> ["action", repo, "pull", remote] : go rest
Right [CommandAction (RepoName repo) (ActionPush (RemoteName remote))] go (CommandAction (RepoName repo) (ActionPush (RemoteName remote)) : rest) =
("action":repo:"getwanted":remote:[]) -> ["action", repo, "push", remote] : go rest
Right [CommandAction (RepoName repo) (ActionGetWanted (RemoteName remote))] go (CommandAction (RepoName repo) (ActionGetWanted (RemoteName remote)) : rest) =
("action":repo:"dropunwanted":[]) -> ["action", repo, "getwanted", remote] : go rest
Right [CommandAction (RepoName repo) (ActionDropUnwanted Nothing)] go (CommandAction (RepoName repo) (ActionDropUnwanted (Just (RemoteName remote))) : rest) =
("action":repo:"dropunwanted":remote:[]) -> ["action", repo, "dropunwanted", remote] : go rest
Right [CommandAction (RepoName repo) (ActionDropUnwanted (Just (RemoteName remote)))] go (CommandAction (RepoName repo) (ActionDropUnwanted Nothing) : rest) =
("action":repo:"gitpush":remote:[]) -> ["action", repo, "dropunwanted"] : go rest
Right [CommandAction (RepoName repo) (ActionGitPush (RemoteName remote))] go (CommandAction (RepoName repo) (ActionSendWanted (RemoteName remote)) : rest) =
("action":repo:"gitpull":remote:[]) -> ["action", repo, "sendwanted", remote] : go rest
Right [CommandAction (RepoName repo) (ActionGitPull (RemoteName remote))] go (CommandAction (RepoName repo) (ActionGitPush (RemoteName remote)) : rest) =
("seed":n:[]) -> ["action", repo, "gitpush", remote] : go rest
case readMaybe n of go (CommandAction (RepoName repo) (ActionGitPull (RemoteName remote)) : rest) =
Just n' -> Right [CommandSeed n'] ["action", repo, "gitpull", remote] : go rest
Nothing -> Left $ "Unable to parse seed value \"" ++ n ++ "\"" go (CommandSeed n : rest) =
("present":repo:file:[]) -> ["seed", show n] : go rest
Right [CommandPresent (RepoName repo) (toRawFilePath file)] go (CommandPresent (RepoName repo) f : rest) =
("notpresent":repo:file:[]) -> ["present", repo, fromRawFilePath f] : go rest
Right [CommandNotPresent (RepoName repo) (toRawFilePath file)] go (CommandNotPresent (RepoName repo) f : rest) =
-- TODO rest ["notpresent", repo, fromRawFilePath f] : go rest
_ -> Left $ "Unable to parse sim file line: \"" ++ s ++ "\"" 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 :: (RepoName -> RemoteName -> SimCommand) -> [String] -> Either String [SimCommand]
parseConnect mk = go [] parseConnect mk = go []
where where
go c [] = Right c go c [] = Right (reverse c)
go c (r1:"->":r2:rest) = go c (r1:"->":r2:rest) =
go (mk (RepoName r1) (RemoteName r2):c) go (mk (RepoName r1) (RemoteName r2):c)
(chain r2 rest) (chain r2 rest)

1
Command/Sim.hs
View file

@ -29,7 +29,6 @@ seek _ = do
let getpath = GetSimRepoPath $ \u -> tmpdir </> fromUUID u let getpath = GetSimRepoPath $ \u -> tmpdir </> fromUUID u
let st = emptySimState rng repobyname getpath let st = emptySimState rng repobyname getpath
st' <- runSimCommand (CommandInit (RepoName "foo")) st st' <- runSimCommand (CommandInit (RepoName "foo")) st
>>= runSimCommand (CommandTrustLevel (RepoName "foo") "trusted")
>>= runSimCommand (CommandUse (RepoName "bar") "here") >>= runSimCommand (CommandUse (RepoName "bar") "here")
>>= runSimCommand (CommandConnect (RepoName "foo") (RemoteName "bar")) >>= runSimCommand (CommandConnect (RepoName "foo") (RemoteName "bar"))
>>= runSimCommand (CommandConnect (RepoName "bar") (RemoteName "foo")) >>= runSimCommand (CommandConnect (RepoName "bar") (RemoteName "foo"))

2
doc/git-annex-sim.mdwn
View file

@ -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 # remove foo's remote bar and see if a new file added to foo reaches bar
disconnect foo -> bar disconnect foo -> bar
add foo foo.mp3 2mb add foo.mp3 2mb foo
step 5 step 5
# SIM COMMANDS # SIM COMMANDS