generalized Annex.Wanted

this should make it easy to use from inside the assistant, where
everything is an AssociatedFile.
This commit is contained in:
Joey Hess 2012-10-08 17:14:01 -04:00
parent acb8721072
commit fee40dd374
5 changed files with 28 additions and 33 deletions

View file

@ -8,43 +8,33 @@
module Annex.Wanted where module Annex.Wanted where
import Common.Annex import Common.Annex
import qualified Remote
import Annex.Content
import Logs.PreferredContent import Logs.PreferredContent
import Git.FilePath import Git.FilePath
import qualified Annex import qualified Annex
import Annex.UUID import Annex.UUID
import Types.Remote
import qualified Data.Set as S import qualified Data.Set as S
checkAuto :: (Bool -> Annex Bool) -> Annex Bool {- Check if a file is preferred content for the local repository. -}
checkAuto a = Annex.getState Annex.auto >>= a wantGet :: AssociatedFile -> Annex Bool
wantGet Nothing = return True
{- A file's content should be gotten if it's not already present. wantGet (Just file) = do
- 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 fp <- inRepo $ toTopFilePath file
isPreferredContent (Just $ Remote.uuid to) S.empty fp isPreferredContent Nothing S.empty fp
{- A file's content should be dropped normally. {- Check if a file is preferred content for a remote. -}
- (This does not check numcopies though.) wantSend :: UUID -> AssociatedFile -> Annex Bool
- In auto mode, hold on to preferred content. -} wantSend _ Nothing = return True
shouldDrop :: Maybe Remote -> FilePath -> Bool -> Annex Bool wantSend to (Just file) = do
shouldDrop _ _ False = return True
shouldDrop from file True = do
fp <- inRepo $ toTopFilePath file fp <- inRepo $ toTopFilePath file
u <- maybe getUUID (return . Remote.uuid) from isPreferredContent (Just to) S.empty fp
{- Check if a file can be dropped, maybe from a remote.
- Don't drop files that are preferred content. -}
wantDrop :: Maybe UUID -> AssociatedFile -> Annex Bool
wantDrop _ Nothing = return True
wantDrop from (Just file) = do
fp <- inRepo $ toTopFilePath file
u <- maybe getUUID (return . id) from
not <$> isPreferredContent (Just u) (S.singleton u) fp not <$> isPreferredContent (Just u) (S.singleton u) fp

View file

@ -22,6 +22,7 @@ module Command (
numCopies, numCopies,
autoCopies, autoCopies,
autoCopiesWith, autoCopiesWith,
checkAuto,
module ReExported module ReExported
) where ) where
@ -137,3 +138,7 @@ autoCopiesWith file key vs a = do
if length have `vs` needed if length have `vs` needed
then a numcopiesattr then a numcopiesattr
else stop else stop
checkAuto :: Annex Bool -> Annex Bool
checkAuto checker = ifM (Annex.getState Annex.auto)
( checker , return True )

View file

@ -31,5 +31,5 @@ start to from file (key, backend) = autoCopies file key (<) $
Command.Move.start to from False file (key, backend) Command.Move.start to from False file (key, backend)
where where
shouldCopy = case to of shouldCopy = case to of
Nothing -> checkAuto $ shouldGet file key Nothing -> checkAuto $ wantGet (Just file)
Just r -> checkAuto $ shouldSend r file Just r -> checkAuto $ wantSend (Remote.uuid r) (Just file)

View file

@ -32,7 +32,7 @@ seek = [withField fromOption Remote.byName $ \from ->
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = autoCopiesWith file key (>) $ \numcopies -> start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
stopUnless (checkAuto $ shouldDrop from file) $ stopUnless (checkAuto $ wantDrop (Remote.uuid <$> from) (Just file)) $
case from of case from of
Nothing -> startLocal file numcopies key Nothing -> startLocal file numcopies key
Just remote -> do Just remote -> do

View file

@ -24,7 +24,7 @@ seek = [withField Command.Move.fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start from] withFilesInGit $ whenAnnexed $ start from]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = stopUnless (checkAuto $ shouldGet file key) $ start from file (key, _) = stopUnless ((not <$> inAnnex key) <&&> checkAuto (wantGet $ Just file)) $
autoCopies file key (<) $ autoCopies file key (<) $
case from of case from of
Nothing -> go $ perform key file Nothing -> go $ perform key file