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
import Common.Annex
import qualified Remote
import Annex.Content
import Logs.PreferredContent
import Git.FilePath
import qualified Annex
import Annex.UUID
import Types.Remote
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
{- Check if a file is preferred content for the local repository. -}
wantGet :: AssociatedFile -> Annex Bool
wantGet Nothing = return True
wantGet (Just file) = 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
{- Check if a file is preferred content for a remote. -}
wantSend :: UUID -> AssociatedFile -> Annex Bool
wantSend _ Nothing = return True
wantSend to (Just file) = do
fp <- inRepo $ toTopFilePath file
isPreferredContent (Just $ Remote.uuid to) S.empty fp
isPreferredContent (Just 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
{- 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 . Remote.uuid) from
u <- maybe getUUID (return . id) from
not <$> isPreferredContent (Just u) (S.singleton u) fp

View file

@ -22,6 +22,7 @@ module Command (
numCopies,
autoCopies,
autoCopiesWith,
checkAuto,
module ReExported
) where
@ -137,3 +138,7 @@ autoCopiesWith file key vs a = do
if length have `vs` needed
then a numcopiesattr
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)
where
shouldCopy = case to of
Nothing -> checkAuto $ shouldGet file key
Just r -> checkAuto $ shouldSend r file
Nothing -> checkAuto $ wantGet (Just 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 from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
stopUnless (checkAuto $ shouldDrop from file) $
stopUnless (checkAuto $ wantDrop (Remote.uuid <$> from) (Just file)) $
case from of
Nothing -> startLocal file numcopies key
Just remote -> do

View file

@ -24,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 (checkAuto $ shouldGet file key) $
start from file (key, _) = stopUnless ((not <$> inAnnex key) <&&> checkAuto (wantGet $ Just file)) $
autoCopies file key (<) $
case from of
Nothing -> go $ perform key file