git-annex/Command/DropUnused.hs

46 lines
1.4 KiB
Haskell
Raw Normal View History

2010-11-15 22:06:21 +00:00
{- git-annex command
-
- Copyright 2010,2012 Joey Hess <joey@kitenet.net>
2010-11-15 22:06:21 +00:00
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.DropUnused where
2011-10-05 20:02:51 +00:00
import Common.Annex
2010-11-15 22:06:21 +00:00
import Command
import qualified Annex
import qualified Command.Drop
2011-04-03 00:59:41 +00:00
import qualified Remote
import qualified Git
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
2014-01-21 22:08:56 +00:00
import Config.NumCopies
def :: [Command]
2014-01-26 20:25:55 +00:00
def = [withOptions [Command.Drop.dropFromOption] $
command "dropunused" (paramRepeating paramNumRange)
seek SectionMaintenance "drop unused file content"]
seek :: CommandSeek
seek ps = do
numcopies <- getNumCopies
withUnusedMaps (start numcopies) ps
start :: NumCopies -> UnusedMaps -> Int -> CommandStart
start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation)
2011-04-03 00:59:41 +00:00
perform :: NumCopies -> Key -> CommandPerform
perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from
2012-11-12 05:05:04 +00:00
where
dropremote r = do
showAction $ "from " ++ Remote.name r
Command.Drop.performRemote key numcopies r
droplocal = Command.Drop.performLocal key numcopies Nothing
2014-01-26 20:25:55 +00:00
from = Annex.getField $ optionName Command.Drop.dropFromOption
2011-04-03 00:59:41 +00:00
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
performOther filespec key = do
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