summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-08 16:06:56 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-08 16:06:56 -0400
commit84a60358dfca930409622732aa023e6e00322319 (patch)
treefc9e8d53a5180ee67bb01ac6872b445f8cd55357
parent98612f75ffee93be2973fd444948314dd1b7f822 (diff)
make copy --to check preferred content of the remote
-rw-r--r--Annex/Wanted.hs50
-rw-r--r--Command.hs11
-rw-r--r--Command/Copy.hs13
-rw-r--r--Command/Drop.hs35
-rw-r--r--Command/Get.hs3
5 files changed, 73 insertions, 39 deletions
diff --git a/Annex/Wanted.hs b/Annex/Wanted.hs
new file mode 100644
index 000000000..a92b1036f
--- /dev/null
+++ b/Annex/Wanted.hs
@@ -0,0 +1,50 @@
+{- git-annex control over whether content is wanted
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.Wanted where
+
+import Common.Annex
+import qualified Remote
+import Annex.Content
+import Logs.PreferredContent
+import Git.FilePath
+import qualified Annex
+import Annex.UUID
+
+import qualified Data.Set as S
+
+checkAuto :: (Bool -> Annex Bool) -> Annex Bool
+checkAuto a = Annex.getState Annex.auto >>= a
+
+{- A file's content should be gotten if it's not already present.
+ - In auto mode, only get files that are preferred content. -}
+shouldGet :: FilePath -> Key -> Bool -> Annex Bool
+shouldGet file key auto = (not <$> inAnnex key) <&&> want
+ where
+ want
+ | auto = do
+ fp <- inRepo $ toTopFilePath file
+ isPreferredContent Nothing S.empty fp
+ | otherwise = return True
+
+{- A file's content should be sent to a remote.
+ - In auto mode, only send files that are preferred content of the remote. -}
+shouldSend :: Remote -> FilePath -> Bool -> Annex Bool
+shouldSend _ _ False = return True
+shouldSend to file True = do
+ fp <- inRepo $ toTopFilePath file
+ isPreferredContent (Just $ Remote.uuid to) S.empty fp
+
+{- A file's content should be dropped normally.
+ - (This does not check numcopies though.)
+ - In auto mode, hold on to preferred content. -}
+shouldDrop :: Maybe Remote -> FilePath -> Bool -> Annex Bool
+shouldDrop _ _ False = return True
+shouldDrop from file True = do
+ fp <- inRepo $ toTopFilePath file
+ u <- maybe getUUID (return . Remote.uuid) from
+ isPreferredContent (Just u) (S.singleton u) fp
diff --git a/Command.hs b/Command.hs
index 55892225b..f2b95aa4c 100644
--- a/Command.hs
+++ b/Command.hs
@@ -38,10 +38,6 @@ import Usage as ReExported
import Logs.Trust
import Config
import Annex.CheckAttr
-import Logs.PreferredContent
-import Git.FilePath
-
-import qualified Data.Set as S
{- Generates a normal command -}
command :: String -> String -> [CommandSeek] -> String -> Command
@@ -127,12 +123,7 @@ autoCopies file key vs a = Annex.getState Annex.auto >>= go
numcopiesattr <- numCopies file
needed <- getNumCopies numcopiesattr
(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
- if length have `vs` needed
- then do
- fp <- inRepo $ toTopFilePath file
- ifM (isPreferredContent Nothing S.empty fp)
- ( a, stop )
- else stop
+ if length have `vs` needed then a else stop
autoCopiesWith :: FilePath -> Key -> (Int -> Int -> Bool) -> (Maybe Int -> CommandStart) -> CommandStart
autoCopiesWith file key vs a = do
diff --git a/Command/Copy.hs b/Command/Copy.hs
index 5d92eef2e..c8a2d7efc 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -11,6 +11,7 @@ import Common.Annex
import Command
import qualified Command.Move
import qualified Remote
+import Annex.Wanted
def :: [Command]
def = [withOptions Command.Move.options $ command "copy" paramPaths seek
@@ -21,8 +22,14 @@ seek = [withField Command.Move.toOption Remote.byName $ \to ->
withField Command.Move.fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start to from]
--- A copy is just a move that does not delete the source file.
--- However, --auto mode avoids unnecessary copies.
+{- A copy is just a move that does not delete the source file.
+ - However, --auto mode avoids unnecessary copies, and avoids getting or
+ - sending non-preferred content. -}
start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start to from file (key, backend) = autoCopies file key (<) $
- Command.Move.start to from False file (key, backend)
+ stopUnless shouldCopy $
+ Command.Move.start to from False file (key, backend)
+ where
+ shouldCopy = case to of
+ Nothing -> checkAuto $ shouldGet file key
+ Just r -> checkAuto $ shouldSend r file
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 9640d2804..3fe5ab20a 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -17,10 +17,7 @@ import Logs.Trust
import Annex.Content
import Config
import qualified Option
-import Git.FilePath
-import Logs.PreferredContent
-
-import qualified Data.Set as S
+import Annex.Wanted
def :: [Command]
def = [withOptions [fromOption] $ command "drop" paramPaths seek
@@ -34,27 +31,15 @@ seek = [withField fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start from]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start from file (key, _) = shouldDrop $ \numcopies ->
- case from of
- Nothing -> startLocal file numcopies key
- Just remote -> do
- u <- getUUID
- if Remote.uuid remote == u
- then startLocal file numcopies key
- else startRemote file numcopies key remote
- where
- {- In --auto mode, drop if there are enough copies,
- - and the repository being dropped from doesn't prefer
- - to keep the content. -}
- shouldDrop a = autoCopiesWith file key (>) $ \numcopies ->
- ifM (Annex.getState Annex.auto)
- ( do
- fp <- inRepo $ toTopFilePath file
- u <- maybe getUUID (return . Remote.uuid) from
- ifM (isPreferredContent (Just u) (S.singleton u) fp)
- ( a numcopies, stop )
- , a numcopies
- )
+start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
+ stopUnless (checkAuto $ shouldDrop from file) $
+ case from of
+ Nothing -> startLocal file numcopies key
+ Just remote -> do
+ u <- getUUID
+ if Remote.uuid remote == u
+ then startLocal file numcopies key
+ else startRemote file numcopies key remote
startLocal :: FilePath -> Maybe Int -> Key -> CommandStart
startLocal file numcopies key = stopUnless (inAnnex key) $ do
diff --git a/Command/Get.hs b/Command/Get.hs
index ab0e60b41..10b74bfc7 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -13,6 +13,7 @@ import qualified Remote
import Annex.Content
import qualified Command.Move
import Logs.Transfer
+import Annex.Wanted
def :: [Command]
def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
@@ -23,7 +24,7 @@ seek = [withField Command.Move.fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start from]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start from file (key, _) = stopUnless (not <$> inAnnex key) $
+start from file (key, _) = stopUnless (checkAuto $ shouldGet file key) $
autoCopies file key (<) $
case from of
Nothing -> go $ perform key file