unify batch mode with non-batch by using AnnexedFileSeeker

This commit is contained in:
Joey Hess 2020-07-22 14:23:28 -04:00
parent d9ae6ab0b4
commit 1be92381ec
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
23 changed files with 70 additions and 74 deletions

View file

@ -80,7 +80,7 @@ seek o = startConcurrency commandStages $ do
Batch fmt
| updateOnly o ->
giveup "--update --batch is not supported"
| otherwise -> batchFilesMatching fmt (gofile . toRawFilePath)
| otherwise -> batchFilesMatching fmt gofile
NoBatch -> do
-- Avoid git ls-files complaining about files that
-- are not known to git yet, since this will add

View file

@ -45,22 +45,21 @@ instance DeferredParseClass CopyOptions where
seek :: CopyOptions -> CommandSeek
seek o = startConcurrency commandStages $ do
let go = start o
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' go
, checkContentPresent = Nothing
, usesLocationLog = False
}
case batchOption o of
Batch fmt -> batchFilesMatching fmt
(whenAnnexed go . toRawFilePath)
NoBatch -> withKeyOptions
(keyOptions o) (autoMode o)
(commandAction . Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (copyFiles o)
Batch fmt -> batchAnnexedFilesMatching fmt seeker
where
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ startAction = start o
, checkContentPresent = Nothing
, usesLocationLog = False
}
{- A copy is just a move that does not delete the source file.
- However, auto mode avoids unnecessary copies, and avoids getting or

View file

@ -54,18 +54,16 @@ parseDropFromOption = parseRemoteOption <$> strOption
seek :: DropOptions -> CommandSeek
seek o = startConcurrency commandStages $
case batchOption o of
Batch fmt -> batchFilesMatching fmt
(whenAnnexed go . toRawFilePath)
Batch fmt -> batchAnnexedFilesMatching fmt seeker
NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
(commandAction . startKeys o)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (dropFiles o)
where
go = start o
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ seekAction = commandAction' go
{ startAction = start o
, checkContentPresent = Nothing
, usesLocationLog = False
}

View file

@ -18,7 +18,6 @@ import Types.Key
import Git.FilePath
import qualified Utility.Format
import Utility.DataUnits
import Annex.Content
cmd :: Command
cmd = notBareRepo $ withGlobalOptions [annexedMatchingOptions] $ mkCommand $
@ -54,27 +53,24 @@ parseFormatOption =
)
seek :: FindOptions -> CommandSeek
seek o = case batchOption o of
NoBatch -> do
islimited <- limited
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' go
-- only files with content present are shown, unless
-- the user has requested others via a limit
, checkContentPresent = if islimited
then Nothing
else Just True
, usesLocationLog = False
}
withKeyOptions (keyOptions o) False
seek o = do
islimited <- limited
let seeker = AnnexedFileSeeker
{ startAction = start o
-- only files with content present are shown, unless
-- the user has requested others via a limit
, checkContentPresent = if islimited
then Nothing
else Just True
, usesLocationLog = False
}
case batchOption o of
NoBatch -> withKeyOptions (keyOptions o) False
(commandAction . startKeys o)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (findThese o)
Batch fmt -> batchFilesMatching fmt
(whenAnnexed gobatch . toRawFilePath)
Batch fmt -> batchAnnexedFilesMatching fmt seeker
where
go = start o
gobatch f k = stopUnless (limited <||> inAnnex k) (go f k)
ww = WarnUnmatchLsFiles
start :: FindOptions -> RawFilePath -> Key -> CommandStart

View file

@ -36,7 +36,7 @@ seek ps = unlessM crippledFileSystem $
where
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ seekAction = commandAction' (start FixAll)
{ startAction = start FixAll
, checkContentPresent = Nothing
, usesLocationLog = False
}

View file

@ -93,7 +93,7 @@ seek o = startConcurrency commandStages $ do
checkDeadRepo u
i <- prepIncremental u (incrementalOpt o)
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' (start from i)
{ startAction = start from i
, checkContentPresent = Nothing
, usesLocationLog = True
}

View file

@ -40,19 +40,17 @@ optParser desc = GetOptions
seek :: GetOptions -> CommandSeek
seek o = startConcurrency downloadStages $ do
from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
let go = start o from
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' go
{ startAction = start o from
, checkContentPresent = Just False
, usesLocationLog = True
}
case batchOption o of
Batch fmt -> batchFilesMatching fmt
(whenAnnexed go . toRawFilePath)
NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
(commandAction . startKeys from)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (getFiles o)
Batch fmt -> batchAnnexedFilesMatching fmt seeker
where
ww = WarnUnmatchLsFiles

View file

@ -39,7 +39,7 @@ seek o = do
_ -> do
let s = S.fromList ts
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' (start s)
{ startAction = start s
, checkContentPresent = Nothing
, usesLocationLog = False
}

View file

@ -45,7 +45,7 @@ seek o = do
list <- getList o
printHeader list
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' (start list)
{ startAction = start list
, checkContentPresent = Nothing
, usesLocationLog = True
}

View file

