diff options
| -rw-r--r-- | CmdLine/GitAnnex.hs | 4 | ||||
| -rw-r--r-- | Command/DropUnused.hs | 39 |
2 files changed, 25 insertions, 18 deletions
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 7119d1455..662766f46 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -51,7 +51,7 @@ import qualified Command.EnableRemote --import qualified Command.Expire import qualified Command.Repair import qualified Command.Unused ---import qualified Command.DropUnused +import qualified Command.DropUnused import qualified Command.AddUnused import qualified Command.Unlock import qualified Command.Lock @@ -181,7 +181,7 @@ cmds = -- , Command.Expire.cmd , Command.Repair.cmd , Command.Unused.cmd --- , Command.DropUnused.cmd + , Command.DropUnused.cmd , Command.AddUnused.cmd , Command.Find.cmd -- , Command.FindRef.cmd diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 703cc3890..98fcef6ea 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -9,7 +9,6 @@ module Command.DropUnused where import Common.Annex import Command -import qualified Annex import qualified Command.Drop import qualified Remote import qualified Git @@ -17,27 +16,35 @@ import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Annex.NumCopies cmd :: Command -cmd = withOptions [Command.Drop.dropFromOption] $ - command "dropunused" SectionMaintenance - "drop unused file content" - (paramRepeating paramNumRange) (withParams seek) +cmd = command "dropunused" SectionMaintenance + "drop unused file content" + (paramRepeating paramNumRange) (seek <$$> optParser) -seek :: CmdParams -> CommandSeek -seek ps = do +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 - withUnusedMaps (start numcopies) ps + from <- maybe (pure Nothing) (Just <$$> getParsed) (dropFrom o) + withUnusedMaps (start from numcopies) (rangesToDrop o) -start :: NumCopies -> UnusedMaps -> Int -> CommandStart -start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation) +start :: Maybe Remote -> NumCopies -> UnusedMaps -> Int -> CommandStart +start from numcopies = startUnused "dropunused" (perform from numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation) -perform :: NumCopies -> Key -> CommandPerform -perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from - where - dropremote r = do +perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform +perform from numcopies key = case from of + Just r -> do showAction $ "from " ++ Remote.name r Command.Drop.performRemote key Nothing numcopies r - droplocal = Command.Drop.performLocal key Nothing numcopies Nothing - from = Annex.getField $ optionName Command.Drop.dropFromOption + Nothing -> Command.Drop.performLocal key Nothing numcopies Nothing performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform performOther filespec key = do |