This commit is contained in:
Joey Hess 2015-07-08 17:59:06 -04:00
parent 6a88c7c101
commit 60806dd191
5 changed files with 137 additions and 82 deletions

View file

@ -19,50 +19,68 @@ import Annex.NumCopies
import Annex.Content
import Annex.Wanted
import Annex.Notification
import Git.Types (RemoteName)
import qualified Data.Set as S
import Options.Applicative hiding (command)
cmd :: Command
cmd = withOptions (dropOptions) $
command "drop" SectionCommon
"indicate content of files not currently wanted"
paramPaths (withParams seek)
cmd = command "drop" SectionCommon
"indicate content of files not currently wanted"
paramPaths (seek <$$> optParser)
dropOptions :: [Option]
dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions
data DropOptions = DropOptions
{ dropFiles :: CmdParams
, dropFrom :: Maybe RemoteName
, autoMode :: Bool
, keyOptions :: KeyOptions
}
dropFromOption :: Option
dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
-- TODO: annexedMatchingOptions
seek :: CmdParams -> CommandSeek
seek ps = do
from <- getOptionField dropFromOption Remote.byNameWithUUID
auto <- getOptionFlag autoOption
withKeyOptions auto
(startKeys auto from)
(withFilesInGit $ whenAnnexed $ start auto from)
ps
optParser :: CmdParamsDesc -> Parser DropOptions
optParser desc = DropOptions
<$> cmdParams desc
<*> parseDropFromOption
<*> parseAutoOption
<*> parseKeyOptions False
start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
start auto from file key = start' auto from key (Just file)
parseDropFromOption :: Parser (Maybe RemoteName)
parseDropFromOption = finalOpt $ strOption
( long "from"
<> short 'f'
<> metavar paramRemote
<> help "drop content from a remote"
)
start' :: Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
start' auto from key afile = checkDropAuto auto from afile key $ \numcopies ->
stopUnless want $
case from of
Nothing -> startLocal afile numcopies key Nothing
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal afile numcopies key Nothing
else startRemote afile numcopies key remote
where
want
| auto = wantDrop False (Remote.uuid <$> from) (Just key) afile
| otherwise = return True
seek :: DropOptions -> CommandSeek
seek o = withKeyOptions (keyOptions o) (autoMode o)
(startKeys o)
(withFilesInGit $ whenAnnexed $ start o)
(dropFiles o)
startKeys :: Bool -> Maybe Remote -> Key -> CommandStart
startKeys auto from key = start' auto from key Nothing
start :: DropOptions -> FilePath -> Key -> CommandStart
start o file key = start' o key (Just file)
start' :: DropOptions -> Key -> AssociatedFile -> CommandStart
start' o key afile = do
from <- Remote.byNameWithUUID (dropFrom o)
checkDropAuto (autoMode o) from afile key $ \numcopies ->
stopUnless (want from) $
case from of
Nothing -> startLocal afile numcopies key Nothing
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal afile numcopies key Nothing
else startRemote afile numcopies key remote
where
want from
| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile
| otherwise = return True
startKeys :: DropOptions -> Key -> CommandStart
startKeys o key = start' o key Nothing
startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
@ -166,10 +184,10 @@ requiredContent = do
{- In auto mode, only runs the action if there are enough
- copies on other semitrusted repositories. -}
checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
checkDropAuto auto mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
checkDropAuto automode mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
where
go numcopies
| auto = do
| automode = do
locs <- Remote.keyLocations key
uuid <- getUUID
let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote