migrate --apply
And avoid migrate --update/--aply migrating when the new key was already present in the repository, and got dropped. Luckily, the location log allows distinguishing from the new key never having been present! That is mostly useful for --apply because otherwise dropped files would keep coming back until the old objects were reaped as unused. But it seemed to make sense to also do it for --update. for consistency in edge cases if nothing else. One case where --update can use it is when one branch got migrated earlier, and we dropped the file, and now another branch has migrated the same file. Sponsored-by: Jack Hill on Patreon
This commit is contained in:
parent
51b974d9f0
commit
4ed71b34de
8 changed files with 78 additions and 25 deletions
|
@ -21,6 +21,7 @@ module Logs.Location (
|
|||
logStatusAfter,
|
||||
logChange,
|
||||
loggedLocations,
|
||||
loggedPreviousLocations,
|
||||
loggedLocationsHistorical,
|
||||
loggedLocationsRef,
|
||||
parseLoggedLocations,
|
||||
|
@ -79,7 +80,13 @@ logChange _ NoUUID _ = noop
|
|||
{- Returns a list of repository UUIDs that, according to the log, have
|
||||
- the value of a key. -}
|
||||
loggedLocations :: Key -> Annex [UUID]
|
||||
loggedLocations = getLoggedLocations currentLogInfo
|
||||
loggedLocations = getLoggedLocations presentLogInfo
|
||||
|
||||
{- Returns a list of repository UUIDs that the location log indicates
|
||||
- used to have the vale of a key, but no longer do.
|
||||
-}
|
||||
loggedPreviousLocations :: Key -> Annex [UUID]
|
||||
loggedPreviousLocations = getLoggedLocations notPresentLogInfo
|
||||
|
||||
{- Gets the location log on a particular date. -}
|
||||
loggedLocationsHistorical :: RefDate -> Key -> Annex [UUID]
|
||||
|
|
|
@ -117,15 +117,18 @@ commitMigration = do
|
|||
(asTopFilePath migrationTreeGraftPoint)
|
||||
committedMigration commitsha
|
||||
|
||||
-- Streams distributed migrations from the git-annex branch that have not
|
||||
-- been performed here, and runs the provided action on each old and new
|
||||
-- key pair.
|
||||
streamNewDistributedMigrations :: (Key -> Key -> Annex ()) -> Annex ()
|
||||
streamNewDistributedMigrations a = do
|
||||
-- Streams distributed migrations from the git-annex branch,
|
||||
-- and runs the provided action on each old and new key pair.
|
||||
--
|
||||
-- With the incremental option, only scans as far as the last recorded
|
||||
-- migration that this has handled before.
|
||||
streamNewDistributedMigrations :: Bool -> (Key -> Key -> Annex ()) -> Annex ()
|
||||
streamNewDistributedMigrations incremental a = do
|
||||
void Annex.Branch.update
|
||||
branchsha <- Annex.Branch.getBranch
|
||||
(stoppoint, toskip) <- getPerformedMigrations
|
||||
(l, cleanup) <- inRepo $ getGitLog branchsha stoppoint
|
||||
(l, cleanup) <- inRepo $ getGitLog branchsha
|
||||
(if incremental then stoppoint else Nothing)
|
||||
[fromRawFilePath migrationTreeGraftPoint]
|
||||
-- Need to follow because migrate.tree is grafted in
|
||||
-- and then deleted, and normally git log stops when a file
|
||||
|
|
|
@ -17,8 +17,8 @@ module Logs.Presence (
|
|||
addLog',
|
||||
maybeAddLog,
|
||||
readLog,
|
||||
currentLog,
|
||||
currentLogInfo,
|
||||
presentLogInfo,
|
||||
notPresentLogInfo,
|
||||
historicalLogInfo,
|
||||
) where
|
||||
|
||||
|
@ -68,12 +68,13 @@ genLine logstatus loginfo c old = LogLine c' logstatus loginfo
|
|||
readLog :: RawFilePath -> Annex [LogLine]
|
||||
readLog = parseLog <$$> Annex.Branch.get
|
||||
|
||||
{- Reads a log and returns only the info that is still in effect. -}
|
||||
currentLogInfo :: RawFilePath -> Annex [LogInfo]
|
||||
currentLogInfo file = map info <$> currentLog file
|
||||
{- Reads a log and returns only the info that is still present. -}
|
||||
presentLogInfo :: RawFilePath -> Annex [LogInfo]
|
||||
presentLogInfo file = map info . filterPresent <$> readLog file
|
||||
|
||||
currentLog :: RawFilePath -> Annex [LogLine]
|
||||
currentLog file = filterPresent <$> readLog file
|
||||
{- Reads a log and returns only the info that is no longer present. -}
|
||||
notPresentLogInfo :: RawFilePath -> Annex [LogInfo]
|
||||
notPresentLogInfo file = map info . filterNotPresent <$> readLog file
|
||||
|
||||
{- Reads a historical version of a log and returns the info that was in
|
||||
- effect at that time.
|
||||
|
|
|
@ -70,14 +70,18 @@ buildLog = mconcat . map genline
|
|||
genstatus InfoMissing = charUtf8 '0'
|
||||
genstatus InfoDead = charUtf8 'X'
|
||||
|
||||
{- Given a log, returns only the info that is are still in effect. -}
|
||||
{- Given a log, returns only the info that is still present. -}
|
||||
getLog :: L.ByteString -> [LogInfo]
|
||||
getLog = map info . filterPresent . parseLog
|
||||
|
||||
{- Returns the info from LogLines that are in effect. -}
|
||||
{- Returns the info from LogLines that is present. -}
|
||||
filterPresent :: [LogLine] -> [LogLine]
|
||||
filterPresent = filter (\l -> InfoPresent == status l) . compactLog
|
||||
|
||||
{- Returns the info from LogLines that is not present. -}
|
||||
filterNotPresent :: [LogLine] -> [LogLine]
|
||||
filterNotPresent = filter (\l -> InfoPresent /= status l) . compactLog
|
||||
|
||||
{- Compacts a set of logs, returning a subset that contains the current
|
||||
- status. -}
|
||||
compactLog :: [LogLine] -> [LogLine]
|
||||
|
|
|
@ -55,7 +55,7 @@ getUrls' key = do
|
|||
where
|
||||
go [] = return []
|
||||
go (l:ls) = do
|
||||
us <- currentLogInfo l
|
||||
us <- presentLogInfo l
|
||||
if null us
|
||||
then go ls
|
||||
else return $ map fromLogInfo us
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue