mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

convert DropUnused

Browse source
This commit is contained in:
Joey Hess 2015-07-10 16:15:31 -04:00
parent 160d4b9fe0
commit decfababe9
2 changed files with 25 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
CmdLine/GitAnnex.hs
View file

@ -51,7 +51,7 @@ import qualified Command.EnableRemote
--import qualified Command.Expire --import qualified Command.Expire
import qualified Command.Repair import qualified Command.Repair
import qualified Command.Unused import qualified Command.Unused
--import qualified Command.DropUnused import qualified Command.DropUnused
import qualified Command.AddUnused import qualified Command.AddUnused
import qualified Command.Unlock import qualified Command.Unlock
import qualified Command.Lock import qualified Command.Lock
@ -181,7 +181,7 @@ cmds =
-- , Command.Expire.cmd -- , Command.Expire.cmd
, Command.Repair.cmd , Command.Repair.cmd
, Command.Unused.cmd , Command.Unused.cmd
-- , Command.DropUnused.cmd , Command.DropUnused.cmd
, Command.AddUnused.cmd , Command.AddUnused.cmd
, Command.Find.cmd , Command.Find.cmd
-- , Command.FindRef.cmd -- , Command.FindRef.cmd

39
Command/DropUnused.hs
View file

@ -9,7 +9,6 @@ module Command.DropUnused where
import Common.Annex import Common.Annex
import Command import Command
import qualified Annex
import qualified Command.Drop import qualified Command.Drop
import qualified Remote import qualified Remote
import qualified Git import qualified Git
@ -17,27 +16,35 @@ import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
import Annex.NumCopies import Annex.NumCopies
cmd :: Command cmd :: Command
cmd = withOptions [Command.Drop.dropFromOption] $ cmd = command "dropunused" SectionMaintenance
command "dropunused" SectionMaintenance "drop unused file content"
"drop unused file content" (paramRepeating paramNumRange) (seek <$$> optParser)
(paramRepeating paramNumRange) (withParams seek)
seek :: CmdParams -> CommandSeek data DropUnusedOptions = DropUnusedOptions
seek ps = do { 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 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 :: Maybe Remote -> NumCopies -> UnusedMaps -> Int -> CommandStart
start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation) start from numcopies = startUnused "dropunused" (perform from numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpObjectLocation)
perform :: NumCopies -> Key -> CommandPerform perform :: Maybe Remote -> NumCopies -> Key -> CommandPerform
perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from perform from numcopies key = case from of
where Just r -> do
dropremote r = do
showAction $ "from " ++ Remote.name r showAction $ "from " ++ Remote.name r
Command.Drop.performRemote key Nothing numcopies r Command.Drop.performRemote key Nothing numcopies r
droplocal = Command.Drop.performLocal key Nothing numcopies Nothing Nothing -> Command.Drop.performLocal key Nothing numcopies Nothing
from = Annex.getField $ optionName Command.Drop.dropFromOption
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
performOther filespec key = do performOther filespec key = do