unify batch mode with non-batch by using AnnexedFileSeeker
This commit is contained in:
parent
d9ae6ab0b4
commit
1be92381ec
23 changed files with 70 additions and 74 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -36,7 +36,7 @@ seek ps = unlessM crippledFileSystem $
|
|||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' (start FixAll)
|
||||
{ startAction = start FixAll
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -30,7 +30,7 @@ seek = withFilesInGitAnnex ww seeker <=< workTreeItems ww
|
|||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' start
|
||||
{ startAction = start
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue