add SeekInput (not yet used)

No behavior changes (hopefully), just adding SeekInput and plumbing it
through to the JSON display code for later use.

Over the course of 2 grueling days.

withFilesNotInGit reimplemented in terms of seekHelper
should be the only possible behavior change. It seems to test as
behaving the same.

Note that seekHelper dummies up the SeekInput in the case where
segmentPaths' gives up on sorting the expanded paths because there are
too many input paths. When SeekInput later gets exposed as a json field,
that will result in it being a little bit wrong in the case where
100 or more paths are passed to a git-annex command. I think this is a
subtle enough problem to not matter. If it does turn out to be a
problem, fixing it would require splitting up the input
parameters into groups of < 100, which would make git ls-files run
perhaps more than is necessary. May want to revisit this, because that
fix seems fairly low-impact.
This commit is contained in:
Joey Hess 2020-09-14 16:49:33 -04:00
parent a1accac084
commit 3a05d53761
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
88 changed files with 561 additions and 405 deletions

View file

@ -308,7 +308,7 @@ syncRemotes' ps available =
fastest = fromMaybe [] . headMaybe . Remote.byCost
commit :: SyncOptions -> CommandStart
commit o = stopUnless shouldcommit $ starting "commit" (ActionItemOther Nothing) $ do
commit o = stopUnless shouldcommit $ starting "commit" ai si $ do
commitmessage <- maybe commitMsg return (messageOption o)
Annex.Branch.commit =<< Annex.Branch.commitMessage
next $ do
@ -324,6 +324,8 @@ commit o = stopUnless shouldcommit $ starting "commit" (ActionItemOther Nothing)
( pure (commitOption o)
<||> (pure (not (noCommitOption o)) <&&> getGitConfigVal annexAutoCommit)
)
ai = ActionItemOther Nothing
si = SeekInput []
commitMsg :: Annex String
commitMsg = do
@ -350,14 +352,18 @@ mergeLocal' :: [Git.Merge.MergeConfig] -> SyncOptions -> CurrBranch -> CommandSt
mergeLocal' mergeconfig o currbranch@(Just branch, _) =
needMerge currbranch branch >>= \case
Nothing -> stop
Just syncbranch ->
starting "merge" (ActionItemOther (Just $ Git.Ref.describe syncbranch)) $
Just syncbranch -> do
let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
let si = SeekInput []
starting "merge" ai si $
next $ merge currbranch mergeconfig o Git.Branch.ManualCommit syncbranch
mergeLocal' _ _ currbranch@(Nothing, _) = inRepo Git.Branch.currentUnsafe >>= \case
Just branch -> needMerge currbranch branch >>= \case
Nothing -> stop
Just syncbranch ->
starting "merge" (ActionItemOther (Just $ Git.Ref.describe syncbranch)) $ do
Just syncbranch -> do
let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
let si = SeekInput []
starting "merge" ai si $ do
warning $ "There are no commits yet to branch " ++ Git.fromRef branch ++ ", so cannot merge " ++ Git.fromRef syncbranch ++ " into it."
next $ return False
Nothing -> stop
@ -421,7 +427,7 @@ updateBranch syncbranch updateto g =
pullRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandStart
pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && wantpull) $
starting "pull" (ActionItemOther (Just (Remote.name remote))) $ do
starting "pull" ai si $ do
showOutput
ifM (onlyAnnex o)
( do
@ -443,6 +449,8 @@ pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && want
[Param "fetch", Param $ Remote.name remote]
++ map Param bs
wantpull = remoteAnnexPull (Remote.gitconfig remote)
ai = ActionItemOther (Just (Remote.name remote))
si = SeekInput []
importRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandSeek
importRemote o mergeconfig remote currbranch
@ -489,7 +497,7 @@ pushRemote o remote (Just branch, _) = do
onlyannex <- onlyAnnex o
let mainbranch = if onlyannex then Nothing else Just branch
stopUnless (pure (pushOption o) <&&> needpush mainbranch) $
starting "push" (ActionItemOther (Just (Remote.name remote))) $ next $ do
starting "push" ai si $ next $ do
repo <- Remote.getRepo remote
showOutput
ok <- inRepoWithSshOptionsTo repo gc $
@ -500,6 +508,8 @@ pushRemote o remote (Just branch, _) = do
warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
return ok
where
ai = ActionItemOther (Just (Remote.name remote))
si = SeekInput []
gc = Remote.gitconfig remote
needpush mainbranch
| remoteAnnexReadOnly gc = return False
@ -663,15 +673,15 @@ seekSyncContent o rs currbranch = do
seekHelper fst3 ww LsFiles.inRepoDetails l
seekincludinghidden origbranch mvar l bloomfeeder =
seekFiltered (\f -> ifAnnexed f (commandAction . gofile bloomfeeder mvar f) noop) $
seekFiltered (\(si, f) -> ifAnnexed f (commandAction . gofile bloomfeeder mvar si f) noop) $
seekHelper id ww (LsFiles.inRepoOrBranch origbranch) l
ww = WarnUnmatchLsFiles
gofile bloom mvar f k =
gofile bloom mvar _ f k =
go (Right bloom) mvar (AssociatedFile (Just f)) k
gokey mvar bloom (k, _) =
gokey mvar bloom (_, k, _) =
go (Left bloom) mvar (AssociatedFile Nothing) k
go ebloom mvar af k = do
@ -725,7 +735,7 @@ syncFile ebloom rs af k = do
-- includeCommandAction for drops,
-- because a failure to drop does not mean
-- the sync failed.
handleDropsFrom locs' rs "unwanted" True k af []
handleDropsFrom locs' rs "unwanted" True k af si []
callCommandAction
return (got || not (null putrs))
@ -739,7 +749,7 @@ syncFile ebloom rs af k = do
( return [ get have ]
, return []
)
get have = includeCommandAction $ starting "get" ai $
get have = includeCommandAction $ starting "get" ai si $
stopUnless (getKey' k af have) $
next $ return True
@ -755,9 +765,10 @@ syncFile ebloom rs af k = do
, return []
)
put dest = includeCommandAction $
Command.Move.toStart' dest Command.Move.RemoveNever af k ai
Command.Move.toStart' dest Command.Move.RemoveNever af k ai si
ai = mkActionItem (k, af)
si = SeekInput []
{- When a remote has an annex-tracking-branch configuration, change the export
- to contain the current content of the branch. Otherwise, transfer any files
@ -814,22 +825,21 @@ seekExportContent o rs (currbranch, _) = or <$> forM rs go
cleanupLocal :: CurrBranch -> CommandStart
cleanupLocal (Nothing, _) = stop
cleanupLocal (Just currb, _) =
starting "cleanup" (ActionItemOther (Just "local")) $
next $ do
delbranch $ syncBranch currb
delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
mapM_ (\(s,r) -> inRepo $ Git.Ref.delete s r)
=<< listTaggedBranches
return True
cleanupLocal (Just currb, _) = starting "cleanup" ai si $ next $ do
delbranch $ syncBranch currb
delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
mapM_ (\(s,r) -> inRepo $ Git.Ref.delete s r) =<< listTaggedBranches
return True
where
delbranch b = whenM (inRepo $ Git.Ref.exists $ Git.Ref.branchRef b) $
inRepo $ Git.Branch.delete b
ai = ActionItemOther (Just "local")
si = SeekInput []
cleanupRemote :: Remote -> CurrBranch -> CommandStart
cleanupRemote _ (Nothing, _) = stop
cleanupRemote remote (Just b, _) =
starting "cleanup" (ActionItemOther (Just (Remote.name remote))) $
starting "cleanup" ai si $
next $ inRepo $ Git.Command.runBool
[ Param "push"
, Param "--quiet"
@ -839,7 +849,10 @@ cleanupRemote remote (Just b, _) =
, Param $ Git.fromRef $ syncBranch $
Git.Ref.base $ Annex.Branch.name
]
where
ai = ActionItemOther (Just (Remote.name remote))
si = SeekInput []
shouldSyncContent :: SyncOptions -> Annex Bool
shouldSyncContent o
| noContentOption o = pure False