generalized Annex.Wanted
this should make it easy to use from inside the assistant, where everything is an AssociatedFile.
This commit is contained in:
		
					parent
					
						
							
								acb8721072
							
						
					
				
			
			
				commit
				
					
						fee40dd374
					
				
			
		
					 5 changed files with 28 additions and 33 deletions
				
			
		| 
						 | 
				
			
			@ -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
 | 
			
		||||
				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 the local repository. -}
 | 
			
		||||
wantGet :: AssociatedFile -> Annex Bool
 | 
			
		||||
wantGet Nothing = return True
 | 
			
		||||
wantGet (Just file) = do
 | 
			
		||||
	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.
 | 
			
		||||
 - (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 is preferred content for a remote. -}
 | 
			
		||||
wantSend :: UUID -> AssociatedFile -> Annex Bool
 | 
			
		||||
wantSend _ Nothing = return True
 | 
			
		||||
wantSend to (Just file) = do
 | 
			
		||||
	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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue