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.
This commit is contained in:
Joey Hess
parent
84bbbeae9d
commit
f381b457f2
4 changed files with 172 additions and 54 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue