parameterize Backend type

This allows the Backend type to not depend on the Annex type, and
so the Annex type can later be moved out of TypeInternals.

14 files changed, 43 insertions, 41 deletions

diff --git a/Annex.hs b/Annex.hs
index 765c9191f..a0de63087 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -33,14 +33,15 @@ import Types
 import qualified TypeInternals as Internals
 
 {- Create and returns an Annex state object for the specified git repo. -}
-new :: Git.Repo -> [Backend] -> IO AnnexState
+new :: Git.Repo -> [Backend Annex] -> IO AnnexState
 new gitrepo allbackends = do
 	let s = Internals.AnnexState {
 		Internals.repo = gitrepo,
 		Internals.backends = [],
 		Internals.supportedBackends = allbackends,
 		Internals.flags = M.empty,
-		Internals.repoqueue = GitQueue.empty
+		Internals.repoqueue = GitQueue.empty,
+		Internals.quiet = False
 	}
 	(_,s') <- Annex.run s prep
 	return s'
@@ -69,19 +70,19 @@ gitRepoChange r = do
 	put state { Internals.repo = r }
 
 {- Returns the backends being used. -}
-backends :: Annex [Backend]
+backends :: Annex [Backend Annex]
 backends = do
 	state <- get
 	return (Internals.backends state)
 
 {- Sets the backends to use. -}
-backendsChange :: [Backend] -> Annex ()
+backendsChange :: [Backend Annex] -> Annex ()
 backendsChange b = do
 	state <- get
 	put state { Internals.backends = b }
 
 {- Returns the full list of supported backends. -}
-supportedBackends :: Annex [Backend]
+supportedBackends :: Annex [Backend Annex]
 supportedBackends = do
 	state <- get
 	return (Internals.supportedBackends state)
diff --git a/Backend.hs b/Backend.hs
index a417c7247..caf50005a 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -42,7 +42,7 @@ import qualified TypeInternals as Internals
 import Messages
 
 {- List of backends in the order to try them when storing a new key. -}
-list :: Annex [Backend]
+list :: Annex [Backend Annex]
 list = do
 	l <- Annex.backends -- list is cached here
 	if not $ null l
@@ -64,12 +64,12 @@ list = do
 				else map (lookupBackendName bs) $ words s
 
 {- Looks up a backend in a list. May fail if unknown. -}
-lookupBackendName :: [Backend] -> String -> Backend
+lookupBackendName :: [Backend Annex] -> String -> Backend Annex
 lookupBackendName bs s =
 	case maybeLookupBackendName bs s of
 		Just b -> b
 		Nothing -> error $ "unknown backend " ++ s
-maybeLookupBackendName :: [Backend] -> String -> Maybe Backend
+maybeLookupBackendName :: [Backend Annex] -> String -> Maybe (Backend Annex)
 maybeLookupBackendName bs s =
 	if 1 /= length matches
 		then Nothing
@@ -77,14 +77,14 @@ maybeLookupBackendName bs s =
 	where matches = filter (\b -> s == Internals.name b) bs
 
 {- Attempts to store a file in one of the backends. -}
-storeFileKey :: FilePath -> Maybe Backend -> Annex (Maybe (Key, Backend))
+storeFileKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
 storeFileKey file trybackend = do
 	bs <- list
 	let bs' = case trybackend of
 		Nothing -> bs
 		Just backend -> backend:bs
 	storeFileKey' bs' file
-storeFileKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend))
+storeFileKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
 storeFileKey' [] _ = return Nothing
 storeFileKey' (b:bs) file = do
 	result <- (Internals.getKey b) file
@@ -100,11 +100,11 @@ storeFileKey' (b:bs) file = do
 
 {- Attempts to retrieve an key from one of the backends, saving it to
  - a specified location. -}
-retrieveKeyFile :: Backend -> Key -> FilePath -> Annex Bool
+retrieveKeyFile :: Backend Annex -> Key -> FilePath -> Annex Bool
 retrieveKeyFile backend key dest = (Internals.retrieveKeyFile backend) key dest
 
 {- Removes a key from a backend. -}
-removeKey :: Backend -> Key -> Maybe Int -> Annex Bool
+removeKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool
 removeKey backend key numcopies = (Internals.removeKey backend) key numcopies
 
 {- Checks if a key is present in its backend. -}
