mostly done with location log precaching
Some nice wins.
This commit is contained in:
parent
df58609804
commit
75aab72d23
22 changed files with 217 additions and 68 deletions
|
@ -46,13 +46,18 @@ 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 (commandAction' go))
|
||||
(withFilesInGitAnnex ww seeker)
|
||||
=<< workTreeItems ww (copyFiles o)
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
|
|
@ -58,12 +58,18 @@ seek o = startConcurrency commandStages $
|
|||
(whenAnnexed go . toRawFilePath)
|
||||
NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
|
||||
(commandAction . startKeys o)
|
||||
(withFilesInGitAnnex ww (commandAction' go))
|
||||
(withFilesInGitAnnex ww seeker)
|
||||
=<< workTreeItems ww (dropFiles o)
|
||||
where
|
||||
go = start o
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' go
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
||||
start :: DropOptions -> RawFilePath -> Key -> CommandStart
|
||||
start o file key = start' o key afile ai
|
||||
where
|
||||
|
|
|
@ -13,7 +13,6 @@ import qualified Data.ByteString as S
|
|||
import qualified Data.ByteString.Char8 as S8
|
||||
|
||||
import Command
|
||||
import Annex.Content
|
||||
import Limit
|
||||
import Types.Key
|
||||
import Git.FilePath
|
||||
|
@ -55,24 +54,31 @@ parseFormatOption =
|
|||
|
||||
seek :: FindOptions -> CommandSeek
|
||||
seek o = case batchOption o of
|
||||
NoBatch -> withKeyOptions (keyOptions o) False
|
||||
(commandAction . startKeys o)
|
||||
(withFilesInGitAnnex ww (commandAction' go))
|
||||
=<< workTreeItems ww (findThese o)
|
||||
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
|
||||
(commandAction . startKeys o)
|
||||
(withFilesInGitAnnex ww seeker)
|
||||
=<< workTreeItems ww (findThese o)
|
||||
Batch fmt -> batchFilesMatching fmt
|
||||
(whenAnnexed go . toRawFilePath)
|
||||
where
|
||||
go = start o
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
||||
-- only files inAnnex are shown, unless the user has requested
|
||||
-- others via a limit
|
||||
start :: FindOptions -> RawFilePath -> Key -> CommandStart
|
||||
start o file key =
|
||||
stopUnless (limited <||> inAnnex key) $
|
||||
startingCustomOutput key $ do
|
||||
showFormatted (formatOption o) file $ ("file", fromRawFilePath file) : keyVars key
|
||||
next $ return True
|
||||
start o file key = startingCustomOutput key $ do
|
||||
showFormatted (formatOption o) file $ ("file", fromRawFilePath file) : keyVars key
|
||||
next $ return True
|
||||
|
||||
startKeys :: FindOptions -> (Key, ActionItem) -> CommandStart
|
||||
startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) =
|
||||
|
|
|
@ -32,10 +32,14 @@ cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $
|
|||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek ps = unlessM crippledFileSystem $
|
||||
withFilesInGitAnnex ww (commandAction' (start FixAll))
|
||||
=<< workTreeItems ww ps
|
||||
withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' (start FixAll)
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
||||
data FixWhat = FixSymlinks | FixAll
|
||||
|
||||
|
|
|
@ -92,9 +92,14 @@ seek o = startConcurrency commandStages $ do
|
|||
u <- maybe getUUID (pure . Remote.uuid) from
|
||||
checkDeadRepo u
|
||||
i <- prepIncremental u (incrementalOpt o)
|
||||
let seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' (start from i)
|
||||
, checkContentPresent = Just True
|
||||
, usesLocationLog = True
|
||||
}
|
||||
withKeyOptions (keyOptions o) False
|
||||
(\kai -> commandAction . startKey from i kai =<< getNumCopies)
|
||||
(withFilesInGit ww $ commandAction . (whenAnnexed (start from i)))
|
||||
(withFilesInGitAnnex ww seeker)
|
||||
=<< workTreeItems ww (fsckFiles o)
|
||||
cleanupIncremental i
|
||||
void $ tryIO $ recordActivity Fsck u
|
||||
|
|
|
@ -41,12 +41,17 @@ 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
|
||||
, 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 (commandAction' go))
|
||||
(withFilesInGitAnnex ww seeker)
|
||||
=<< workTreeItems ww (getFiles o)
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
|
|
@ -38,8 +38,12 @@ seek o = do
|
|||
| otherwise -> commandAction stop
|
||||
_ -> do
|
||||
let s = S.fromList ts
|
||||
withFilesInGitAnnex ww
|
||||
(commandAction' (start s))
|
||||
let seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' (start s)
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
withFilesInGitAnnex ww seeker
|
||||
=<< workTreeItems ww (inprogressFiles o)
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
|
|
@ -44,8 +44,12 @@ seek :: ListOptions -> CommandSeek
|
|||
seek o = do
|
||||
list <- getList o
|
||||
printHeader list
|
||||
withFilesInGitAnnex ww (commandAction' (start list))
|
||||
=<< workTreeItems ww (listThese o)
|
||||
let seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' (start list)
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = True
|
||||
}
|
||||
withFilesInGitAnnex ww seeker =<< workTreeItems ww (listThese o)
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
||||
|
|
|
@ -28,11 +28,14 @@ cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $
|
|||
paramPaths (withParams seek)
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek ps = do
|
||||
l <- workTreeItems ww ps
|
||||
withFilesInGitAnnex ww (commandAction' start) l
|
||||
seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' start
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
||||
start :: RawFilePath -> Key -> CommandStart
|
||||
start file key = ifM (isJust <$> isAnnexLink file)
|
||||
|
|
|
@ -85,9 +85,15 @@ seek o = do
|
|||
m <- Remote.uuidDescriptions
|
||||
zone <- liftIO getCurrentTimeZone
|
||||
let outputter = mkOutputter m zone o
|
||||
let seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' (start o outputter)
|
||||
, checkContentPresent = Nothing
|
||||
-- the way this uses the location log would not be helped
|
||||
-- by precaching the current value
|
||||
, usesLocationLog = False
|
||||
}
|
||||
case (logFiles o, allOption o) of
|
||||
(fs, False) -> withFilesInGitAnnex ww
|
||||
(commandAction' (start o outputter))
|
||||
(fs, False) -> withFilesInGitAnnex ww seeker
|
||||
=<< workTreeItems ww fs
|
||||
([], True) -> commandAction (startAll o outputter)
|
||||
(_, True) -> giveup "Cannot specify both files and --all"
|
||||
|
|
|
@ -76,14 +76,19 @@ seek o = case batchOption o of
|
|||
NoBatch -> do
|
||||
c <- liftIO currentVectorClock
|
||||
let ww = WarnUnmatchLsFiles
|
||||
let seeker = case getSet o of
|
||||
let seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' (start c o)
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
let seekaction = case getSet o of
|
||||
Get _ -> withFilesInGitAnnex ww
|
||||
GetAll -> withFilesInGitAnnex ww
|
||||
Set _ -> withFilesInGitAnnexNonRecursive ww
|
||||
"Not recursively setting metadata. Use --force to do that."
|
||||
withKeyOptions (keyOptions o) False
|
||||
(commandAction . startKeys c o)
|
||||
(seeker (commandAction' (start c o)))
|
||||
(seekaction seeker)
|
||||
=<< workTreeItems ww (forFiles o)
|
||||
Batch fmt -> withMessageState $ \s -> case outputType s of
|
||||
JSONOutput _ -> ifM limited
|
||||
|
|
|
@ -26,10 +26,14 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
|
|||
paramPaths (withParams seek)
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek = withFilesInGitAnnex ww (commandAction' start)
|
||||
<=< workTreeItems ww
|
||||
seek = withFilesInGitAnnex ww seeker <=< workTreeItems ww
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' start
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
||||
start :: RawFilePath -> Key -> CommandStart
|
||||
start file key = do
|
||||
|
|
|
@ -44,13 +44,18 @@ seek :: MirrorOptions -> CommandSeek
|
|||
seek o = startConcurrency stages $
|
||||
withKeyOptions (keyOptions o) False
|
||||
(commandAction . startKey o (AssociatedFile Nothing))
|
||||
(withFilesInGitAnnex ww (commandAction' (start o)))
|
||||
(withFilesInGitAnnex ww seeker)
|
||||
=<< workTreeItems ww (mirrorFiles o)
|
||||
where
|
||||
stages = case fromToOptions o of
|
||||
FromRemote _ -> downloadStages
|
||||
ToRemote _ -> commandStages
|
||||
ww = WarnUnmatchLsFiles
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' (start o)
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
||||
start :: MirrorOptions -> RawFilePath -> Key -> CommandStart
|
||||
start o file k = startKey o afile (k, ai)
|
||||
|
|
|
@ -56,12 +56,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
|
||||
, 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 (commandAction' go))
|
||||
(withFilesInGitAnnex ww seeker)
|
||||
=<< workTreeItems ww (moveFiles o)
|
||||
where
|
||||
stages = case fromToOptions o of
|
||||
|
|
|
@ -652,8 +652,13 @@ seekSyncContent o rs currbranch = do
|
|||
waitForAllRunningCommandActions
|
||||
liftIO $ not <$> isEmptyMVar mvar
|
||||
where
|
||||
seekworktree mvar l bloomfeeder =
|
||||
seekFilteredKeys (gofile bloomfeeder mvar) $
|
||||
seekworktree mvar l bloomfeeder = do
|
||||
let seeker = AnnexedFileSeeker
|
||||
{ seekAction = gofile bloomfeeder mvar
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = True
|
||||
}
|
||||
seekFilteredKeys seeker $
|
||||
seekHelper fst3 ww LsFiles.inRepoDetails l
|
||||
|
||||
seekincludinghidden origbranch mvar l bloomfeeder =
|
||||
|
|
|
@ -23,13 +23,19 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
|
|||
paramPaths (withParams seek)
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek ps = (withFilesInGitAnnex ww (commandAction' start))
|
||||
=<< workTreeItems ww ps
|
||||
seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
||||
seeker :: AnnexedFileSeeker
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' start
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
||||
start :: RawFilePath -> Key -> CommandStart
|
||||
start file key = stopUnless (inAnnex key) $
|
||||
start file key =
|
||||
starting "unannex" (mkActionItem (key, file)) $
|
||||
perform file key
|
||||
|
||||
|
|
|
@ -44,7 +44,7 @@ seek ps = do
|
|||
l <- workTreeItems ww ps
|
||||
withFilesNotInGit (commandAction . whenAnnexed (startCheckIncomplete . fromRawFilePath)) l
|
||||
Annex.changeState $ \s -> s { Annex.fast = True }
|
||||
withFilesInGitAnnex ww (commandAction' Command.Unannex.start) l
|
||||
withFilesInGitAnnex ww Command.Unannex.seeker l
|
||||
finish
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
|
|
@ -27,10 +27,14 @@ mkcmd n d = withGlobalOptions [jsonOptions, annexedMatchingOptions] $
|
|||
command n SectionCommon d paramPaths (withParams seek)
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek ps = withFilesInGitAnnex ww (commandAction' start)
|
||||
=<< workTreeItems ww ps
|
||||
seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' start
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = False
|
||||
}
|
||||
|
||||
start :: RawFilePath -> Key -> CommandStart
|
||||
start file key = ifM (isJust <$> isAnnexLink file)
|
||||
|
|
|
@ -55,10 +55,15 @@ seek o = do
|
|||
case batchOption o of
|
||||
Batch fmt -> batchFilesMatching fmt
|
||||
(whenAnnexed go . toRawFilePath)
|
||||
NoBatch ->
|
||||
NoBatch -> do
|
||||
let seeker = AnnexedFileSeeker
|
||||
{ seekAction = commandAction' go
|
||||
, checkContentPresent = Nothing
|
||||
, usesLocationLog = True
|
||||
}
|
||||
withKeyOptions (keyOptions o) False
|
||||
(commandAction . startKeys o m)
|
||||
(withFilesInGitAnnex ww (commandAction' go))
|
||||
(withFilesInGitAnnex ww seeker)
|
||||
=<< workTreeItems ww (whereisFiles o)
|
||||
where
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue