1a9af823bc
This also changes addunused to display the names of the files that it adds. That seems like a general usability improvement, and not displaying the input number does not seem likely to be a problem to a user, since the filename is based on the key. Displaying the filename was necessary to get it and the key included in the json. dropunused does not include the key in the json. It would be possible to add, but would need more changes. And I doubt that dropunused --json would be used in a situation where a program cared which keys were dropped. Note that drop --unused does have the key in its json, so such a program could just use it. Or could just dropkey --batch with the specific keys it wants to drop if it cares about specific keys. Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project
82 lines
2.6 KiB
Haskell
82 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 [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 = 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 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 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
|