@@ -114,12 +114,12 @@ hasKey key = do
 	(Internals.hasKey backend) key
 
 {- Checks a key's backend for problems. -}
-fsckKey :: Backend -> Key -> Maybe Int -> Annex Bool
+fsckKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool
 fsckKey backend key numcopies = (Internals.fsckKey backend) key numcopies
 
 {- Looks up the key and backend corresponding to an annexed file,
  - by examining what the file symlinks to. -}
-lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
+lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex))
 lookupFile file = do
 	bs <- Annex.supportedBackends
 	tl <- liftIO $ try getsymlink
@@ -147,7 +147,7 @@ lookupFile file = do
 {- Looks up the backends that should be used for each file in a list.
  - That can be configured on a per-file basis in the gitattributes file.
  -}
-chooseBackends :: [FilePath] -> Annex [(FilePath, Maybe Backend)]
+chooseBackends :: [FilePath] -> Annex [(FilePath, Maybe (Backend Annex))]
 chooseBackends fs = do
 	g <- Annex.gitRepo
 	bs <- Annex.supportedBackends
@@ -155,7 +155,7 @@ chooseBackends fs = do
 	return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs
 
 {- Returns the backend to use for a key. -}
-keyBackend :: Key -> Annex Backend
+keyBackend :: Key -> Annex (Backend Annex)
 keyBackend key = do
 	bs <- Annex.supportedBackends
 	return $ lookupBackendName bs $ backendName key
diff --git a/Backend/File.hs b/Backend/File.hs
index 27b2a6901..c8ddd5938 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -27,7 +27,7 @@ import qualified Annex
 import UUID
 import Messages
 
