From 2f868db90c7ba16eee901b9b1472b1e1a889dd93 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 24 Feb 2017 15:16:56 -0400
Subject: 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.
---
 Backend.hs | 44 +++++++++++++++++++++++---------------------
 1 file changed, 23 insertions(+), 21 deletions(-)

(limited to 'Backend.hs')

diff --git a/Backend.hs b/Backend.hs
index f7bbed6b5..40b618355 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -1,6 +1,6 @@
 {- git-annex key/value backends
  -
- - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,14 +11,15 @@ module Backend (
 	genKey,
 	getBackend,
 	chooseBackend,
-	lookupBackendName,
-	maybeLookupBackendName,
+	lookupBackendVariety,
+	maybeLookupBackendVariety,
 	isStableKey,
 ) where
 
 import Annex.Common
 import qualified Annex
 import Annex.CheckAttr
+import Types.Key
 import Types.KeySource
 import qualified Types.Backend as B
 
@@ -42,14 +43,15 @@ orderedList = do
 			f <- Annex.getState Annex.forcebackend
 			case f of
 				Just name | not (null name) ->
-					return [lookupBackendName name]
+					return [lookupname name]
 				_ -> do
 					l' <- gen . annexBackends <$> Annex.getGitConfig
 					Annex.changeState $ \s -> s { Annex.backends = l' }
 					return l'
   where
 	gen [] = list
-	gen l = map lookupBackendName l
+	gen ns = map lookupname ns
+	lookupname = lookupBackendVariety . parseKeyVariety
 
 {- Generates a key for a file, trying each backend in turn until one
  - accepts it. -}
@@ -73,33 +75,33 @@ genKey' (b:bs) source = do
 		| otherwise = c
 
 getBackend :: FilePath -> Key -> Annex (Maybe Backend)
-getBackend file k = let bname = keyBackendName k in
-	case maybeLookupBackendName bname of
-		Just backend -> return $ Just backend
-		Nothing -> do
-			warning $ "skipping " ++ file ++ " (unknown backend " ++ bname ++ ")"
-			return Nothing
+getBackend file k = case maybeLookupBackendVariety (keyVariety k) of
+	Just backend -> return $ Just backend
+	Nothing -> do
+		warning $ "skipping " ++ file ++ " (unknown backend " ++ formatKeyVariety (keyVariety k) ++ ")"
+		return Nothing
 
 {- Looks up the backend that should be used for a file.
  - That can be configured on a per-file basis in the gitattributes file. -}
 chooseBackend :: FilePath -> Annex (Maybe Backend)
 chooseBackend f = Annex.getState Annex.forcebackend >>= go
   where
-	go Nothing =  maybeLookupBackendName <$> checkAttr "annex.backend" f
+	go Nothing =  maybeLookupBackendVariety . parseKeyVariety
+		<$> checkAttr "annex.backend" f
 	go (Just _) = Just . Prelude.head <$> orderedList
 
-{- Looks up a backend by name. May fail if unknown. -}
-lookupBackendName :: String -> Backend
-lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s
+{- Looks up a backend by variety. May fail if unsupported or disabled. -}
+lookupBackendVariety :: KeyVariety -> Backend
+lookupBackendVariety v = fromMaybe unknown $ maybeLookupBackendVariety v
   where
-	unknown = error $ "unknown backend " ++ s
+	unknown = error $ "unknown backend " ++ formatKeyVariety v
 
-maybeLookupBackendName :: String -> Maybe Backend
-maybeLookupBackendName s = M.lookup s nameMap
+maybeLookupBackendVariety :: KeyVariety -> Maybe Backend
+maybeLookupBackendVariety v = M.lookup v varietyMap
 
-nameMap :: M.Map String Backend
-nameMap = M.fromList $ zip (map B.name list) list
+varietyMap :: M.Map KeyVariety Backend
+varietyMap = M.fromList $ zip (map B.backendVariety list) list
 
 isStableKey :: Key -> Bool
 isStableKey k = maybe False (`B.isStableKey` k) 
-	(maybeLookupBackendName (keyBackendName k))
+	(maybeLookupBackendVariety (keyVariety k))
-- 
cgit v1.2.3