numcopies cleanup, part 2

This includes several bug fixes.

Annex.hs

@@ -96,6 +96,7 @@ data AnnexState = AnnexState
 	, checkignorehandle :: Maybe (Maybe CheckIgnoreHandle)
 	, forcebackend :: Maybe String
 	, globalnumcopies :: Maybe NumCopies
+	, forcenumcopies :: Maybe NumCopies
 	, limit :: Matcher (MatchInfo -> Annex Bool)
 	, uuidmap :: Maybe UUIDMap
 	, preferredcontentmap :: Maybe PreferredContentMap
@@ -131,6 +132,7 @@ newState c r = AnnexState
 	, checkignorehandle = Nothing
 	, forcebackend = Nothing
 	, globalnumcopies = Nothing
+	, forcenumcopies = Nothing
 	, limit = Left []
 	, uuidmap = Nothing
 	, preferredcontentmap = Nothing

Annex/Drop.hs

@@ -60,8 +60,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn
   where
 	getcopies fs = do
 		(untrusted, have) <- trustPartition UnTrusted locs
-		numcopies <- maximum
+		numcopies <- maximum <$> mapM getFileNumCopies fs
-			<$> mapM (getNumCopies <=< getFileNumCopies) fs
 		return (NumCopies (length have), numcopies, S.fromList untrusted)
 
 	{- Check that we have enough copies still to drop the content.
@@ -88,7 +87,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn
 
 	checkdrop fs n@(have, numcopies, _untrusted) u a =
 		ifM (allM (wantDrop True u . Just) fs)
-			( ifM (safely $ runner $ a (Just numcopies))
+			( ifM (safely $ runner $ a numcopies)
 				( do
 					liftIO $ debugM "drop" $ unwords
 						[ "dropped"

Assistant/WebApp/Configurators/Preferences.hs

@@ -82,7 +82,7 @@ prefsAForm def = PrefsForm
 getPrefs :: Annex PrefsForm
 getPrefs = PrefsForm
 	<$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig)
-	<*> (fromNumCopies <$> (maybe deprecatedNumCopies return =<< getGlobalNumCopies))
+	<*> (fromNumCopies <$> getNumCopies)
 	<*> inAutoStartFile
 	<*> (annexAutoUpgrade <$> Annex.getGitConfig)
 	<*> (annexDebug <$> Annex.getGitConfig)

Command/Drop.hs

@@ -43,17 +43,17 @@ start from file (key, _) = checkDropAuto from file key $ \numcopies ->
 					then startLocal (Just file) numcopies key Nothing
 					else startRemote (Just file) numcopies key remote
 
-startLocal :: AssociatedFile -> Maybe NumCopies -> Key -> Maybe Remote -> CommandStart
+startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
 startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
 	showStart "drop" (fromMaybe (key2file key) afile)
 	next $ performLocal key numcopies knownpresentremote
 
-startRemote :: AssociatedFile -> Maybe NumCopies -> Key -> Remote -> CommandStart
+startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart
 startRemote afile numcopies key remote = do
 	showStart ("drop " ++ Remote.name remote) (fromMaybe (key2file key) afile)
 	next $ performRemote key numcopies remote
 
-performLocal :: Key -> Maybe NumCopies -> Maybe Remote -> CommandPerform
+performLocal :: Key -> NumCopies -> Maybe Remote -> CommandPerform
 performLocal key numcopies knownpresentremote = lockContent key $ do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
 	let trusteduuids' = case knownpresentremote of
@@ -65,7 +65,7 @@ performLocal key numcopies knownpresentremote = lockContent key $ do
 		removeAnnex key
 		next $ cleanupLocal key
 
-performRemote :: Key -> Maybe NumCopies -> Remote -> CommandPerform
+performRemote :: Key -> NumCopies -> Remote -> CommandPerform
 performRemote key numcopies remote = lockContent key $ do
 	-- Filter the remote it's being dropped from out of the lists of
 	-- places assumed to have the key, and places to check.
@@ -98,14 +98,12 @@ cleanupRemote key remote ok = do
 {- Checks specified remotes to verify that enough copies of a key exist to
  - allow it to be safely removed (with no data loss). Can be provided with
  - some locations where the key is known/assumed to be present. -}
-canDropKey :: Key -> Maybe NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
+canDropKey :: Key -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
-canDropKey key numcopiesM have check skip = do
+canDropKey key numcopies have check skip = do
 	force <- Annex.getState Annex.force
-	if force || numcopiesM == Just (NumCopies 0)
+	if force || numcopies == NumCopies 0
 		then return True
-		else do
+		else findCopies key numcopies skip have check
-			need <- getNumCopies numcopiesM
-			findCopies key need skip have check
 
 findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
 findCopies key need skip = helper [] []
@@ -142,22 +140,18 @@ notEnoughCopies key need have skip bad = do
 	hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"
 
 {- In auto mode, only runs the action if there are enough
- - copies on other semitrusted repositories.
+ - copies on other semitrusted repositories. -}
- -
+checkDropAuto :: Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart
- - Passes any numcopies attribute of the file on to the action as an
- - optimisation. -}
-checkDropAuto :: Maybe Remote -> FilePath -> Key -> (Maybe NumCopies -> CommandStart) -> CommandStart
 checkDropAuto mremote file key a = do
-	numcopiesattr <- getFileNumCopies file
+	numcopies <- getFileNumCopies file
-	Annex.getState Annex.auto >>= auto numcopiesattr
+	Annex.getState Annex.auto >>= auto numcopies
   where
-	auto numcopiesattr False = a numcopiesattr
+	auto numcopies False = a numcopies
-	auto numcopiesattr True = do
+	auto numcopies True = do
-		needed <- getNumCopies numcopiesattr
 		locs <- Remote.keyLocations key
 		uuid <- getUUID
 		let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote
 		locs' <- trustExclude UnTrusted $ filter (/= remoteuuid) locs
-		if NumCopies (length locs') >= needed
+		if NumCopies (length locs') >= numcopies
-			then a numcopiesattr
+			then a numcopies
 			else stop

Command/DropUnused.hs

@@ -15,6 +15,7 @@ import qualified Remote
 import qualified Git
 import qualified Option
 import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
+import Logs.NumCopies
 
 def :: [Command]
 def = [withOptions [Command.Drop.fromOption] $
@@ -22,18 +23,20 @@ def = [withOptions [Command.Drop.fromOption] $
 		seek SectionMaintenance "drop unused file content"]
 
 seek :: CommandSeek
-seek = withUnusedMaps start
+seek ps = do
+	numcopies <- getNumCopies
+	withUnusedMaps (start numcopies) ps
 
-start :: UnusedMaps -> Int -> CommandStart
+start :: NumCopies -> UnusedMaps -> Int -> CommandStart
-start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation)
+start numcopies = startUnused "dropunused" (perform numcopies) (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation)
 
-perform :: Key -> CommandPerform
+perform :: NumCopies -> Key -> CommandPerform
-perform key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from
+perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<< from
   where
 	dropremote r = do
 		showAction $ "from " ++ Remote.name r
-		Command.Drop.performRemote key Nothing r
+		Command.Drop.performRemote key numcopies r
-	droplocal = Command.Drop.performLocal key Nothing Nothing
+	droplocal = Command.Drop.performLocal key numcopies Nothing
 	from = Annex.getField $ Option.name Command.Drop.fromOption
 
 performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform

Command/Fsck.hs

@@ -119,7 +119,7 @@ start from inc file (key, backend) = do
   where
 	go = runFsck inc file key
 
-perform :: Key -> FilePath -> Backend -> Maybe NumCopies -> Annex Bool
+perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool
 perform key file backend numcopies = check
 	-- order matters
 	[ fixLink key file
@@ -133,7 +133,7 @@ perform key file backend numcopies = check
 
 {- To fsck a remote, the content is retrieved to a tmp file,
  - and checked locally. -}
-performRemote :: Key -> FilePath -> Backend -> Maybe NumCopies -> Remote -> Annex Bool
+performRemote :: Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool
 performRemote key file backend numcopies remote =
 	dispatch =<< Remote.hasKey remote key
   where
@@ -369,15 +369,14 @@ checkBackendOr' bad backend key file postcheck =
 				, return True
 				)
 
-checkKeyNumCopies :: Key -> FilePath -> Maybe NumCopies -> Annex Bool
+checkKeyNumCopies :: Key -> FilePath -> NumCopies -> Annex Bool
 checkKeyNumCopies key file numcopies = do
-	needed <- getNumCopies numcopies
 	(untrustedlocations, safelocations) <- trustPartition UnTrusted =<< Remote.keyLocations key
 	let present = NumCopies (length safelocations)
-	if present < needed
+	if present < numcopies
 		then do
 			ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations
-			warning $ missingNote file present needed ppuuids
+			warning $ missingNote file present numcopies ppuuids
 			return False
 		else return True
 

Command/Mirror.hs

@@ -28,17 +28,15 @@ seek ps = do
 	to <- getOptionField toOption Remote.byNameWithUUID
 	from <- getOptionField fromOption Remote.byNameWithUUID
 	withKeyOptions
-		(startKey Nothing to from Nothing)
+		(startKey to from Nothing)
 		(withFilesInGit $ whenAnnexed $ start to from)
 		ps
 
 start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start to from file (key, _backend) = do
+start to from file (key, _backend) = startKey to from (Just file) key
-	numcopies <- getFileNumCopies file
-	startKey numcopies to from (Just file) key
 
-startKey :: Maybe NumCopies -> Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
+startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
-startKey numcopies to from afile key = do
+startKey to from afile key = do
 	noAuto
 	case (from, to) of
 		(Nothing, Nothing) -> error "specify either --from or --to"
@@ -50,7 +48,9 @@ startKey numcopies to from afile key = do
 		error "--auto is not supported for mirror"
 	mirrorto r = ifM (inAnnex key)
 		( Command.Move.toStart r False afile key
-		, Command.Drop.startRemote afile numcopies key r
+		, do
+			numcopies <- getnumcopies
+			Command.Drop.startRemote afile numcopies key r
 		)
 	mirrorfrom r = do
 		haskey <- Remote.hasKey r key
@@ -58,6 +58,9 @@ startKey numcopies to from afile key = do
 			Left _ -> stop
 			Right True -> Command.Get.start' (return True) Nothing key afile
 			Right False -> ifM (inAnnex key)
-				( Command.Drop.startLocal afile numcopies key Nothing
+				( do
+					numcopies <- getnumcopies
+					Command.Drop.startLocal afile numcopies key Nothing
 				, stop
 				)
+	getnumcopies = maybe getNumCopies getFileNumCopies afile

Command/NumCopies.hs

@@ -42,10 +42,10 @@ startGet = next $ next $ do
 		Just n -> liftIO $ putStrLn $ show $ fromNumCopies n
 		Nothing -> do
 			liftIO $ putStrLn $ "global numcopies is not set"
-			old <- annexNumCopies <$> Annex.getGitConfig
+			old <- deprecatedNumCopies
 			case old of
 				Nothing -> liftIO $ putStrLn "(default is 1)"
-				Just n -> liftIO $ putStrLn $ "(deprecated git config annex.numcopies is set to " ++ show n ++ " locally)"
+				Just n -> liftIO $ putStrLn $ "(deprecated git config annex.numcopies is set to " ++ show (fromNumCopies n) ++ " locally)"
 	return True
 
 startSet :: Int -> CommandStart

GitAnnex/Options.hs

@@ -66,7 +66,7 @@ options = Option.common ++
   where
 	trustArg t = ReqArg (Remote.forceTrust t) paramRemote
 	setnumcopies v = maybe noop
-		(\n -> Annex.changeState $ \s -> s { Annex.globalnumcopies = Just $ NumCopies n })
+		(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n })
 		(readish v)
 	setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
 	setgitconfig v = inRepo (Git.Config.store v)

Logs/NumCopies.hs

@@ -13,9 +13,11 @@ module Logs.NumCopies (
 	getGlobalNumCopies,
 	globalNumCopiesLoad,
 	getFileNumCopies,
-	numCopiesCheck,
+	getGlobalFileNumCopies,
 	getNumCopies,
+	numCopiesCheck,
 	deprecatedNumCopies,
+	defaultNumCopies
 ) where
 
 import Common.Annex
@@ -34,7 +36,7 @@ instance SingleValueSerializable NumCopies where
 setGlobalNumCopies :: NumCopies -> Annex ()
 setGlobalNumCopies = setLog numcopiesLog
 
-{- Cached for speed. -}
+{- Value configured in the numcopies log. Cached for speed. -}
 getGlobalNumCopies :: Annex (Maybe NumCopies)
 getGlobalNumCopies = maybe globalNumCopiesLoad (return . Just)
 	=<< Annex.getState Annex.globalnumcopies
@@ -45,33 +47,57 @@ globalNumCopiesLoad = do
 	Annex.changeState $ \s -> s { Annex.globalnumcopies = v }
 	return v
 
-{- Numcopies value for a file, from .gitattributes or global,
+defaultNumCopies :: NumCopies
- - but not the deprecated git config. -}
+defaultNumCopies = NumCopies 1
-getFileNumCopies :: FilePath  -> Annex (Maybe NumCopies)
-getFileNumCopies file = do
-	global <- getGlobalNumCopies
-	case global of
-		Just n -> return $ Just n
-		Nothing -> (NumCopies <$$> readish)
-			<$> checkAttr "annex.numcopies" file
 
-deprecatedNumCopies :: Annex NumCopies
+fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies
-deprecatedNumCopies = NumCopies . fromMaybe 1 . annexNumCopies
+fromSources = fromMaybe defaultNumCopies <$$> getM id
-	<$> Annex.getGitConfig
 
-{- Checks if numcopies are satisfied by running a comparison
+{- The git config annex.numcopies is deprecated. -}
+deprecatedNumCopies :: Annex (Maybe NumCopies)
+deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig
+
+{- Value forced on the command line by --numcopies. -}
+getForcedNumCopies :: Annex (Maybe NumCopies)
+getForcedNumCopies = Annex.getState Annex.forcenumcopies
+
+{- Numcopies value from any of the non-.gitattributes configuration
+ - sources. -}
+getNumCopies :: Annex NumCopies
+getNumCopies = fromSources
+	[ getForcedNumCopies
+	, getGlobalNumCopies
+	, deprecatedNumCopies
+	]
+
+{- Numcopies value for a file, from any configuration source, including the
+ - deprecated git config. -}
+getFileNumCopies :: FilePath -> Annex NumCopies
+getFileNumCopies f = fromSources
+	[ getForcedNumCopies
+	, getFileNumCopies' f
+	, deprecatedNumCopies
+	]
+
+{- This is the globally visible numcopies value for a file. So it does
+ - not include local configuration in the git config or command line
+ - options. -}
+getGlobalFileNumCopies :: FilePath  -> Annex NumCopies
+getGlobalFileNumCopies f = fromSources
+	[ getFileNumCopies' f
+	]
+
+getFileNumCopies' :: FilePath  -> Annex (Maybe NumCopies)
+getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr
+  where
+	getattr = (NumCopies <$$> readish)
+		<$> checkAttr "annex.numcopies" file
+
+{- Checks if numcopies are satisfied for a file by running a comparison
  - between the number of (not untrusted) copies that are
- - belived to exist, and the configured value.
+ - belived to exist, and the configured value. -}
- -
- - Includes the deprecated annex.numcopies git config if
- - nothing else specifies a numcopies value. -}
 numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
 numCopiesCheck file key vs = do
-	numcopiesattr <- getFileNumCopies file
+	NumCopies needed <- getFileNumCopies file
-	NumCopies needed <- getNumCopies numcopiesattr
 	have <- trustExclude UnTrusted =<< Remote.keyLocations key
 	return $ length have `vs` needed
-
-getNumCopies :: Maybe NumCopies -> Annex NumCopies
-getNumCopies (Just v) = return v
-getNumCopies Nothing = deprecatedNumCopies

Types/GitConfig.hs

@@ -19,12 +19,13 @@ import Utility.DataUnits
 import Config.Cost
 import Types.Distribution
 import Types.Availability
+import Types.NumCopies
 
 {- Main git-annex settings. Each setting corresponds to a git-config key
  - such as annex.foo -}
 data GitConfig = GitConfig
 	{ annexVersion :: Maybe String
-	, annexNumCopies :: Maybe Int
+	, annexNumCopies :: Maybe NumCopies
 	, annexDiskReserve :: Integer
 	, annexDirect :: Bool
 	, annexBackends :: [String]
@@ -52,7 +53,7 @@ data GitConfig = GitConfig
 extractGitConfig :: Git.Repo -> GitConfig
 extractGitConfig r = GitConfig
 	{ annexVersion = notempty $ getmaybe (annex "version")
-	, annexNumCopies = getmayberead (annex "numcopies")
+	, annexNumCopies = NumCopies <$> getmayberead (annex "numcopies")
 	, annexDiskReserve = fromMaybe onemegabyte $
 		readSize dataUnits =<< getmaybe (annex "diskreserve")
 	, annexDirect = getbool (annex "direct") False