c3d40b9ec3
Each command that first checks preferred content (and/or required content) and then does something that can change the sizes of repositories needs to call prepareLiveUpdate, and plumb it through the preferred content check and the location log update. So far, only Command.Drop is done. Many other commands that don't need to do this have been updated to keep working. There may be some calls to NoLiveUpdate in places where that should be done. All will need to be double checked. Not currently in a compilable state.
84 lines
2.6 KiB
Haskell
84 lines
2.6 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010,2012,2018 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Command.DropUnused where
|
|
|
|
import Command
|
|
import qualified Annex
|
|
import qualified Command.Drop
|
|
import qualified Remote
|
|
import qualified Git
|
|
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
|
|
import Annex.NumCopies
|
|
import Annex.Content
|
|
import qualified Utility.RawFilePath as R
|
|
|
|
cmd :: Command
|
|
cmd = withAnnexOptions [jobsOption, jsonOptions] $
|
|
command "dropunused" SectionMaintenance
|
|
"drop unused file content"
|
|
(paramRepeating paramNumRange) (seek <$$> optParser)
|
|
|
|
data DropUnusedOptions = DropUnusedOptions
|
|
{ rangesToDrop :: CmdParams
|
|
, dropFrom :: Maybe (DeferredParse Remote)
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser DropUnusedOptions
|
|
optParser desc = DropUnusedOptions
|
|
<$> cmdParams desc
|
|
<*> optional (Command.Drop.parseDropFromOption)
|
|
|
|
seek :: DropUnusedOptions -> CommandSeek
|
|
seek o = startConcurrency commandStages $ do
|
|
numcopies <- getNumCopies
|
|
mincopies <- getMinCopies
|
|
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
|
|
withUnusedMaps (start from numcopies mincopies) (rangesToDrop o)
|
|
|
|
start :: Maybe Remote -> NumCopies -> MinCopies -> UnusedMaps -> Int -> CommandStart
|
|
start from numcopies mincopies = startUnused
|
|
(go (perform from numcopies mincopies))
|
|
(go (performOther gitAnnexBadLocation))
|
|
(go (performOther gitAnnexTmpObjectLocation))
|
|
where
|
|
go a n key = starting "dropunused"
|
|
(ActionItemOther $ Just $ UnquotedString $ show n)
|
|
(SeekInput [show n])
|
|
(a key)
|
|
|
|
perform :: Maybe Remote -> NumCopies -> MinCopies -> Key -> CommandPerform
|
|
perform from numcopies mincopies key = case from of
|
|
Just r -> do
|
|
showAction $ UnquotedString $ "from " ++ Remote.name r
|
|
Command.Drop.performRemote NoLiveUpdate pcc key
|
|
(AssociatedFile Nothing) numcopies mincopies r ud
|
|
Nothing -> ifM (inAnnex key)
|
|
( droplocal
|
|
, ifM (objectFileExists key)
|
|
( ifM (Annex.getRead Annex.force)
|
|
( droplocal
|
|
, do
|
|
warning "Annexed object has been modified and dropping it would probably lose the only copy. Run this command with --force if you want to drop it anyway."
|
|
next $ return False
|
|
)
|
|
, next $ return True
|
|
)
|
|
)
|
|
where
|
|
droplocal = Command.Drop.performLocal NoLiveUpdate pcc
|
|
key (AssociatedFile Nothing) numcopies mincopies [] ud
|
|
pcc = Command.Drop.PreferredContentChecked False
|
|
ud = Command.Drop.DroppingUnused True
|
|
|
|
performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform
|
|
performOther filespec key = do
|
|
f <- fromRepo $ filespec key
|
|
pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink)
|
|
next $ return True
|