split out three modules from Git

Constructors and configuration make sense in separate modules.
A separate Git.Types is needed to avoid cycles.

Annex.hs

@@ -27,6 +27,7 @@ import Control.Monad.State
 
 import Common
 import qualified Git
+import qualified Git.Config
 import Git.CatFile
 import Git.Queue
 import Types.Backend
@@ -99,7 +100,7 @@ newState gitrepo = AnnexState
 
 {- Create and returns an Annex state object for the specified git repo. -}
 new :: Git.Repo -> IO AnnexState
-new gitrepo = newState <$> Git.configRead gitrepo
+new gitrepo = newState <$> Git.Config.read gitrepo
 
 {- performs an action in the Annex monad -}
 run :: AnnexState -> Annex a -> IO (a, AnnexState)

Annex/UUID.hs

@@ -21,6 +21,7 @@ module Annex.UUID (
 
 import Common.Annex
 import qualified Git
+import qualified Git.Config
 import qualified Build.SysConfig as SysConfig
 import Config
 
@@ -55,14 +56,14 @@ getRepoUUID r = do
 			return u
 		else return c
 	where
-		cached = toUUID . Git.configGet cachekey ""
+		cached = toUUID . Git.Config.get cachekey ""
 		updatecache u = do
 			g <- gitRepo
 			when (g /= r) $ storeUUID cachekey u
 		cachekey = remoteConfig r "uuid"
 
 getUncachedUUID :: Git.Repo -> UUID
-getUncachedUUID = toUUID . Git.configGet configkey ""
+getUncachedUUID = toUUID . Git.Config.get configkey ""
 
 {- Make sure that the repo has an annex.uuid setting. -}
 prepUUID :: Annex ()

Annex/Version.hs

@@ -8,7 +8,7 @@
 module Annex.Version where
 
 import Common.Annex
-import qualified Git
+import qualified Git.Config
 import Config
 
 type Version = String
@@ -26,7 +26,7 @@ versionField :: String
 versionField = "annex.version"
 
 getVersion :: Annex (Maybe Version)
-getVersion = handle <$> fromRepo (Git.configGet versionField "")
+getVersion = handle <$> fromRepo (Git.Config.get versionField "")
 	where
 		handle [] = Nothing
 		handle v = Just v

Backend.hs

@@ -21,6 +21,7 @@ import System.Posix.Files
 
 import Common.Annex
 import qualified Git
+import qualified Git.Config
 import qualified Annex
 import Types.Key
 import qualified Types.Backend as B
@@ -47,7 +48,7 @@ orderedList = do
 			l' <- (lookupBackendName name :) <$> standard
 			Annex.changeState $ \s -> s { Annex.backends = l' }
 			return l'
-		standard = fromRepo $ parseBackendList . Git.configGet "annex.backends" ""
+		standard = fromRepo $ parseBackendList . Git.Config.get "annex.backends" ""
 		parseBackendList [] = list
 		parseBackendList s = map lookupBackendName $ words s
 

Command/Map.hs

@@ -13,6 +13,8 @@ import qualified Data.Map as M
 import Common.Annex
 import Command
 import qualified Git
+import qualified Git.Config
+import qualified Git.Construct
 import Annex.UUID
 import Logs.UUID
 import Logs.Trust
@@ -146,8 +148,8 @@ spider' (r:rs) known
 {- Converts repos to a common absolute form. -}
 absRepo :: Git.Repo -> Git.Repo -> Annex Git.Repo
 absRepo reference r
-	| Git.repoIsUrl reference = return $ Git.localToUrl reference r
-	| otherwise = liftIO $ Git.repoFromAbsPath =<< absPath (Git.workTree r)
+	| Git.repoIsUrl reference = return $ Git.Construct.localToUrl reference r
+	| otherwise = liftIO $ Git.Construct.fromAbsPath =<< absPath (Git.workTree r)
 
 {- Checks if two repos are the same. -}
 same :: Git.Repo -> Git.Repo -> Bool
@@ -182,7 +184,7 @@ tryScan :: Git.Repo -> Annex (Maybe Git.Repo)
 tryScan r
 	| Git.repoIsSsh r = sshscan
 	| Git.repoIsUrl r = return Nothing
-	| otherwise = safely $ Git.configRead r
+	| otherwise = safely $ Git.Config.read r
 	where
 		safely a = do
 			result <- liftIO (try a :: IO (Either SomeException Git.Repo))
@@ -191,7 +193,7 @@ tryScan r
 				Right r' -> return $ Just r'
 		pipedconfig cmd params = safely $
 			pOpen ReadFromPipe cmd (toCommand params) $
-				Git.hConfigRead r
+				Git.Config.hRead r
 
 		configlist =
 			onRemote r (pipedconfig, Nothing) "configlist" []

Command/Sync.hs

@@ -11,6 +11,7 @@ import Common.Annex
 import Command
 import qualified Annex.Branch
 import qualified Git
+import qualified Git.Config
 
 import qualified Data.ByteString.Lazy.Char8 as L
 
@@ -56,7 +57,7 @@ push = do
 defaultRemote :: Annex String
 defaultRemote = do
 	branch <- currentBranch
-	fromRepo $ Git.configGet ("branch." ++ branch ++ ".remote") "origin"
+	fromRepo $ Git.Config.get ("branch." ++ branch ++ ".remote") "origin"
 
 currentBranch :: Annex String
 currentBranch = last . split "/" . L.unpack . head . L.lines <$>
@@ -65,6 +66,6 @@ currentBranch = last . split "/" . L.unpack . head . L.lines <$>
 checkRemote :: String -> Annex ()
 checkRemote remote = do
 	remoteurl <- fromRepo $
-		Git.configGet ("remote." ++ remote ++ ".url") ""
+		Git.Config.get ("remote." ++ remote ++ ".url") ""
 	when (null remoteurl) $ do
 		error $ "No url is configured for the remote: " ++ remote

Config.hs

@@ -9,6 +9,7 @@ module Config where
 
 import Common.Annex
 import qualified Git
+import qualified Git.Config
 import qualified Annex
 
 type ConfigKey = String
@@ -18,15 +19,15 @@ setConfig :: ConfigKey -> String -> Annex ()
 setConfig k value = do
 	inRepo $ Git.run "config" [Param k, Param value]
 	-- re-read git config and update the repo's state
-	newg <- inRepo Git.configRead
+	newg <- inRepo Git.Config.read
 	Annex.changeState $ \s -> s { Annex.repo = newg }
 
 {- Looks up a per-remote config setting in git config.
  - Failing that, tries looking for a global config option. -}
 getConfig :: Git.Repo -> ConfigKey -> String -> Annex String
 getConfig r key def = do
-	def' <- fromRepo $ Git.configGet ("annex." ++ key) def
-	fromRepo $ Git.configGet (remoteConfig r key) def'
+	def' <- fromRepo $ Git.Config.get ("annex." ++ key) def
+	fromRepo $ Git.Config.get (remoteConfig r key) def'
 
 {- Looks up a per-remote config setting in git config. -}
 remoteConfig :: Git.Repo -> ConfigKey -> String
@@ -83,6 +84,6 @@ getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies
 	where
 		use (Just n) = return n
 		use Nothing = perhaps (return 1) =<< 
-			readMaybe <$> fromRepo (Git.configGet config "1")
+			readMaybe <$> fromRepo (Git.Config.get config "1")
 		perhaps fallback = maybe fallback (return . id)
 		config = "annex.numcopies"

Git.hs

@@ -14,11 +14,6 @@ module Git (
 	Branch,
 	Sha,
 	Tag,
-	repoFromCwd,
-	repoFromAbsPath,
-	repoFromUnknown,
-	repoFromUrl,
-	localToUrl,
 	repoIsUrl,
 	repoIsSsh,
 	repoIsHttp,
@@ -34,11 +29,7 @@ module Git (
 	urlHostUser,
 	urlAuthority,
 	urlScheme,
-	configGet,
 	configMap,
-	configRead,
-	hConfigRead,
-	configStore,
 	configTrue,
 	gitCommandLine,
 	run,
@@ -51,14 +42,12 @@ module Git (
 	attributes,
 	remotes,
 	remotesAdd,
-	genRemote,
 	repoRemoteName,
 	repoRemoteNameSet,
 	repoRemoteNameFromKey,
 	checkAttr,
 	decodeGitFile,
 	encodeGitFile,
-	repoAbsPath,
 	reap,
 	useIndex,
 	getSha,
@@ -69,9 +58,6 @@ module Git (
 	prop_idempotent_deencode
 ) where
 
-import System.Posix.Directory
-import System.Posix.User
-import Control.Exception (bracket_)
 import qualified Data.Map as M hiding (map, split)
 import Network.URI
 import Data.Char
@@ -83,92 +69,7 @@ import System.Posix.Env (setEnv, unsetEnv, getEnv)
 import qualified Data.ByteString.Lazy.Char8 as L
 
 import Common
-
-{- There are two types of repositories; those on local disk and those
- - accessed via an URL. -}
-data RepoLocation = Dir FilePath | Url URI | Unknown
-	deriving (Show, Eq)
-
-data Repo = Repo {
-	location :: RepoLocation,
-	config :: M.Map String String,
-	remotes :: [Repo],
-	-- remoteName holds the name used for this repo in remotes
-	remoteName :: Maybe String 
-} deriving (Show, Eq)
-
-{- A git ref. Can be a sha1, or a branch or tag name. -}
-newtype Ref = Ref String
-	deriving (Eq)
-
-instance Show Ref where
-	show (Ref v) = v
-
-{- Aliases for Ref. -}
-type Branch = Ref
-type Sha = Ref
-type Tag = Ref
-
-newFrom :: RepoLocation -> Repo
-newFrom l = 
-	Repo {
-		location = l,
-		config = M.empty,
-		remotes = [],
-		remoteName = Nothing
-	}
-
-{- Local Repo constructor, requires an absolute path to the repo be
- - specified. -}
-repoFromAbsPath :: FilePath -> IO Repo
-repoFromAbsPath dir
-	| "/" `isPrefixOf` dir = do
- 		-- Git always looks for "dir.git" in preference to
-		-- to "dir", even if dir ends in a "/".
-		let canondir = dropTrailingPathSeparator dir
-		let dir' = canondir ++ ".git"
-		e <- doesDirectoryExist dir'
-		if e
-			then ret dir'
-			else if "/.git" `isSuffixOf` canondir
-				then do
-					-- When dir == "foo/.git", git looks
-					-- for "foo/.git/.git", and failing
-					-- that, uses "foo" as the repository.
-					e' <- doesDirectoryExist $ dir </> ".git"
-					if e'
-						then ret dir
-						else ret $ takeDirectory canondir
-				else ret dir
-	| otherwise = error $ "internal error, " ++ dir ++ " is not absolute"
-	where
-		ret = return . newFrom . Dir
-
-{- Remote Repo constructor. Throws exception on invalid url. -}
-repoFromUrl :: String -> IO Repo
-repoFromUrl url
-	| startswith "file://" url = repoFromAbsPath $ uriPath u
-	| otherwise = return $ newFrom $ Url u
-		where
-			u = fromMaybe bad $ parseURI url
-			bad = error $ "bad url " ++ url
-
-{- Creates a repo that has an unknown location. -}
-repoFromUnknown :: Repo
-repoFromUnknown = newFrom Unknown
-
-{- Converts a Local Repo into a remote repo, using the reference repo
- - which is assumed to be on the same host. -}
-localToUrl :: Repo -> Repo -> Repo
-localToUrl reference r
-	| not $ repoIsUrl reference = error "internal error; reference repo not url"
-	| repoIsUrl r = r
-	| otherwise = r { location = Url $ fromJust $ parseURI absurl }
-	where
-		absurl =
-			urlScheme reference ++ "//" ++
-			urlAuthority reference ++
-			workTree r
+import Git.Types
 
 {- User-visible description of a git repo. -}
 repoDescribe :: Repo -> String
@@ -470,89 +371,10 @@ commit message branch parentrefs repo = do
 		asString a = L.unpack <$> a
 		ps = concatMap (\r -> ["-p", show r]) parentrefs
 
-{- Runs git config and populates a repo with its config. -}
-configRead :: Repo -> IO Repo
-configRead repo@(Repo { location = Dir d }) = do
-	{- Cannot use pipeRead because it relies on the config having
-	   been already read. Instead, chdir to the repo. -}
-	cwd <- getCurrentDirectory
-	bracket_ (changeWorkingDirectory d) (changeWorkingDirectory cwd) $
-		pOpen ReadFromPipe "git" ["config", "--list"] $ hConfigRead repo
-configRead r = assertLocal r $ error "internal"
-
-{- Reads git config from a handle and populates a repo with it. -}
-hConfigRead :: Repo -> Handle -> IO Repo
-hConfigRead repo h = do
-	val <- hGetContentsStrict h
-	configStore val repo
-
-{- Stores a git config into a repo, returning the new version of the repo.
- - The git config may be multiple lines, or a single line. Config settings
- - can be updated inrementally. -}
-configStore :: String -> Repo -> IO Repo
-configStore s repo = do
-	let repo' = repo { config = configParse s `M.union` config repo }
-	rs <- configRemotes repo'
-	return $ repo' { remotes = rs }
-
-{- Parses git config --list output into a config map. -}
-configParse :: String -> M.Map String String
-configParse s = M.fromList $ map pair $ lines s
-	where
-		pair = separate (== '=')
-
-{- Calculates a list of a repo's configured remotes, by parsing its config. -}
-configRemotes :: Repo -> IO [Repo]
-configRemotes repo = mapM construct remotepairs
-	where
-		filterconfig f = filter f $ M.toList $ config repo
-		filterkeys f = filterconfig (\(k,_) -> f k)
-		remotepairs = filterkeys isremote
-		isremote k = startswith "remote." k && endswith ".url" k
-		construct (k,v) = repoRemoteNameFromKey k <$> genRemote v repo
-
-{- Generates one of a repo's remotes using a given location (ie, an url). -}
-genRemote :: String -> Repo -> IO Repo
-genRemote s repo = gen $ calcloc s
-	where
-		filterconfig f = filter f $ M.toList $ config repo
-		gen v	
-			| scpstyle v = repoFromUrl $ scptourl v
-			| isURI v = repoFromUrl v
-			| otherwise = repoFromRemotePath v repo
-		-- insteadof config can rewrite remote location
-		calcloc l
-			| null insteadofs = l
-			| otherwise = replacement ++ drop (length bestvalue) l
-			where
-				replacement = drop (length prefix) $
-					take (length bestkey - length suffix) bestkey
-				(bestkey, bestvalue) = maximumBy longestvalue insteadofs
-				longestvalue (_, a) (_, b) = compare b a
-				insteadofs = filterconfig $ \(k, v) -> 
-					startswith prefix k &&
-					endswith suffix k &&
-					startswith v l
-				(prefix, suffix) = ("url." , ".insteadof")
-		-- git remotes can be written scp style -- [user@]host:dir
-		scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v)
-		scptourl v = "ssh://" ++ host ++ slash dir
-			where
-				(host, dir) = separate (== ':') v
-				slash d	| d == "" = "/~/" ++ d
-					| "/" `isPrefixOf` d = d
-					| "~" `isPrefixOf` d = '/':d
-					| otherwise = "/~/" ++ d
-
 {- Checks if a string from git config is a true value. -}
 configTrue :: String -> Bool
 configTrue s = map toLower s == "true"
 
-{- Returns a single git config setting, or a default value if not set. -}
-configGet :: String -> String -> Repo -> String
-configGet key defaultValue repo = 
-	M.findWithDefault defaultValue key (config repo)
-
 {- Access to raw config Map -}
 configMap :: Repo -> M.Map String String
 configMap = config
@@ -658,71 +480,3 @@ encodeGitFile s = foldl (++) "\"" (map echar s) ++ "\""
 {- for quickcheck -}
 prop_idempotent_deencode :: String -> Bool
 prop_idempotent_deencode s = s == decodeGitFile (encodeGitFile s)
-
-{- Constructs a Repo from the path specified in the git remotes of
- - another Repo. -}
-repoFromRemotePath :: FilePath -> Repo -> IO Repo
-repoFromRemotePath dir repo = do
-	dir' <- expandTilde dir
-	repoFromAbsPath $ workTree repo </> dir'
-
-{- Git remotes can have a directory that is specified relative
- - to the user's home directory, or that contains tilde expansions.
- - This converts such a directory to an absolute path.
- - Note that it has to run on the system where the remote is.
- -}
-repoAbsPath :: FilePath -> IO FilePath
-repoAbsPath d = do
-	d' <- expandTilde d
-	h <- myHomeDir
-	return $ h </> d'
-
-expandTilde :: FilePath -> IO FilePath
-expandTilde = expandt True
-	where
-		expandt _ [] = return ""
-		expandt _ ('/':cs) = do
-			v <- expandt True cs
-			return ('/':v)
-		expandt True ('~':'/':cs) = do
-			h <- myHomeDir
-			return $ h </> cs
-		expandt True ('~':cs) = do
-			let (name, rest) = findname "" cs
-			u <- getUserEntryForName name
-			return $ homeDirectory u </> rest
-		expandt _ (c:cs) = do
-			v <- expandt False cs
-			return (c:v)
-		findname n [] = (n, "")
-		findname n (c:cs)
-			| c == '/' = (n, cs)
-			| otherwise = findname (n++[c]) cs
-
-{- Finds the current git repository, which may be in a parent directory. -}
-repoFromCwd :: IO Repo
-repoFromCwd = getCurrentDirectory >>= seekUp isRepoTop >>= maybe norepo makerepo
-	where
-		makerepo = return . newFrom . Dir
-		norepo = error "Not in a git repository."
-
-seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
-seekUp want dir = do
-	ok <- want dir
-	if ok
-		then return $ Just dir
-		else case parentDir dir of
-			"" -> return Nothing
-			d -> seekUp want d
-
-isRepoTop :: FilePath -> IO Bool
-isRepoTop dir = do
-	r <- isRepo
-	b <- isBareRepo
-	return (r || b)
-	where
-		isRepo = gitSignature ".git" ".git/config"
-		isBareRepo = gitSignature "objects" "config"
-		gitSignature subdir file = liftM2 (&&)
-			(doesDirectoryExist (dir ++ "/" ++ subdir))
-			(doesFileExist (dir ++ "/" ++ file))

Git/Config.hs

@@ -0,0 +1,58 @@
+{- git repository configuration handling
+ -
+ - Copyright 2010,2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Config (
+	get,
+	read,
+	hRead,
+	store
+) where
+
+import Prelude hiding (read)
+import System.Posix.Directory
+import Control.Exception (bracket_)
+import qualified Data.Map as M
+
+import Common
+import Git
+import Git.Types
+import qualified Git.Construct
+
+{- Returns a single git config setting, or a default value if not set. -}
+get :: String -> String -> Repo -> String
+get key defaultValue repo = M.findWithDefault defaultValue key (config repo)
+
+{- Runs git config and populates a repo with its config. -}
+read :: Repo -> IO Repo
+read repo@(Repo { location = Dir d }) = do
+	{- Cannot use pipeRead because it relies on the config having
+	   been already read. Instead, chdir to the repo. -}
+	cwd <- getCurrentDirectory
+	bracket_ (changeWorkingDirectory d) (changeWorkingDirectory cwd) $
+		pOpen ReadFromPipe "git" ["config", "--list"] $ hRead repo
+read r = assertLocal r $ error "internal"
+
+{- Reads git config from a handle and populates a repo with it. -}
+hRead :: Repo -> Handle -> IO Repo
+hRead repo h = do
+	val <- hGetContentsStrict h
+	store val repo
+
+{- Stores a git config into a repo, returning the new version of the repo.
+ - The git config may be multiple lines, or a single line. Config settings
+ - can be updated inrementally. -}
+store :: String -> Repo -> IO Repo
+store s repo = do
+	let repo' = repo { config = parse s `M.union` config repo }
+	rs <- Git.Construct.fromRemotes repo'
+	return $ repo' { remotes = rs }
+
+{- Parses git config --list output into a config map. -}
+parse :: String -> M.Map String String
+parse s = M.fromList $ map pair $ lines s
+	where
+		pair = separate (== '=')

Git/Construct.hs

@@ -0,0 +1,198 @@
+{- Construction of Git Repo objects
+ -
+ - Copyright 2010,2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Construct (
+	fromCwd,
+	fromAbsPath,
+	fromUrl,
+	fromUnknown,
+	localToUrl,
+	fromRemotes,
+	fromRemoteLocation,
+	repoAbsPath,
+) where
+
+import System.Posix.User
+import qualified Data.Map as M hiding (map, split)
+import Network.URI
+
+import Common
+import Git.Types
+import Git
+
+{- Finds the current git repository, which may be in a parent directory. -}
+fromCwd :: IO Repo
+fromCwd = getCurrentDirectory >>= seekUp isRepoTop >>= maybe norepo makerepo
+	where
+		makerepo = return . newFrom . Dir
+		norepo = error "Not in a git repository."
+
+{- Local Repo constructor, requires an absolute path to the repo be
+ - specified. -}
+fromAbsPath :: FilePath -> IO Repo
+fromAbsPath dir
+	| "/" `isPrefixOf` dir = do
+ 		-- Git always looks for "dir.git" in preference to
+		-- to "dir", even if dir ends in a "/".
+		let canondir = dropTrailingPathSeparator dir
+		let dir' = canondir ++ ".git"
+		e <- doesDirectoryExist dir'
+		if e
+			then ret dir'
+			else if "/.git" `isSuffixOf` canondir
+				then do
+					-- When dir == "foo/.git", git looks
+					-- for "foo/.git/.git", and failing
+					-- that, uses "foo" as the repository.
+					e' <- doesDirectoryExist $ dir </> ".git"
+					if e'
+						then ret dir
+						else ret $ takeDirectory canondir
+				else ret dir
+	| otherwise = error $ "internal error, " ++ dir ++ " is not absolute"
+	where
+		ret = return . newFrom . Dir
+
+{- Remote Repo constructor. Throws exception on invalid url. -}
+fromUrl :: String -> IO Repo
+fromUrl url
+	| startswith "file://" url = fromAbsPath $ uriPath u
+	| otherwise = return $ newFrom $ Url u
+		where
+			u = fromMaybe bad $ parseURI url
+			bad = error $ "bad url " ++ url
+
+{- Creates a repo that has an unknown location. -}
+fromUnknown :: Repo
+fromUnknown = newFrom Unknown
+
+{- Converts a local Repo into a remote repo, using the reference repo
+ - which is assumed to be on the same host. -}
+localToUrl :: Repo -> Repo -> Repo
+localToUrl reference r
+	| not $ repoIsUrl reference = error "internal error; reference repo not url"
+	| repoIsUrl r = r
+	| otherwise = r { location = Url $ fromJust $ parseURI absurl }
+	where
+		absurl =
+			urlScheme reference ++ "//" ++
+			urlAuthority reference ++
+			workTree r
+
+{- Calculates a list of a repo's configured remotes, by parsing its config. -}
+fromRemotes :: Repo -> IO [Repo]
+fromRemotes repo = mapM construct remotepairs
+	where
+		filterconfig f = filter f $ M.toList $ config repo
+		filterkeys f = filterconfig (\(k,_) -> f k)
+		remotepairs = filterkeys isremote
+		isremote k = startswith "remote." k && endswith ".url" k
+		construct (k,v) = repoRemoteNameFromKey k <$> fromRemoteLocation v repo
+
+{- Constructs a new Repo for one of a Repo's remotes using a given
+ - location (ie, an url). -}
+fromRemoteLocation :: String -> Repo -> IO Repo
+fromRemoteLocation s repo = gen $ calcloc s
+	where
+		filterconfig f = filter f $ M.toList $ config repo
+		gen v	
+			| scpstyle v = fromUrl $ scptourl v
+			| isURI v = fromUrl v
+			| otherwise = fromRemotePath v repo
+		-- insteadof config can rewrite remote location
+		calcloc l
+			| null insteadofs = l
+			| otherwise = replacement ++ drop (length bestvalue) l
+			where
+				replacement = drop (length prefix) $
+					take (length bestkey - length suffix) bestkey
+				(bestkey, bestvalue) = maximumBy longestvalue insteadofs
+				longestvalue (_, a) (_, b) = compare b a
+				insteadofs = filterconfig $ \(k, v) -> 
+					startswith prefix k &&
+					endswith suffix k &&
+					startswith v l
+				(prefix, suffix) = ("url." , ".insteadof")
+		-- git remotes can be written scp style -- [user@]host:dir
+		scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v)
+		scptourl v = "ssh://" ++ host ++ slash dir
+			where
+				(host, dir) = separate (== ':') v
+				slash d	| d == "" = "/~/" ++ d
+					| "/" `isPrefixOf` d = d
+					| "~" `isPrefixOf` d = '/':d
+					| otherwise = "/~/" ++ d
+
+{- Constructs a Repo from the path specified in the git remotes of
+ - another Repo. -}
+fromRemotePath :: FilePath -> Repo -> IO Repo
+fromRemotePath dir repo = do
+	dir' <- expandTilde dir
+	fromAbsPath $ workTree repo </> dir'
+
+{- Git remotes can have a directory that is specified relative
+ - to the user's home directory, or that contains tilde expansions.
+ - This converts such a directory to an absolute path.
+ - Note that it has to run on the system where the remote is.
+ -}
+repoAbsPath :: FilePath -> IO FilePath
+repoAbsPath d = do
+	d' <- expandTilde d
+	h <- myHomeDir
+	return $ h </> d'
+
+expandTilde :: FilePath -> IO FilePath
+expandTilde = expandt True
+	where
+		expandt _ [] = return ""
+		expandt _ ('/':cs) = do
+			v <- expandt True cs
+			return ('/':v)
+		expandt True ('~':'/':cs) = do
+			h <- myHomeDir
+			return $ h </> cs
+		expandt True ('~':cs) = do
+			let (name, rest) = findname "" cs
+			u <- getUserEntryForName name
+			return $ homeDirectory u </> rest
+		expandt _ (c:cs) = do
+			v <- expandt False cs
+			return (c:v)
+		findname n [] = (n, "")
+		findname n (c:cs)
+			| c == '/' = (n, cs)
+			| otherwise = findname (n++[c]) cs
+
+seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
+seekUp want dir = do
+	ok <- want dir
+	if ok
+		then return $ Just dir
+		else case parentDir dir of
+			"" -> return Nothing
+			d -> seekUp want d
+
+isRepoTop :: FilePath -> IO Bool
+isRepoTop dir = do
+	r <- isRepo
+	b <- isBareRepo
+	return (r || b)
+	where
+		isRepo = gitSignature ".git" ".git/config"
+		isBareRepo = gitSignature "objects" "config"
+		gitSignature subdir file = liftM2 (&&)
+			(doesDirectoryExist (dir ++ "/" ++ subdir))
+			(doesFileExist (dir ++ "/" ++ file))
+
+newFrom :: RepoLocation -> Repo
+newFrom l = 
+	Repo {
+		location = l,
+		config = M.empty,
+		remotes = [],
+		remoteName = Nothing
+	}

Git/Types.hs

@@ -0,0 +1,36 @@
+{- git data types
+ -
+ - Copyright 2010,2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Types where
+
+import Network.URI
+import qualified Data.Map as M
+
+{- There are two types of repositories; those on local disk and those
+ - accessed via an URL. -}
+data RepoLocation = Dir FilePath | Url URI | Unknown
+	deriving (Show, Eq)
+
+data Repo = Repo {
+	location :: RepoLocation,
+	config :: M.Map String String,
+	remotes :: [Repo],
+	-- remoteName holds the name used for this repo in remotes
+	remoteName :: Maybe String 
+} deriving (Show, Eq)
+
+{- A git ref. Can be a sha1, or a branch or tag name. -}
+newtype Ref = Ref String
+	deriving (Eq)
+
+instance Show Ref where
+	show (Ref v) = v
+
+{- Aliases for Ref. -}
+type Branch = Ref
+type Sha = Ref
+type Tag = Ref

GitAnnex.hs

@@ -10,7 +10,8 @@ module GitAnnex where
 import System.Console.GetOpt
 
 import Common.Annex
-import qualified Git
+import qualified Git.Config
+import qualified Git.Construct
 import CmdLine
 import Command
 import Types.TrustLevel
@@ -125,11 +126,11 @@ options = commonOptions ++
 		setprint0 v = Annex.changeState $ \s -> s { Annex.print0 = v }
 		setgitconfig :: String -> Annex ()
 		setgitconfig v = do
-			newg <- inRepo $ Git.configStore v
+			newg <- inRepo $ Git.Config.store v
 			Annex.changeState $ \s -> s { Annex.repo = newg }
 
 header :: String
 header = "Usage: git-annex command [option ..]"
 
 run :: [String] -> IO ()
-run args = dispatch args cmds options header Git.repoFromCwd
+run args = dispatch args cmds options header Git.Construct.fromCwd

Remote/Bup.hs

@@ -15,6 +15,8 @@ import System.Process
 import Common.Annex
 import Types.Remote
 import qualified Git
+import qualified Git.Config
+import qualified Git.Construct
 import Config
 import Annex.Ssh
 import Remote.Helper.Special
@@ -163,8 +165,8 @@ storeBupUUID u buprepo = do
 				[Params $ "config annex.uuid " ++ v]
 					>>! error "ssh failed"
 		else liftIO $ do
-			r' <- Git.configRead r
-			let olduuid = Git.configGet "annex.uuid" "" r'
+			r' <- Git.Config.read r
+			let olduuid = Git.Config.get "annex.uuid" "" r'
 			when (olduuid == "") $
 				Git.run "config"
 					[Param "annex.uuid", Param v] r'
@@ -192,9 +194,9 @@ getBupUUID :: Git.Repo -> UUID -> Annex (UUID, Git.Repo)
 getBupUUID r u
 	| Git.repoIsUrl r = return (u, r)
 	| otherwise = liftIO $ do
-		ret <- try $ Git.configRead r
+		ret <- try $ Git.Config.read r
 		case ret of
-			Right r' -> return (toUUID $ Git.configGet "annex.uuid" "" r', r')
+			Right r' -> return (toUUID $ Git.Config.get "annex.uuid" "" r', r')
 			Left _ -> return (NoUUID, r)
 
 {- Converts a bup remote path spec into a Git.Repo. There are some
@@ -203,13 +205,13 @@ bup2GitRemote :: BupRepo -> IO Git.Repo
 bup2GitRemote "" = do
 	-- bup -r "" operates on ~/.bup
 	h <- myHomeDir
-	Git.repoFromAbsPath $ h </> ".bup"
+	Git.Construct.fromAbsPath $ h </> ".bup"
 bup2GitRemote r
 	| bupLocal r = 
 		if head r == '/'
-			then Git.repoFromAbsPath r
+			then Git.Construct.fromAbsPath r
 			else error "please specify an absolute path"
-	| otherwise = Git.repoFromUrl $ "ssh://" ++ host ++ slash dir
+	| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
 		where
 			bits = split ":" r
 			host = head bits

Remote/Git.hs

@@ -16,6 +16,8 @@ import Utility.RsyncFile
 import Annex.Ssh
 import Types.Remote
 import qualified Git
+import qualified Git.Config
+import qualified Git.Construct
 import qualified Annex
 import Annex.UUID
 import qualified Annex.Content
@@ -44,7 +46,7 @@ list = do
 			case M.lookup (annexurl n) c of
 				Nothing -> return r
 				Just url -> Git.repoRemoteNameSet n <$>
-					inRepo (Git.genRemote url)
+					inRepo (Git.Construct.fromRemoteLocation url)
 
 gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
 gen r u _ = do
@@ -100,7 +102,7 @@ tryGitConfigRead r
 
 		pipedconfig cmd params = safely $
 			pOpen ReadFromPipe cmd (toCommand params) $
-				Git.hConfigRead r
+				Git.Config.hRead r
 
 		geturlconfig = do
 			s <- Url.get (Git.repoLocation r ++ "/config")
@@ -108,7 +110,7 @@ tryGitConfigRead r
 				hPutStr h s
 				hClose h
 				pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $
-					Git.hConfigRead r
+					Git.Config.hRead r
 
 		store a = do
 			r' <- a

Remote/Helper/Special.hs

@@ -12,6 +12,7 @@ import qualified Data.Map as M
 import Common.Annex
 import Types.Remote
 import qualified Git
+import qualified Git.Construct
 
 {- Special remotes don't have a configured url, so Git.Repo does not
  - automatically generate remotes for them. This looks for a different
@@ -23,7 +24,7 @@ findSpecialRemotes s = do
 	return $ map construct $ remotepairs m
 	where
 		remotepairs = M.toList . M.filterWithKey match
-		construct (k,_) = Git.repoRemoteNameFromKey k Git.repoFromUnknown
+		construct (k,_) = Git.repoRemoteNameFromKey k Git.Construct.fromUnknown
 		match k _ = startswith "remote." k && endswith (".annex-"++s) k
 
 {- Sets up configuration for a special remote in .git/config. -}

Remote/Web.hs

@@ -10,6 +10,7 @@ module Remote.Web (remote) where
 import Common.Annex
 import Types.Remote
 import qualified Git
+import qualified Git.Construct
 import Config
 import Logs.Web
 import qualified Utility.Url as Url
@@ -26,7 +27,7 @@ remote = RemoteType {
 -- (If the web should cease to exist, remove this module and redistribute
 -- a new release to the survivors by carrier pigeon.)
 list :: Annex [Git.Repo]
-list = return [Git.repoRemoteNameSet "web" Git.repoFromUnknown]
+list = return [Git.repoRemoteNameSet "web" Git.Construct.fromUnknown]
 
 gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
 gen r _ _ = 

git-annex-shell.hs

@@ -9,7 +9,7 @@ import System.Environment
 import System.Console.GetOpt
 
 import Common.Annex
-import qualified Git
+import qualified Git.Construct
 import CmdLine
 import Command
 import Annex.UUID
@@ -80,7 +80,7 @@ builtin :: String -> String -> [String] -> IO ()
 builtin cmd dir params = do
 	checkNotReadOnly cmd
 	dispatch (cmd : filterparams params) cmds options header $
-		Git.repoAbsPath dir >>= Git.repoFromAbsPath
+		Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
 
 external :: [String] -> IO ()
 external params = do

git-annex.cabal

@@ -1,5 +1,5 @@
 Name: git-annex
-Version: 3.20111211
+Version: 3.20111212
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>

git-union-merge.hs

@@ -9,6 +9,8 @@ import System.Environment
 
 import Common
 import qualified Git.UnionMerge
+import qualified Git.Config
+import qualified Git.Construct
 import qualified Git
 
 header :: String
@@ -38,7 +40,7 @@ parseArgs = do
 main :: IO ()
 main = do
 	[aref, bref, newref] <- map Git.Ref <$> parseArgs
-	g <- Git.configRead =<< Git.repoFromCwd
+	g <- Git.Config.read =<< Git.Construct.fromCwd
 	_ <- Git.useIndex (tmpIndex g)
 	setup g
 	Git.UnionMerge.merge aref bref g

test.hs

@@ -25,6 +25,8 @@ import qualified Annex
 import qualified Annex.UUID
 import qualified Backend
 import qualified Git
+import qualified Git.Config
+import qualified Git.Construct
 import qualified Locations
 import qualified Types.Backend
 import qualified Types
@@ -496,8 +498,8 @@ git_annex command params = do
 -- are not run; this should only be used for actions that query state.
 annexeval :: Types.Annex a -> IO a
 annexeval a = do
-	g <- Git.repoFromCwd
-	g' <- Git.configRead g
+	g <- Git.Construct.fromCwd
+	g' <- Git.Config.read g
 	s <- Annex.new g'
 	Annex.eval s a