-backend :: Backend
+backend :: Backend Annex
 backend = Backend {
 	name = mustProvide,
 	getKey = mustProvide,
diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs
index 2f3e2cf53..e665e5da7 100644
--- a/Backend/SHA1.hs
+++ b/Backend/SHA1.hs
@@ -20,7 +20,7 @@ import qualified Annex
 import Locations
 import Content
 
-backend :: Backend
+backend :: Backend Annex
 backend = Backend.File.backend {
 	name = "SHA1",
 	getKey = keyValue,
diff --git a/Backend/URL.hs b/Backend/URL.hs
index 3eb7376e0..8ed354aed 100644
--- a/Backend/URL.hs
+++ b/Backend/URL.hs
@@ -14,7 +14,7 @@ import TypeInternals
 import Utility
 import Messages
 
-backend :: Backend
+backend :: Backend Annex
 backend = Backend {
 	name = "URL",
 	getKey = keyValue,
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index 0c9301238..cd4254e2b 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -21,7 +21,7 @@ import qualified Annex
 import Content
 import Messages
 
-backend :: Backend
+backend :: Backend Annex
 backend = Backend.File.backend {
 	name = "WORM",
 	getKey = keyValue,
diff --git a/BackendList.hs b/BackendList.hs
index d1180d22f..5ae78bcc7 100644
--- a/BackendList.hs
+++ b/BackendList.hs
@@ -13,7 +13,7 @@ import qualified Backend.SHA1
 import qualified Backend.URL
 import Types
 
-allBackends :: [Backend]
+allBackends :: [Backend Annex]
 allBackends = 
 	[ Backend.WORM.backend
 	, Backend.SHA1.backend
diff --git a/Command.hs b/Command.hs
index 9fafb18ef..06fc704bd 100644
--- a/Command.hs
+++ b/Command.hs
@@ -43,7 +43,7 @@ type CommandCleanup = Annex Bool
  - functions. -}
 type CommandSeekStrings = CommandStartString -> CommandSeek
 type CommandStartString = String -> CommandStart
-type BackendFile = (FilePath, Maybe Backend)
+type BackendFile = (FilePath, Maybe (Backend Annex))
 type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek
 type CommandStartBackendFile = BackendFile -> CommandStart
 type AttrFile = (FilePath, String)
@@ -95,7 +95,7 @@ notAnnexed file a = do
 		Just _ -> return Nothing
 		Nothing -> a
 
-isAnnexed :: FilePath -> ((Key, Backend) -> Annex (Maybe a)) -> Annex (Maybe a)
+isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
 isAnnexed file a = do
 	r <- Backend.lookupFile file
 	case r of
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 065e1743a..fdc55969f 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -37,7 +37,7 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do
 	where
 		numcopies = readMaybe attr :: Maybe Int
 
-perform :: Key -> Backend -> Maybe Int -> CommandPerform
+perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform
 perform key backend numcopies = do
 	success <- Backend.removeKey backend key numcopies
 	if success
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 662c281c2..fc9bd7f52 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -28,7 +28,7 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do
 	where
 		numcopies = readMaybe attr :: Maybe Int
 
-perform :: Key -> Backend -> Maybe Int -> CommandPerform
+perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform
 perform key backend numcopies = do
 	success <- Backend.fsckKey backend key numcopies
 	if success
diff --git a/Command/Get.hs b/Command/Get.hs
index e0af6c407..2aa3c0c15 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -30,7 +30,7 @@ start file = isAnnexed file $ \(key, backend) -> do
 			showStart "get" file
 			return $ Just $ perform key backend
 
-perform :: Key -> Backend -> CommandPerform
+perform :: Key -> Backend Annex -> CommandPerform
 perform key backend = do
 	ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
 	if ok
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index 5bc54ceab..566b508c0 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -42,7 +42,7 @@ start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
 			return $ head backends
 		choosebackend (Just backend) = return backend
 
-perform :: FilePath -> Key -> Backend -> CommandPerform
+perform :: FilePath -> Key -> Backend Annex -> CommandPerform
 perform file oldkey newbackend = do
 	g <- Annex.gitRepo
 
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index cdd577ba8..413443969 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -36,7 +36,7 @@ start file = isAnnexed file $ \(key, backend) -> do
 			return $ Just $ perform file key backend
 		else return Nothing
 
-perform :: FilePath -> Key -> Backend -> CommandPerform
+perform :: FilePath -> Key -> Backend Annex -> CommandPerform
 perform file key backend = do
 	-- force backend to always remove
 	ok <- Backend.removeKey backend key (Just 0)
diff --git a/TypeInternals.hs b/TypeInternals.hs
index 44db743fa..99f304973 100644
--- a/TypeInternals.hs
+++ b/TypeInternals.hs
@@ -28,10 +28,11 @@ data Flag =
 -- but it uses Backend, so has to be here to avoid a depends loop.
 data AnnexState = AnnexState {
 	repo :: Git.Repo,
-	backends :: [Backend],
-	supportedBackends :: [Backend],
+	backends :: [Backend Annex],
+	supportedBackends :: [Backend Annex],
 	flags :: M.Map FlagName Flag,
-	repoqueue :: GitQueue.Queue
+	repoqueue :: GitQueue.Queue,
+	quiet :: Bool
 } deriving (Show)
 
 -- git-annex's monad
@@ -43,7 +44,7 @@ type BackendName = String
 data Key = Key (BackendName, KeyName) deriving (Eq, Ord)
 
 -- constructs a key in a backend
-genKey :: Backend -> KeyName -> Key
+genKey :: Backend a -> KeyName -> Key
 genKey b f = Key (name b,f)
 
 -- show a key to convert it to a string; the string includes the
@@ -77,28 +78,28 @@ keyName :: Key -> KeyName
 keyName (Key (_,k)) = k
 
 -- this structure represents a key-value backend
-data Backend = Backend {
+data Backend a = Backend {
 	-- name of this backend
 	name :: String,
 	-- converts a filename to a key
-	getKey :: FilePath -> Annex (Maybe Key),
+	getKey :: FilePath -> a (Maybe Key),
 	-- stores a file's contents to a key
-	storeFileKey :: FilePath -> Key -> Annex Bool,
+	storeFileKey :: FilePath -> Key -> a Bool,
 	-- retrieves a key's contents to a file
-	retrieveKeyFile :: Key -> FilePath -> Annex Bool,
+	retrieveKeyFile :: Key -> FilePath -> a Bool,
 	-- removes a key, optionally checking that enough copies are stored
 	-- elsewhere
-	removeKey :: Key -> Maybe Int -> Annex Bool,
+	removeKey :: Key -> Maybe Int -> a Bool,
 	-- checks if a backend is storing the content of a key
-	hasKey :: Key -> Annex Bool,
+	hasKey :: Key -> a Bool,
 	-- called during fsck to check a key
 	-- (second parameter may be the number of copies that there should
 	-- be of the key)
-	fsckKey :: Key -> Maybe Int -> Annex Bool
+	fsckKey :: Key -> Maybe Int -> a Bool
 }
 
-instance Show Backend where
+instance Show (Backend a) where
 	show backend = "Backend { name =\"" ++ name backend ++ "\" }"
 
-instance Eq Backend where
+instance Eq (Backend a) where
 	a == b = name a == name b