@ -32,7 +32,7 @@ seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
where
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ seekAction = commandAction' start
{ startAction = start
, checkContentPresent = Nothing
, usesLocationLog = False
}

View file

@ -86,7 +86,7 @@ seek o = do
zone <- liftIO getCurrentTimeZone
let outputter = mkOutputter m zone o
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' (start o outputter)
{ startAction = start o outputter
, checkContentPresent = Nothing
-- the way this uses the location log would not be helped
-- by precaching the current value

View file

@ -77,7 +77,7 @@ seek o = case batchOption o of
c <- liftIO currentVectorClock
let ww = WarnUnmatchLsFiles
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' (start c o)
{ startAction = start c o
, checkContentPresent = Nothing
, usesLocationLog = False
}

View file

@ -30,7 +30,7 @@ seek = withFilesInGitAnnex ww seeker <=< workTreeItems ww
where
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ seekAction = commandAction' start
{ startAction = start
, checkContentPresent = Nothing
, usesLocationLog = False
}

View file

@ -52,7 +52,7 @@ seek o = startConcurrency stages $
ToRemote _ -> commandStages
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ seekAction = commandAction' (start o)
{ startAction = start o
, checkContentPresent = Nothing
, usesLocationLog = False
}

View file

@ -55,19 +55,17 @@ data RemoveWhen = RemoveSafe | RemoveNever
seek :: MoveOptions -> CommandSeek
seek o = startConcurrency stages $ do
let go = start (fromToOptions o) (removeWhen o)
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' go
{ startAction = start (fromToOptions o) (removeWhen o)
, checkContentPresent = Nothing
, usesLocationLog = False
}
case batchOption o of
Batch fmt -> batchFilesMatching fmt
(whenAnnexed go . toRawFilePath)
NoBatch -> withKeyOptions (keyOptions o) False
(commandAction . startKey (fromToOptions o) (removeWhen o))
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (moveFiles o)
Batch fmt -> batchAnnexedFilesMatching fmt seeker
where
stages = case fromToOptions o of
Right (FromRemote _) -> downloadStages

View file

@ -646,7 +646,7 @@ seekSyncContent o rs currbranch = do
seekworktree mvar l (const noop)
pure Nothing
withKeyOptions' (keyOptions o) False
(return (gokey mvar bloom))
(return (commandAction . gokey mvar bloom))
(const noop)
[]
waitForAllRunningCommandActions
@ -654,7 +654,7 @@ seekSyncContent o rs currbranch = do
where
seekworktree mvar l bloomfeeder = do
let seeker = AnnexedFileSeeker
{ seekAction = gofile bloomfeeder mvar
{ startAction = gofile bloomfeeder mvar
, checkContentPresent = Nothing
, usesLocationLog = True
}
@ -662,7 +662,7 @@ seekSyncContent o rs currbranch = do
seekHelper fst3 ww LsFiles.inRepoDetails l
seekincludinghidden origbranch mvar l bloomfeeder =
seekFiltered (\f -> ifAnnexed f (gofile bloomfeeder mvar f) noop) $
seekFiltered (\f -> ifAnnexed f (commandAction . gofile bloomfeeder mvar f) noop) $
seekHelper id ww (LsFiles.inRepoOrBranch origbranch) l
ww = WarnUnmatchLsFiles
@ -677,7 +677,7 @@ seekSyncContent o rs currbranch = do
-- Run syncFile as a command action so file transfers run
-- concurrently.
let ai = OnlyActionOn k (ActionItemKey k)
commandAction $ startingNoMessage ai $ do
startingNoMessage ai $ do
whenM (syncFile ebloom rs af k) $
void $ liftIO $ tryPutMVar mvar ()
next $ return True

View file

@ -28,7 +28,7 @@ seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
seeker :: AnnexedFileSeeker
seeker = AnnexedFileSeeker
{ seekAction = commandAction' start
{ startAction = start
, checkContentPresent = Just True
, usesLocationLog = False
}

View file

@ -31,7 +31,7 @@ seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
where
ww = WarnUnmatchLsFiles
seeker = AnnexedFileSeeker
{ seekAction = commandAction' start
{ startAction = start
, checkContentPresent = Nothing
, usesLocationLog = False
}

View file

@ -51,20 +51,18 @@ parseFormatOption = option (Utility.Format.gen <$> str)
seek :: WhereisOptions -> CommandSeek
seek o = do
m <- remoteMap id
let go = start o m
let seeker = AnnexedFileSeeker
{ startAction = start o m
, checkContentPresent = Nothing
, usesLocationLog = True
}
case batchOption o of
Batch fmt -> batchFilesMatching fmt
(whenAnnexed go . toRawFilePath)
NoBatch -> do
let seeker = AnnexedFileSeeker
{ seekAction = commandAction' go
, checkContentPresent = Nothing
, usesLocationLog = True
}
withKeyOptions (keyOptions o) False
(commandAction . startKeys o m)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (whereisFiles o)
Batch fmt -> batchAnnexedFilesMatching fmt seeker
where
ww = WarnUnmatchLsFiles