2010-11-15 22:06:21 +00:00
|
|
|
{- git-annex command
|
|
|
|
-
|
2015-01-21 16:50:09 +00:00
|
|
|
- Copyright 2010,2012 Joey Hess <id@joeyh.name>
|
2010-11-15 22:06:21 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Command.DropUnused where
|
|
|
|
|
|
|
|
import Command
|
|
|
|
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
|
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
|
2015-07-10 20:15:31 +00:00
|
|
|
from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o)
|
|
|
|
withUnusedMaps (start from numcopies) (rangesToDrop o)
|
2012-05-02 17:15:19 +00:00
|
|
|
|
2015-07-10 20:15:31 +00:00
|
|
|
start :: Maybe Remote -> NumCopies -> UnusedMaps -> Int -> CommandStart
|
2015-12-03 19:58:00 +00:00
|
|
|
start from numcopies = startUnused "dropunused"
|
|
|
|
(perform from numcopies)
|
|
|
|
(performOther gitAnnexBadLocation)
|
|
|
|
(performOther gitAnnexTmpObjectLocation)
|
2011-04-03 00:59:41 +00:00
|
|
|
|
2015-07-10 20:15:31 +00:00
|
|
|
perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform
|
|
|
|
perform from numcopies key = case from of
|
|
|
|
Just r -> do
|
2012-11-12 05:05:04 +00:00
|
|
|
showAction $ "from " ++ Remote.name r
|
2014-03-29 19:20:55 +00:00
|
|
|
Command.Drop.performRemote key Nothing numcopies r
|
2015-12-03 19:58:00 +00:00
|
|
|
Nothing -> ifM (inAnnex key)
|
|
|
|
( Command.Drop.performLocal key Nothing numcopies []
|
|
|
|
, next (return True)
|
|
|
|
)
|
2011-04-03 00:59:41 +00:00
|
|
|
|
2011-11-08 19:34:10 +00:00
|
|
|
performOther :: (Key -> Git.Repo -> FilePath) -> 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
|
2012-06-06 17:13:13 +00:00
|
|
|
liftIO $ nukeFile f
|
2011-05-15 06:02:46 +00:00
|
|
|
next $ return True
|