add git config lookups for annex.name, annex.backends, etc

Annex.hs

@@ -18,20 +18,38 @@ import LocationLog
 startAnnex :: IO State
 startAnnex = do
 	r <- currentRepo
+	config <- getConfig r
 	gitPrep r
-	-- TODO query git repo for configuration
-	return State { repo = r,  backends = supportedBackends }
+	return State {
+		repo = r,
+		gitconfig = config
+	}
+
+{- Query the git repo for relevant configuration settings. -}
+getConfig :: GitRepo -> IO GitConfig
+getConfig repo = do
+	-- a name can be configured, if none is, use the repository path
+	name <- gitConfigGet "annex.name" (top repo)
+	-- default number of copies to keep of file contents is 1
+	numcopies <- gitConfigGet "annex.numcopies" "1"
+	backends <- gitConfigGet "annex.backends" ""
+	
+	return GitConfig {
+		annex_name = name,
+		annex_numcopies = read numcopies,
+		annex_backends = parseBackendList backends
+	}
 
 {- Annexes a file, storing it in a backend, and then moving it into
  - the annex directory and setting up the symlink pointing to its content. -}
 annexFile :: State -> FilePath -> IO ()
 annexFile state file = do
-	alreadyannexed <- lookupBackend (backends state) (repo state) file
+	alreadyannexed <- lookupBackend backends (repo state) file
 	case (alreadyannexed) of
 		Just _ -> error $ "already annexed: " ++ file
 		Nothing -> do
 			checkLegal file
-			stored <- storeFile (backends state) (repo state) file
+			stored <- storeFile (annex_backends $ gitconfig state) (repo state) file
 			case (stored) of
 				Nothing -> error $ "no backend could store: " ++ file
 				Just key -> symlink key
@@ -47,15 +65,16 @@ annexFile state file = do
 			if ((isSymbolicLink s) || (not $ isRegularFile s))
 				then error $ "not a regular file: " ++ file
 				else return ()
+		backends = annex_backends $ gitconfig state
 
 {- Inverse of annexFile. -}
 unannexFile :: State -> FilePath -> IO ()
 unannexFile state file = do
-	alreadyannexed <- lookupBackend (backends state) (repo state) file
+	alreadyannexed <- lookupBackend backends (repo state) file
 	case (alreadyannexed) of
 		Nothing -> error $ "not annexed " ++ file
 		Just _ -> do
-			mkey <- dropFile (backends state) (repo state) file
+			mkey <- dropFile backends (repo state) file
 			case (mkey) of
 				Nothing -> return ()
 				Just key -> do
@@ -63,6 +82,8 @@ unannexFile state file = do
 					removeFile file
 					renameFile src file
 					return ()
+	where
+		backends = annex_backends $ gitconfig state
 
 {- Sets up a git repo for git-annex. May be called repeatedly. -}
 gitPrep :: GitRepo -> IO ()

BackendList.hs

@@ -4,6 +4,7 @@
 module BackendList where
 
 -- When adding a new backend, import it here and add it to the list.
+import Types
 import qualified BackendFile
 import qualified BackendChecksum
 import qualified BackendUrl
@@ -12,3 +13,20 @@ supportedBackends =
 	, BackendChecksum.backend
 	, BackendUrl.backend
 	]
+
+{- Parses a string with a list of backend names into
+ - a list of Backend objects. If the list is empty,
+ - defaults to supportedBackends. -}
+parseBackendList :: String -> [Backend]
+parseBackendList s = 
+	if (length s == 0)
+		then supportedBackends
+		else map (lookupBackendName) $ words s
+
+{- Looks up a supported backed by name. -}
+lookupBackendName :: String -> Backend
+lookupBackendName s =
+	if ((length matches) /= 1)
+		then error $ "unknown backend " ++ s
+		else matches !! 0
+	where matches = filter (\b -> s == name b) supportedBackends

GitRepo.hs

@@ -5,7 +5,10 @@ module GitRepo where
 import Directory
 import System.Directory
 import System.Path
+import System.Cmd.Utils
+import System.IO
 import Data.String.Utils
+import Control.Exception
 import Utility
 import Types
 
@@ -14,11 +17,9 @@ gitRepo :: FilePath -> IO GitRepo
 gitRepo dir = do
 	b <- isBareRepo dir
 
-	-- TOOD query repo for configuration settings; other repositories; etc
 	return GitRepo {
 		top = dir,
-		bare = b,
-		remotes = []
+		bare = b
 	}
 
 {- Path to a repository's gitattributes file. -}
@@ -53,10 +54,19 @@ gitRelative repo file = drop (length absrepo) absfile
 			Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo
 
 {- Stages a changed file in git's index. -}
+gitAdd :: GitRepo -> FilePath -> IO ()
 gitAdd repo file = do
 	-- TODO
 	return ()
 
+{- Queries git-config. -}
+gitConfigGet :: String -> String -> IO String
+gitConfigGet name defaultValue = 
+	handle ((\_ -> return defaultValue)::SomeException -> IO String) $
+		pOpen ReadFromPipe "git" ["config", "--get", name] $ \h -> do
+			ret <- hGetLine h
+			return ret
+
 {- Finds the current git repository, which may be in a parent directory. -}
 currentRepo :: IO GitRepo
 currentRepo = do

Types.hs

@@ -23,12 +23,17 @@ data Backend = Backend {
 -- a git repository
 data GitRepo = GitRepo {
 	top :: FilePath,
-	bare :: Bool,
-	remotes :: [GitRepo]
+	bare :: Bool
 }
 
 -- git-annex's runtime state
 data State = State {
 	repo :: GitRepo,
-	backends :: [Backend]
+	gitconfig :: GitConfig
+}
+
+data GitConfig = GitConfig {
+	annex_name :: String,
+	annex_numcopies :: Int,
+	annex_backends :: [Backend]
 }

git-annex.mdwn

@@ -124,8 +124,9 @@ so the lines may be in arbitrary order, but it will never conflict.)
 ## configuration
 
 * `annex.numcopies` -- number of copies of files to keep
-* `annex.backend` -- name of the default key/value backend to use to
-  store new files
+* `annex.backends` -- space-separated list of names of 
+  the key/value backends to use. The first listed is used to store
+  new files.
 * `annex.name` -- allows specifying a unique name for this repository.
   If not specified, the name is derived from its directory's location and
   the hostname. When a repository is on removable media it is useful to give
@@ -145,11 +146,15 @@ If the symlink to annexed content is relative, moving it to a subdir will
 break it. But it it's absolute, moving the git repo (or mounting its drive
 elsewhere) will break it. Either:
 
-* Use relative links and need `git annex mv` to move (or post-commit 
+* Use relative links and need `git annex --mv` to move (or post-commit 
   hook that caches moves and updates links).
 * Use absolute links and need `git annex fixlinks` when location changes;
   note that would also mean that git would see the symlink targets changed
-  and want to commit the change.
+  and want to commit the change. And, other clones of the repo would
+  diverge and there would be conflicts on the symlink text. Ugh.
+
+Hard links are not an option, because git would then happily commit the
+file content. Amoung other reasons..
 
 ### free space determination