add KeyVariety type

Where before the "name" of a key and a backend was a string, this makes
it a concrete data type.

This is groundwork for allowing some varieties of keys to be disabled
in file2key, so git-annex won't use them at all.

Benchmarks ran in my big repo:

old git-annex info:

real	0m3.338s
user	0m3.124s
sys	0m0.244s

new git-annex info:

real	0m3.216s
user	0m3.024s
sys	0m0.220s

new git-annex find:

real	0m7.138s
user	0m6.924s
sys	0m0.252s

old git-annex find:

real	0m7.433s
user	0m7.240s
sys	0m0.232s

Surprising result; I'd have expected it to be slower since it now parses
all the key varieties. But, the parser is very simple and perhaps
sharing KeyVarieties uses less memory or something like that.

This commit was supported by the NSF-funded DataLad project.

6 files changed, 13 insertions, 8 deletions

diff --git a/Command/Find.hs b/Command/Find.hs
index 553ddc419..d3571c6f8 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -13,6 +13,7 @@ import qualified Data.Map as M
 import Command
 import Annex.Content
 import Limit
+import Types.Key
 import qualified Utility.Format
 import Utility.DataUnits
 
@@ -76,7 +77,7 @@ showFormatted format unformatted vars =
 keyVars :: Key -> [(String, String)]
 keyVars key =
 	[ ("key", key2file key)
-	, ("backend", keyBackendName key)
+	, ("backend", formatKeyVariety $ keyVariety key)
 	, ("bytesize", size show)
 	, ("humansize", size $ roughSize storageUnits True)
 	, ("keyname", keyName key)
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 96ffd35da..f1b0b78a6 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -175,7 +175,7 @@ performRemote key afile backend numcopies remote =
 
 startKey :: Maybe Remote -> Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
 startKey from inc key ai numcopies =
-	case Backend.maybeLookupBackendName (keyBackendName key) of
+	case Backend.maybeLookupBackendVariety (keyVariety key) of
 		Nothing -> stop
 		Just backend -> runFsck inc ai key $
 			case from of
diff --git a/Command/Info.hs b/Command/Info.hs
index 9def38838..835a8498d 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -36,6 +36,7 @@ import qualified Git.LsTree as LsTree
 import Utility.Percentage
 import Types.Transfer
 import Logs.Transfer
+import Types.Key
 import Types.TrustLevel
 import Types.FileMatcher
 import qualified Limit
@@ -51,7 +52,7 @@ data KeyData = KeyData
 	{ countKeys :: Integer
 	, sizeKeys :: Integer
 	, unknownSizeKeys :: Integer
-	, backendsKeys :: M.Map String Integer
+	, backendsKeys :: M.Map KeyVariety Integer
 	}
 
 data NumCopiesStats = NumCopiesStats
@@ -451,7 +452,8 @@ disk_size = simpleStat "available local disk space" $
 
 backend_usage :: Stat
 backend_usage = stat "backend usage" $ json fmt $
-	ObjectMap . backendsKeys <$> cachedReferencedData
+	ObjectMap . (M.mapKeys formatKeyVariety) . backendsKeys
+		<$> cachedReferencedData
   where
 	fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . sort . M.toList . fromObjectMap
 
@@ -598,7 +600,7 @@ addKey key (KeyData count size unknownsize backends) =
 	{- All calculations strict to avoid thunks when repeatedly
 	 - applied to many keys. -}
 	!count' = count + 1
-	!backends' = M.insertWith (+) (keyBackendName key) 1 backends
+	!backends' = M.insertWith (+) (keyVariety key) 1 backends
 	!size' = maybe size (+ size) ks
 	!unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks
 	ks = keySize key
diff --git a/Command/Smudge.hs b/Command/Smudge.hs
index cf5272f82..1644ee257 100644
--- a/Command/Smudge.hs
+++ b/Command/Smudge.hs
@@ -84,7 +84,7 @@ clean file = do
 				-- for this file before, so that when
 				-- git re-cleans a file its backend does
 				-- not change.
-				currbackend <- maybe Nothing (maybeLookupBackendName . keyBackendName)
+				currbackend <- maybe Nothing (maybeLookupBackendVariety . keyVariety)
 					<$> catKeyFile file
 				liftIO . emitPointer
 					=<< go
diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index 4c0ff9e3c..78921b856 100644
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -149,7 +149,7 @@ test st r k =
 		Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"
 	present b = check ("present " ++ show b) $
 		(== Right b) <$> Remote.hasKey r k
-	fsck = case maybeLookupBackendName (keyBackendName k) of
+	fsck = case maybeLookupBackendVariety (keyVariety k) of
 		Nothing -> return True
 		Just b -> case Backend.verifyKeyContent b of
 			Nothing -> return True
diff --git a/Command/Version.hs b/Command/Version.hs
index e15f1fb91..ece5fbb05 100644
--- a/Command/Version.hs
+++ b/Command/Version.hs
@@ -11,6 +11,7 @@ import Command
 import qualified Build.SysConfig as SysConfig
 import Annex.Version
 import BuildFlags
+import Types.Key
 import qualified Types.Backend as B
 import qualified Types.Remote as R
 import qualified Remote
@@ -62,7 +63,8 @@ showPackageVersion :: IO ()
 showPackageVersion = do
 	vinfo "git-annex version" SysConfig.packageversion
 	vinfo "build flags" $ unwords buildFlags
-	vinfo "key/value backends" $ unwords $ map B.name Backend.list
+	vinfo "key/value backends" $ unwords $
+		map (formatKeyVariety . B.backendVariety) Backend.list
 	vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes
 
 showRawVersion :: IO ()