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.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

39
Command/DropUnused.hs
View file

@ -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