summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-03-25 17:06:14 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-03-25 17:06:14 -0400
commit850241b7fed075c8a0055ae77cb30d6485aaa795 (patch)
treebbae2d577ea7daf136cfb80cdf87e4ce76681f84 /Command
parent644cd4ca27e410ca567ec0f78acf2517d91d330e (diff)
--auto is no longer a global option; only get, drop, and copy accept it.
Not a behavior change unless you were passing it to a command that ignored it.
Diffstat (limited to 'Command')
-rw-r--r--Command/Copy.hs22
-rw-r--r--Command/Drop.hs40
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Command/Get.hs15
-rw-r--r--Command/MetaData.hs2
-rw-r--r--Command/Mirror.hs16
-rw-r--r--Command/Move.hs6
-rw-r--r--Command/Whereis.hs2
8 files changed, 56 insertions, 49 deletions
diff --git a/Command/Copy.hs b/Command/Copy.hs
index e5b093c61..1b9b2aac8 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -15,26 +15,32 @@ import Annex.Wanted
import Config.NumCopies
cmd :: [Command]
-cmd = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek
+cmd = [withOptions copyOptions $ command "copy" paramPaths seek
SectionCommon "copy content of files to/from another repository"]
+copyOptions :: [Option]
+copyOptions = Command.Move.moveOptions ++ [autoOption]
+
seek :: CommandSeek
seek ps = do
to <- getOptionField toOption Remote.byNameWithUUID
from <- getOptionField fromOption Remote.byNameWithUUID
- withKeyOptions
+ auto <- getOptionFlag autoOption
+ withKeyOptions auto
(Command.Move.startKey to from False)
- (withFilesInGit $ whenAnnexed $ start to from)
+ (withFilesInGit $ whenAnnexed $ start auto to from)
ps
{- A copy is just a move that does not delete the source file.
- - However, --auto mode avoids unnecessary copies, and avoids getting or
+ - However, auto mode avoids unnecessary copies, and avoids getting or
- sending non-preferred content. -}
-start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
-start to from file key = stopUnless shouldCopy $
+start :: Bool -> Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
+start auto to from file key = stopUnless shouldCopy $
Command.Move.start to from False file key
where
- shouldCopy = checkAuto (check <||> numCopiesCheck file key (<))
- check = case to of
+ shouldCopy
+ | auto = want <||> numCopiesCheck file key (<)
+ | otherwise = return True
+ want = case to of
Nothing -> wantGet False (Just key) (Just file)
Just r -> wantSend False (Just key) (Just file) (Remote.uuid r)
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 35c2f5cf4..63b9ccb7f 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -27,7 +27,7 @@ cmd = [withOptions (dropOptions) $ command "drop" paramPaths seek
SectionCommon "indicate content of files not currently wanted"]
dropOptions :: [Option]
-dropOptions = dropFromOption : annexedMatchingOptions
+dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption]
dropFromOption :: Option
dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
@@ -35,11 +35,12 @@ dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remot
seek :: CommandSeek
seek ps = do
from <- getOptionField dropFromOption Remote.byNameWithUUID
- withFilesInGit (whenAnnexed $ start from) ps
+ auto <- getOptionFlag autoOption
+ withFilesInGit (whenAnnexed $ start auto from) ps
-start :: Maybe Remote -> FilePath -> Key -> CommandStart
-start from file key = checkDropAuto from file key $ \numcopies ->
- stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just key) (Just file)) $
+start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
+start auto from file key = checkDropAuto auto from file key $ \numcopies ->
+ stopUnless want $
case from of
Nothing -> startLocal (Just file) numcopies key Nothing
Just remote -> do
@@ -47,6 +48,10 @@ start from file key = checkDropAuto from file key $ \numcopies ->
if Remote.uuid remote == u
then startLocal (Just file) numcopies key Nothing
else startRemote (Just file) numcopies key remote
+ where
+ want
+ | auto = wantDrop False (Remote.uuid <$> from) (Just key) (Just file)
+ | otherwise = return True
startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
@@ -182,17 +187,16 @@ requiredContent = do
{- In auto mode, only runs the action if there are enough
- copies on other semitrusted repositories. -}
-checkDropAuto :: Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart
-checkDropAuto mremote file key a = do
- numcopies <- getFileNumCopies file
- Annex.getState Annex.auto >>= auto numcopies
+checkDropAuto :: Bool -> Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart
+checkDropAuto auto mremote file key a = go =<< getFileNumCopies file
where
- auto numcopies False = a numcopies
- auto numcopies True = do
- locs <- Remote.keyLocations key
- uuid <- getUUID
- let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote
- locs' <- trustExclude UnTrusted $ filter (/= remoteuuid) locs
- if NumCopies (length locs') >= numcopies
- then a numcopies
- else stop
+ go numcopies
+ | auto = do
+ locs <- Remote.keyLocations key
+ uuid <- getUUID
+ let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote
+ locs' <- trustExclude UnTrusted $ filter (/= remoteuuid) locs
+ if NumCopies (length locs') >= numcopies
+ then a numcopies
+ else stop
+ | otherwise = a numcopies
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 2d6029ec9..7b8fbddf1 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -69,7 +69,7 @@ seek ps = do
from <- getOptionField fsckFromOption Remote.byNameWithUUID
u <- maybe getUUID (pure . Remote.uuid) from
i <- getIncremental u
- withKeyOptions
+ withKeyOptions False
(\k -> startKey i k =<< getNumCopies)
(withFilesInGit $ whenAnnexed $ start from i)
ps
diff --git a/Command/Get.hs b/Command/Get.hs
index 85960fc1a..922aee06a 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -21,20 +21,23 @@ cmd = [withOptions getOptions $ command "get" paramPaths seek
SectionCommon "make content of annexed files available"]
getOptions :: [Option]
-getOptions = fromOption : annexedMatchingOptions ++ keyOptions
+getOptions = fromOption : annexedMatchingOptions ++ keyOptions ++ [autoOption]
seek :: CommandSeek
seek ps = do
from <- getOptionField fromOption Remote.byNameWithUUID
- withKeyOptions
+ auto <- getOptionFlag autoOption
+ withKeyOptions auto
(startKeys from)
- (withFilesInGit $ whenAnnexed $ start from)
+ (withFilesInGit $ whenAnnexed $ start auto from)
ps
-start :: Maybe Remote -> FilePath -> Key -> CommandStart
-start from file key = start' expensivecheck from key (Just file)
+start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
+start auto from file key = start' expensivecheck from key (Just file)
where
- expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file))
+ expensivecheck
+ | auto = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
+ | otherwise = return True
startKeys :: Maybe Remote -> Key -> CommandStart
startKeys from key = start' (return True) from key Nothing
diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index 08f205359..10093ab08 100644
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -61,7 +61,7 @@ seek ps = do
let seeker = if null modmeta
then withFilesInGit
else withFilesInGitNonRecursive
- withKeyOptions
+ withKeyOptions False
(startKeys now getfield modmeta)
(seeker $ whenAnnexed $ start now getfield modmeta)
ps
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index 7d3a7ef67..a04efb89b 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -14,19 +14,20 @@ import qualified Command.Drop
import qualified Command.Get
import qualified Remote
import Annex.Content
-import qualified Annex
import Config.NumCopies
cmd :: [Command]
-cmd = [withOptions (fromToOptions ++ annexedMatchingOptions ++ keyOptions) $
- command "mirror" paramPaths seek
- SectionCommon "mirror content of files to/from another repository"]
+cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek
+ SectionCommon "mirror content of files to/from another repository"]
+
+mirrorOptions :: [Option]
+mirrorOptions = fromToOptions ++ annexedMatchingOptions ++ keyOptions
seek :: CommandSeek
seek ps = do
to <- getOptionField toOption Remote.byNameWithUUID
from <- getOptionField fromOption Remote.byNameWithUUID
- withKeyOptions
+ withKeyOptions False
(startKey to from Nothing)
(withFilesInGit $ whenAnnexed $ start to from)
ps
@@ -35,16 +36,13 @@ start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
start to from file = startKey to from (Just file)
startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
-startKey to from afile key = do
- noAuto
+startKey to from afile key =
case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just r) -> mirrorto r
(Just r, Nothing) -> mirrorfrom r
_ -> error "only one of --from or --to can be specified"
where
- noAuto = whenM (Annex.getState Annex.auto) $
- error "--auto is not supported for mirror"
mirrorto r = ifM (inAnnex key)
( Command.Move.toStart r False afile key
, do
diff --git a/Command/Move.hs b/Command/Move.hs
index 5317cefdd..bdc8018ba 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -28,7 +28,7 @@ seek :: CommandSeek
seek ps = do
to <- getOptionField toOption Remote.byNameWithUUID
from <- getOptionField fromOption Remote.byNameWithUUID
- withKeyOptions
+ withKeyOptions False
(startKey to from True)
(withFilesInGit $ whenAnnexed $ start to from True)
ps
@@ -41,15 +41,11 @@ startKey to from move = start' to from move Nothing
start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
start' to from move afile key = do
- noAuto
case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just dest) -> toStart dest move afile key
(Just src, Nothing) -> fromStart src move afile key
_ -> error "only one of --from or --to can be specified"
- where
- noAuto = when move $ whenM (Annex.getState Annex.auto) $ error
- "--auto is not supported for move"
showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
showMoveAction move = showStart' (if move then "move" else "copy")
diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index 5f31998c5..cfcc8f224 100644
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -23,7 +23,7 @@ cmd = [noCommit $ withOptions (jsonOption : annexedMatchingOptions ++ keyOptions
seek :: CommandSeek
seek ps = do
m <- remoteMap id
- withKeyOptions
+ withKeyOptions False
(startKeys m)
(withFilesInGit $ whenAnnexed $ start m)
ps