2010-11-15 22:06:21 +00:00
{- git - annex command
-
2018-12-04 16:20:34 +00:00
- Copyright 2010 , 2012 , 2018 Joey Hess < id @ joeyh . name >
2010-11-15 22:06:21 +00:00
-
2019-03-13 19:48:14 +00:00
- Licensed under the GNU AGPL version 3 or higher .
2010-11-15 22:06:21 +00:00
- }
module Command.DropUnused where
import Command
2018-12-04 16:20:34 +00:00
import qualified Annex
2010-11-15 22:06:21 +00:00
import qualified Command.Drop
2011-04-03 00:59:41 +00:00
import qualified Remote
2011-06-30 17:16:57 +00:00
import qualified Git
2013-07-03 19:26:59 +00:00
import Command.Unused ( withUnusedMaps , UnusedMaps ( .. ) , startUnused )
2015-04-30 18:02:56 +00:00
import Annex.NumCopies
2015-12-03 19:58:00 +00:00
import Annex.Content
2020-11-03 14:11:04 +00:00
import qualified Utility.RawFilePath as R
2011-04-29 17:59:00 +00:00
2015-07-08 16:33:27 +00:00
cmd :: Command
2015-07-10 20:15:31 +00:00
cmd = command " dropunused " SectionMaintenance
" drop unused file content "
( paramRepeating paramNumRange ) ( seek <$$> optParser )
2010-12-30 19:06:26 +00:00
2015-07-10 20:15:31 +00:00
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
2014-01-21 21:08:49 +00:00
numcopies <- getNumCopies
2021-01-06 18:11:08 +00:00
mincopies <- getMinCopies
2015-07-10 20:15:31 +00:00
from <- maybe ( pure Nothing ) ( Just <$$> getParsed ) ( dropFrom o )
2021-01-06 18:11:08 +00:00
withUnusedMaps ( start from numcopies mincopies ) ( rangesToDrop o )
2012-05-02 17:15:19 +00:00
2021-01-06 18:11:08 +00:00
start :: Maybe Remote -> NumCopies -> MinCopies -> UnusedMaps -> Int -> CommandStart
start from numcopies mincopies = startUnused " dropunused "
( perform from numcopies mincopies )
2015-12-03 19:58:00 +00:00
( performOther gitAnnexBadLocation )
( performOther gitAnnexTmpObjectLocation )
2011-04-03 00:59:41 +00:00
2021-01-06 18:11:08 +00:00
perform :: Maybe Remote -> NumCopies -> MinCopies -> Key -> CommandPerform
perform from numcopies mincopies key = case from of
2015-07-10 20:15:31 +00:00
Just r -> do
2012-11-12 05:05:04 +00:00
showAction $ " from " ++ Remote . name r
2021-06-25 19:22:05 +00:00
Command . Drop . performRemote pcc key ( AssociatedFile Nothing ) numcopies mincopies r ud
2015-12-03 19:58:00 +00:00
Nothing -> ifM ( inAnnex key )
2018-12-04 16:20:34 +00:00
( droplocal
, ifM ( objectFileExists key )
2022-06-28 19:28:14 +00:00
( ifM ( Annex . getRead Annex . force )
2018-12-04 16:20:34 +00:00
( 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
)
2015-12-03 19:58:00 +00:00
)
2018-12-04 16:20:34 +00:00
where
2021-06-25 19:22:05 +00:00
droplocal = Command . Drop . performLocal pcc key ( AssociatedFile Nothing ) numcopies mincopies [] ud
2021-05-25 14:57:06 +00:00
pcc = Command . Drop . PreferredContentChecked False
2021-06-25 19:22:05 +00:00
ud = Command . Drop . DroppingUnused True
2011-04-03 00:59:41 +00:00
2020-11-03 14:11:04 +00:00
performOther :: ( Key -> Git . Repo -> RawFilePath ) -> Key -> CommandPerform
2011-04-29 17:59:00 +00:00
performOther filespec key = do
2011-11-08 19:34:10 +00:00
f <- fromRepo $ filespec key
2020-11-03 14:11:04 +00:00
pruneTmpWorkDirBefore f ( liftIO . removeWhenExistsWith R . removeLink )
2011-05-15 06:02:46 +00:00
next $ return True