implement ActionPull/Pull/Sync

Somewhat unsatisfying implementation, but all the alternatives were
worse.
This commit is contained in:
Joey Hess 2024-09-16 16:58:03 -04:00
parent c420ec9364
commit 92c10045d1
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -238,12 +238,37 @@ runSimCommand (CommandStep n) repobyname st
>>= runSimCommand (CommandStep (pred n)) repobyname >>= runSimCommand (CommandStep (pred n)) repobyname
(Nothing, st') -> return st' (Nothing, st') -> return st'
| otherwise = return st | otherwise = return st
runSimCommand (CommandAction reponame (ActionPull remote)) repobyname st =
runCompoundSimAction repobyname
[ CommandAction reponame (ActionGitPull remote)
, CommandAction reponame (ActionGetWanted remote)
, CommandAction reponame (ActionDropUnwanted Nothing)
] st
runSimCommand (CommandAction reponame (ActionPush remote)) repobyname st =
runCompoundSimAction repobyname
[ CommandAction reponame (ActionSendWanted remote)
, CommandAction reponame (ActionDropUnwanted (Just remote))
, CommandAction reponame (ActionGitPush remote)
] st
runSimCommand (CommandAction reponame (ActionSync remote)) repobyname st =
runCompoundSimAction repobyname
[ CommandAction reponame (ActionGitPull remote)
, CommandAction reponame (ActionGetWanted remote)
, CommandAction reponame (ActionSendWanted remote)
, CommandAction reponame (ActionDropUnwanted (Just remote))
, CommandAction reponame (ActionGitPush remote)
] st
runSimCommand cmd repobyname st = runSimCommand cmd repobyname st =
case applySimCommand cmd st repobyname of case applySimCommand cmd st repobyname of
Left err -> giveup err Left err -> giveup err
Right (Right st') -> return st' Right (Right st') -> return st'
Right (Left mkst) -> mkst Right (Left mkst) -> mkst
runCompoundSimAction :: GetExistingRepoByName -> [SimCommand] -> SimState SimRepo -> Annex (SimState SimRepo)
runCompoundSimAction repobyname (a:as) st =
runSimCommand a repobyname st >>= runCompoundSimAction repobyname as
runCompoundSimAction _ [] st = return st
applySimCommand applySimCommand
:: SimCommand :: SimCommand
-> SimState SimRepo -> SimState SimRepo
@ -412,9 +437,6 @@ applySimAction
-> SimAction -> SimAction
-> SimState SimRepo -> SimState SimRepo
-> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo)) -> Either String (Either (Annex (SimState SimRepo)) (SimState SimRepo))
applySimAction _r _u (ActionPull _remote) _st = undefined -- TODO
applySimAction _r _u (ActionPush _remote) _st = undefined -- TODO
applySimAction _r _u (ActionSync _remote) _st = undefined -- TODO
applySimAction r u (ActionGetWanted remote) st = applySimAction r u (ActionGetWanted remote) st =
overFilesRemote r u remote S.member wanted go st overFilesRemote r u remote S.member wanted go st
where where
@ -481,6 +503,10 @@ applySimAction r u (ActionGitPush remote) st =
applySimAction r u (ActionGitPull remote) st = applySimAction r u (ActionGitPull remote) st =
checkKnownRemote remote r u st $ \_ -> checkKnownRemote remote r u st $ \_ ->
simulateGitAnnexMerge (remoteNameToRepoName remote) r st simulateGitAnnexMerge (remoteNameToRepoName remote) r st
-- These are handled by runSimCommand
applySimAction _r _u (ActionPull _remote) _st = error "applySimAction ActionPull"
applySimAction _r _u (ActionPush _remote) _st = error "applySimAction ActionPush"
applySimAction _r _u (ActionSync _remote) _st = error "applySimAction ActionSync"
overFilesRemote overFilesRemote
:: RepoName :: RepoName