diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-08 16:06:56 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-08 16:06:56 -0400 |
commit | 84a60358dfca930409622732aa023e6e00322319 (patch) | |
tree | fc9e8d53a5180ee67bb01ac6872b445f8cd55357 | |
parent | 98612f75ffee93be2973fd444948314dd1b7f822 (diff) |
make copy --to check preferred content of the remote
-rw-r--r-- | Annex/Wanted.hs | 50 | ||||
-rw-r--r-- | Command.hs | 11 | ||||
-rw-r--r-- | Command/Copy.hs | 13 | ||||
-rw-r--r-- | Command/Drop.hs | 35 | ||||
-rw-r--r-- | Command/Get.hs | 3 |
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 |