avoid needing to keep list of present keys
Stale and bad files are rare, so it's more efficient to use inAnnex to see if they can be deleted, rather than keeping the list of all present keys around for them.
This commit is contained in:
parent
6fd0c0bfec
commit
5df18b311a
1 changed files with 15 additions and 28 deletions
|
@ -55,12 +55,20 @@ start = do
|
|||
|
||||
checkUnused :: CommandPerform
|
||||
checkUnused = do
|
||||
(unused, stalebad, staletmp) <- unusedKeys
|
||||
unused <- findunused =<< Annex.getState Annex.fast
|
||||
stalebad <- staleKeysPrune gitAnnexBadDir
|
||||
staletmp <- staleKeysPrune gitAnnexTmpDir
|
||||
_ <- list "" unusedMsg unused 0 >>=
|
||||
list "bad" staleBadMsg stalebad >>=
|
||||
list "tmp" staleTmpMsg staletmp
|
||||
next $ return True
|
||||
where
|
||||
findunused True = do
|
||||
showNote "fast mode enabled; only finding stale files"
|
||||
return []
|
||||
findunused False = do
|
||||
showAction "checking for unused data"
|
||||
excludeReferenced =<< getKeysPresent
|
||||
list file msg l c = do
|
||||
let unusedlist = number c l
|
||||
unless (null l) $ showLongNote $ msg unusedlist
|
||||
|
@ -131,26 +139,6 @@ dropMsg (Just r) = dropMsg' $ " --from " ++ Remote.name r
|
|||
dropMsg' :: String -> String
|
||||
dropMsg' s = "\nTo remove unwanted data: git-annex dropunused" ++ s ++ " NUMBER\n"
|
||||
|
||||
{- Finds keys whose content is present, but that do not seem to be used
|
||||
- by any files in the git repo, or that are only present as bad or tmp
|
||||
- files. -}
|
||||
unusedKeys :: Annex ([Key], [Key], [Key])
|
||||
unusedKeys = do
|
||||
fast <- Annex.getState Annex.fast
|
||||
if fast
|
||||
then do
|
||||
showNote "fast mode enabled; only finding stale files"
|
||||
tmp <- staleKeys gitAnnexTmpDir
|
||||
bad <- staleKeys gitAnnexBadDir
|
||||
return ([], bad, tmp)
|
||||
else do
|
||||
showAction "checking for unused data"
|
||||
present <- getKeysPresent
|
||||
unused <- excludeReferenced present
|
||||
staletmp <- staleKeysPrune gitAnnexTmpDir present
|
||||
stalebad <- staleKeysPrune gitAnnexBadDir present
|
||||
return (unused, stalebad, staletmp)
|
||||
|
||||
{- Finds keys in the list that are not referenced in the git repository. -}
|
||||
excludeReferenced :: [Key] -> Annex [Key]
|
||||
excludeReferenced [] = return [] -- optimisation
|
||||
|
@ -220,17 +208,16 @@ withKeysReferencedInGit ref initial a = do
|
|||
| otherwise = go v ls
|
||||
|
||||
{- Looks in the specified directory for bad/tmp keys, and returns a list
|
||||
- of those that might still have value, or might be stale and removable.
|
||||
- of those that might still have value, or might be stale and removable.
|
||||
-
|
||||
- When a list of presently available keys is provided, stale keys
|
||||
- that no longer have value are deleted.
|
||||
- Also, stale keys that can be proven to have no value are deleted.
|
||||
-}
|
||||
staleKeysPrune :: (Git.Repo -> FilePath) -> [Key] -> Annex [Key]
|
||||
staleKeysPrune dirspec present = do
|
||||
staleKeysPrune :: (Git.Repo -> FilePath) -> Annex [Key]
|
||||
staleKeysPrune dirspec = do
|
||||
contents <- staleKeys dirspec
|
||||
|
||||
let stale = contents `exclude` present
|
||||
let dups = contents `exclude` stale
|
||||
dups <- filterM inAnnex contents
|
||||
let stale = contents `exclude` dups
|
||||
|
||||
dir <- fromRepo dirspec
|
||||
liftIO $ forM_ dups $ \t -> removeFile $ dir </> keyFile t
|
||||
|
|
Loading…
Reference in a new issue