split more stuff out of Git.hs

Annex/Branch.hs

@@ -28,6 +28,7 @@ import qualified Git.Ref
 import qualified Git.Branch
 import qualified Git.UnionMerge
 import qualified Git.HashObject
+import qualified Git.Index
 import Annex.CatFile
 
 {- Name of the branch that is used to store git-annex's information. -}
@@ -249,7 +250,7 @@ withIndex = withIndex' False
 withIndex' :: Bool -> Annex a -> Annex a
 withIndex' bootstrapping a = do
 	f <- fromRepo gitAnnexIndex
-	bracketIO (Git.useIndex f) id $ do
+	bracketIO (Git.Index.override f) id $ do
 		unlessM (liftIO $ doesFileExist f) $ do
 			unless bootstrapping create
 			liftIO $ createDirectoryIfMissing True $ takeDirectory f

Annex/Ssh.hs

@@ -10,6 +10,7 @@ module Annex.Ssh where
 import Control.Monad.State (liftIO)
 
 import qualified Git
+import qualified Git.Url
 import Utility.SafeCommand
 import Types
 import Config
@@ -22,10 +23,10 @@ sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam]
 sshToRepo repo sshcmd = do
 	s <- getConfig repo "ssh-options" ""
 	let sshoptions = map Param (words s)
-	let sshport = case Git.urlPort repo of
+	let sshport = case Git.Url.port repo of
 		Nothing -> []
 		Just p -> [Param "-p", Param (show p)]
-	let sshhost = Param $ Git.urlHostUser repo
+	let sshhost = Param $ Git.Url.hostuser repo
 	return $ sshoptions ++ sshport ++ [sshhost] ++ sshcmd
 
 {- Generates parameters to run a git-annex-shell command on a remote

Backend.hs

@@ -20,7 +20,6 @@ import System.IO.Error (try)
 import System.Posix.Files
 
 import Common.Annex
-import qualified Git
 import qualified Git.Config
 import qualified Git.CheckAttr
 import qualified Annex

Command/Map.hs

@@ -13,6 +13,7 @@ import qualified Data.Map as M
 import Common.Annex
 import Command
 import qualified Git
+import qualified Git.Url
 import qualified Git.Config
 import qualified Git.Construct
 import Annex.UUID
@@ -68,7 +69,7 @@ drawMap rs umap ts = Dot.graph $ repos ++ trusted ++ others
 
 hostname :: Git.Repo -> String
 hostname r
-	| Git.repoIsUrl r = Git.urlHost r
+	| Git.repoIsUrl r = Git.Url.host r
 	| otherwise = "localhost"
 
 basehostname :: Git.Repo -> String
@@ -82,7 +83,7 @@ repoName umap r
 	| otherwise = M.findWithDefault fallback repouuid umap
 	where
 		repouuid = getUncachedUUID r
-		fallback = fromMaybe "unknown" $ Git.repoRemoteName r
+		fallback = fromMaybe "unknown" $ Git.remoteName r
 
 {- A unique id for the node for a repo. Uses the annex.uuid if available. -}
 nodeId :: Git.Repo -> String
@@ -99,7 +100,7 @@ node umap fullinfo r = unlines $ n:edges
 			decorate $ Dot.graphNode (nodeId r) (repoName umap r)
 		edges = map (edge umap fullinfo r) (Git.remotes r)
 		decorate
-			| Git.configMap r == M.empty = unreachable
+			| Git.config r == M.empty = unreachable
 			| otherwise = reachable
 
 {- An edge between two repos. The second repo is a remote of the first. -}
@@ -116,7 +117,7 @@ edge umap fullinfo from to =
 		{- Only name an edge if the name is different than the name
 		 - that will be used for the destination node, and is
 		 - different from its hostname. (This reduces visual clutter.) -}
-		edgename = maybe Nothing calcname $ Git.repoRemoteName to
+		edgename = maybe Nothing calcname $ Git.remoteName to
 		calcname n
 			| n `elem` [repoName umap fullto, hostname fullto] = Nothing
 			| otherwise = Just n
@@ -141,7 +142,7 @@ spider' (r:rs) known
 		-- The remotes will be relative to r', and need to be
 		-- made absolute for later use.
 		remotes <- mapM (absRepo r') (Git.remotes r')
-		let r'' = Git.remotesAdd r' remotes
+		let r'' = r' { Git.remotes = remotes }
 
 		spider' (rs ++ remotes) (r'':known)
 
@@ -154,7 +155,7 @@ absRepo reference r
 {- Checks if two repos are the same. -}
 same :: Git.Repo -> Git.Repo -> Bool
 same a b
-	| both Git.repoIsSsh = matching Git.urlAuthority && matching Git.workTree
+	| both Git.repoIsSsh = matching Git.Url.authority && matching Git.workTree
 	| both Git.repoIsUrl && neither Git.repoIsSsh = matching show
 	| neither Git.repoIsSsh = matching Git.workTree
 	| otherwise = False

Config.hs

@@ -31,7 +31,7 @@ getConfig r key def = do
 
 {- Looks up a per-remote config setting in git config. -}
 remoteConfig :: Git.Repo -> ConfigKey -> String
-remoteConfig r key = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-" ++ key
+remoteConfig r key = "remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" ++ key
 
 {- Calculates cost for a remote. Either the default, or as configured 
  - by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command

Git.hs

@@ -9,7 +9,7 @@
  -}
 
 module Git (
-	Repo,
+	Repo(..),
 	Ref(..),
 	Branch,
 	Sha,
@@ -22,13 +22,6 @@ module Git (
 	repoLocation,
 	workTree,
 	gitDir,
-	urlPath,
-	urlHost,
-	urlPort,
-	urlHostUser,
-	urlAuthority,
-	urlScheme,
-	configMap,
 	configTrue,
 	gitCommandLine,
 	run,
@@ -39,23 +32,14 @@ module Git (
 	pipeNullSplit,
 	pipeNullSplitB,
 	attributes,
-	remotes,
-	remotesAdd,
-	repoRemoteName,
-	repoRemoteNameSet,
-	repoRemoteNameFromKey,
 	reap,
-	useIndex,
-	getSha,
-	shaSize,
 	assertLocal,
 ) where
 
 import qualified Data.Map as M
-import Network.URI
 import Data.Char
-import System.Posix.Env (setEnv, unsetEnv, getEnv)
 import qualified Data.ByteString.Lazy.Char8 as L
+import Network.URI (uriPath, uriScheme)
 
 import Common
 import Git.Types
@@ -73,29 +57,6 @@ repoLocation Repo { location = Url url } = show url
 repoLocation Repo { location = Dir dir } = dir
 repoLocation Repo { location = Unknown } = undefined
 
-{- Constructs and returns an updated version of a repo with
- - different remotes list. -}
-remotesAdd :: Repo -> [Repo] -> Repo
-remotesAdd repo rs = repo { remotes = rs }
-
-{- Returns the name of the remote that corresponds to the repo, if
- - it is a remote. -}
-repoRemoteName :: Repo -> Maybe String
-repoRemoteName Repo { remoteName = Just name } = Just name
-repoRemoteName _ = Nothing
-
-{- Sets the name of a remote. -}
-repoRemoteNameSet :: String -> Repo -> Repo
-repoRemoteNameSet n r = r { remoteName = Just n }
-
-{- Sets the name of a remote based on the git config key, such as
-   "remote.foo.url". -}
-repoRemoteNameFromKey :: String -> Repo -> Repo
-repoRemoteNameFromKey k = repoRemoteNameSet basename
-	where
-		basename = join "." $ reverse $ drop 1 $
-				reverse $ drop 1 $ split "." k
-
 {- Some code needs to vary between URL and normal repos,
  - or bare and non-bare, these functions help with that. -}
 repoIsUrl :: Repo -> Bool
@@ -104,11 +65,13 @@ repoIsUrl _ = False
 
 repoIsSsh :: Repo -> Bool
 repoIsSsh Repo { location = Url url } 
-	| uriScheme url == "ssh:" = True
+	| scheme == "ssh:" = True
 	-- git treats these the same as ssh
-	| uriScheme url == "git+ssh:" = True
-	| uriScheme url == "ssh+git:" = True
+	| scheme == "git+ssh:" = True
+	| scheme == "ssh+git:" = True
 	| otherwise = False
+	where
+		scheme = uriScheme url
 repoIsSsh _ = False
 
 repoIsHttp :: Repo -> Bool
@@ -129,15 +92,8 @@ assertLocal :: Repo -> a -> a
 assertLocal repo action = 
 	if not $ repoIsUrl repo
 		then action
-		else error $ "acting on URL git repo " ++  repoDescribe repo ++ 
+		else error $ "acting on non-local git repo " ++  repoDescribe repo ++ 
 				" not supported"
-assertUrl :: Repo -> a -> a
-assertUrl repo action = 
-	if repoIsUrl repo
-		then action
-		else error $ "acting on local git repo " ++  repoDescribe repo ++ 
-				" not supported"
-
 configBare :: Repo -> Bool
 configBare repo = maybe unknown configTrue $ M.lookup "core.bare" $ config repo
 	where
@@ -161,61 +117,10 @@ gitDir repo
  -
  - Note that for URL repositories, this is the path on the remote host. -}
 workTree :: Repo -> FilePath
-workTree r@(Repo { location = Url _ }) = urlPath r
-workTree (Repo { location = Dir d }) = d
+workTree Repo { location = Url u } = uriPath u
+workTree Repo { location = Dir d } = d
 workTree Repo { location = Unknown } = undefined
 
-{- Path of an URL repo. -}
-urlPath :: Repo -> String
-urlPath Repo { location = Url u } = uriPath u
-urlPath repo = assertUrl repo $ error "internal"
-
-{- Scheme of an URL repo. -}
-urlScheme :: Repo -> String
-urlScheme Repo { location = Url u } = uriScheme u
-urlScheme repo = assertUrl repo $ error "internal"
-
-{- Work around a bug in the real uriRegName
- - <http://trac.haskell.org/network/ticket/40> -}
-uriRegName' :: URIAuth -> String
-uriRegName' a = fixup $ uriRegName a
-	where
-		fixup x@('[':rest)
-			| rest !! len == ']' = take len rest
-			| otherwise = x
-			where
-				len  = length rest - 1
-		fixup x = x
-
-{- Hostname of an URL repo. -}
-urlHost :: Repo -> String
-urlHost = urlAuthPart uriRegName'
-
-{- Port of an URL repo, if it has a nonstandard one. -}
-urlPort :: Repo -> Maybe Integer
-urlPort r = 
-	case urlAuthPart uriPort r of
-		":" -> Nothing
-		(':':p) -> readMaybe p
-		_ -> Nothing
-
-{- Hostname of an URL repo, including any username (ie, "user@host") -}
-urlHostUser :: Repo -> String
-urlHostUser r = urlAuthPart uriUserInfo r ++ urlAuthPart uriRegName' r
-
-{- The full authority portion an URL repo. (ie, "user@host:port") -}
-urlAuthority :: Repo -> String
-urlAuthority = urlAuthPart assemble
-	where
-		assemble a = uriUserInfo a ++ uriRegName' a ++ uriPort a
-
-{- Applies a function to extract part of the uriAuthority of an URL repo. -}
-urlAuthPart :: (URIAuth -> a) -> Repo -> a
-urlAuthPart a Repo { location = Url u } = a auth
-	where
-		auth = fromMaybe (error $ "bad url " ++ show u) (uriAuthority u)
-urlAuthPart _ repo = assertUrl repo $ error "internal"
-
 {- Constructs a git command line operating on the specified repo. -}
 gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
 gitCommandLine params repo@(Repo { location = Dir _ } ) =
@@ -284,39 +189,6 @@ reap = do
 	r <- catchDefaultIO (getAnyProcessStatus False True) Nothing
 	maybe (return ()) (const reap) r
 
-{- Forces git to use the specified index file.
- - Returns an action that will reset back to the default
- - index file. -}
-useIndex :: FilePath -> IO (IO ())
-useIndex index = do
-	res <- getEnv var
-	setEnv var index True
-	return $ reset res
-	where
-		var = "GIT_INDEX_FILE"
-		reset (Just v) = setEnv var v True
-		reset _ = unsetEnv var
-
-{- Runs an action that causes a git subcommand to emit a sha, and strips
-   any trailing newline, returning the sha. -}
-getSha :: String -> IO String -> IO Sha
-getSha subcommand a = do
-	t <- a
-	let t' = if last t == '\n'
-		then init t
-		else t
-	when (length t' /= shaSize) $
-		error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")"
-	return $ Ref t'
-
-{- Size of a git sha. -}
-shaSize :: Int
-shaSize = 40
-
 {- Checks if a string from git config is a true value. -}
 configTrue :: String -> Bool
 configTrue s = map toLower s == "true"
-
-{- Access to raw config Map -}
-configMap :: Repo -> M.Map String String
-configMap = config

Git/Branch.hs

@@ -11,6 +11,7 @@ import qualified Data.ByteString.Lazy.Char8 as L
 
 import Common
 import Git
+import Git.Sha
 
 {- Checks if the second branch has any commits not present on the first
  - branch. -}
@@ -19,7 +20,7 @@ changed origbranch newbranch repo
 	| origbranch == newbranch = return False
 	| otherwise = not . L.null <$> diffs
 	where
-		diffs = Git.pipeRead
+		diffs = pipeRead
 			[ Param "log"
 			, Param (show origbranch ++ ".." ++ show newbranch)
 			, Params "--oneline -n1"
@@ -44,7 +45,7 @@ fastForward branch (first:rest) repo = do
 	where
 		no_ff = return False
 		do_ff to = do
-			Git.run "update-ref"
+			run "update-ref"
 				[Param $ show branch, Param $ show to] repo
 			return True
 		findbest c [] = return $ Just c

Git/CatFile.hs

@@ -20,6 +20,7 @@ import qualified Data.ByteString.Char8 as S
 import qualified Data.ByteString.Lazy.Char8 as L
 
 import Git
+import Git.Sha
 import Utility.SafeCommand
 
 type CatFileHandle = (PipeHandle, Handle, Handle)
@@ -27,7 +28,7 @@ type CatFileHandle = (PipeHandle, Handle, Handle)
 {- Starts git cat-file running in batch mode in a repo and returns a handle. -}
 catFileStart :: Repo -> IO CatFileHandle
 catFileStart repo = hPipeBoth "git" $ toCommand $
-	Git.gitCommandLine [Param "cat-file", Param "--batch"] repo
+	gitCommandLine [Param "cat-file", Param "--batch"] repo
 
 {- Stops git cat-file. -}
 catFileStop :: CatFileHandle -> IO ()
@@ -49,7 +50,7 @@ catObject (_, from, to) object = do
 	header <- hGetLine from
 	case words header of
 		[sha, objtype, size]
-			| length sha == Git.shaSize &&
+			| length sha == shaSize &&
 			  validobjtype objtype -> handle size
 			| otherwise -> empty
 		_

Git/Construct.hs

@@ -11,6 +11,8 @@ module Git.Construct (
 	fromUrl,
 	fromUnknown,
 	localToUrl,
+	remoteNamed,
+	remoteNamedFromKey,
 	fromRemotes,
 	fromRemoteLocation,
 	repoAbsPath,
@@ -23,6 +25,7 @@ import Network.URI
 import Common
 import Git.Types
 import Git
+import qualified Git.Url as Url
 
 {- Finds the current git repository, which may be in a parent directory. -}
 fromCwd :: IO Repo
@@ -67,8 +70,8 @@ fromUrl url
 			bad = error $ "bad url " ++ url
 
 {- Creates a repo that has an unknown location. -}
-fromUnknown :: Repo
-fromUnknown = newFrom Unknown
+fromUnknown :: IO Repo
+fromUnknown = return $ newFrom Unknown
 
 {- Converts a local Repo into a remote repo, using the reference repo
  - which is assumed to be on the same host. -}
@@ -79,8 +82,8 @@ localToUrl reference r
 	| otherwise = r { location = Url $ fromJust $ parseURI absurl }
 	where
 		absurl =
-			urlScheme reference ++ "//" ++
-			urlAuthority reference ++
+			Url.scheme reference ++ "//" ++
+			Url.authority reference ++
 			workTree r
 
 {- Calculates a list of a repo's configured remotes, by parsing its config. -}
@@ -91,7 +94,21 @@ fromRemotes repo = mapM construct remotepairs
 		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
+		construct (k,v) = remoteNamedFromKey k $ fromRemoteLocation v repo
+
+{- Sets the name of a remote when constructing the Repo to represent it. -}
+remoteNamed :: String -> IO Repo -> IO Repo
+remoteNamed n constructor = do
+	r <- constructor
+	return $ r { remoteName = Just n }
+
+{- Sets the name of a remote based on the git config key, such as
+   "remote.foo.url". -}
+remoteNamedFromKey :: String -> IO Repo -> IO Repo
+remoteNamedFromKey k = remoteNamed basename
+	where
+		basename = join "." $ reverse $ drop 1 $
+				reverse $ drop 1 $ split "." k
 
 {- Constructs a new Repo for one of a Repo's remotes using a given
  - location (ie, an url). -}

Git/HashObject.hs

@@ -17,10 +17,10 @@ hashFiles paths repo = do
 	(pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object repo
 	_ <- forkProcess (feeder toh)
 	hClose toh
-	shas <- map Git.Ref . lines <$> hGetContentsStrict fromh
+	shas <- map Ref . lines <$> hGetContentsStrict fromh
 	return (shas, ender fromh pid)
 	where
-		git_hash_object = Git.gitCommandLine
+		git_hash_object = gitCommandLine
 			[Param "hash-object", Param "-w", Param "--stdin-paths"]
 		feeder toh = do
 			hPutStr toh $ unlines paths

Git/Index.hs

@@ -0,0 +1,24 @@
+{- git index file stuff
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Index where
+
+import System.Posix.Env (setEnv, unsetEnv, getEnv)
+
+{- Forces git to use the specified index file.
+ -
+ - Returns an action that will reset back to the default
+ - index file. -}
+override :: FilePath -> IO (IO ())
+override index = do
+	res <- getEnv var
+	setEnv var index True
+	return $ reset res
+	where
+		var = "GIT_INDEX_FILE"
+		reset (Just v) = setEnv var v True
+		reset _ = unsetEnv var

Git/Ref.hs

@@ -37,11 +37,11 @@ sha branch repo = process . L.unpack <$> showref repo
 
 {- List of (refs, branches) matching a given ref spec.
  - Duplicate refs are filtered out. -}
-matching :: Ref -> Repo -> IO [(Git.Ref, Git.Branch)]
+matching :: Ref -> Repo -> IO [(Ref, Branch)]
 matching ref repo = do
-	r <- Git.pipeRead [Param "show-ref", Param $ show ref] repo
+	r <- pipeRead [Param "show-ref", Param $ show ref] repo
 	return $ nubBy uref $ map (gen . words . L.unpack) (L.lines r)
 	where
-		gen l = (Git.Ref $ head l, Git.Ref $ last l)
+		gen l = (Ref $ head l, Ref $ last l)
 		uref (a, _) (b, _) = a == b
 

Git/Sha.hs

@@ -0,0 +1,27 @@
+{- git SHA stuff
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Sha where
+
+import Common
+import Git.Types
+
+{- Runs an action that causes a git subcommand to emit a sha, and strips
+   any trailing newline, returning the sha. -}
+getSha :: String -> IO String -> IO Sha
+getSha subcommand a = do
+	t <- a
+	let t' = if last t == '\n'
+		then init t
+		else t
+	when (length t' /= shaSize) $
+		error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")"
+	return $ Ref t'
+
+{- Size of a git sha. -}
+shaSize :: Int
+shaSize = 40

Git/UnionMerge.hs

@@ -20,6 +20,7 @@ import qualified Data.Set as S
 
 import Common
 import Git
+import Git.Sha
 import Git.CatFile
 
 type Streamer = (String -> IO ()) -> IO ()
@@ -27,7 +28,7 @@ type Streamer = (String -> IO ()) -> IO ()
 {- Performs a union merge between two branches, staging it in the index.
  - Any previously staged changes in the index will be lost.
  -
- - Should be run with a temporary index file configured by Git.useIndex.
+ - Should be run with a temporary index file configured by useIndex.
  -}
 merge :: Ref -> Ref -> Repo -> IO ()
 merge x y repo = do
@@ -53,7 +54,7 @@ update_index repo ls = stream_update_index repo [(`mapM_` ls)]
 {- Streams content into update-index. -}
 stream_update_index :: Repo -> [Streamer] -> IO ()
 stream_update_index repo as = do
-	(p, h) <- hPipeTo "git" (toCommand $ Git.gitCommandLine params repo)
+	(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
 	forM_ as (stream h)
 	hClose h
 	forceSuccess p

Git/Url.hs

@@ -0,0 +1,70 @@
+{- git repository urls
+ -
+ - Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Url (
+	scheme,
+	host,
+	port,
+	hostuser,
+	authority,
+) where
+
+import Network.URI hiding (scheme, authority)
+
+import Common
+import Git.Types
+import Git
+
+{- Scheme of an URL repo. -}
+scheme :: Repo -> String
+scheme Repo { location = Url u } = uriScheme u
+scheme repo = notUrl repo
+
+{- Work around a bug in the real uriRegName
+ - <http://trac.haskell.org/network/ticket/40> -}
+uriRegName' :: URIAuth -> String
+uriRegName' a = fixup $ uriRegName a
+	where
+		fixup x@('[':rest)
+			| rest !! len == ']' = take len rest
+			| otherwise = x
+			where
+				len  = length rest - 1
+		fixup x = x
+
+{- Hostname of an URL repo. -}
+host :: Repo -> String
+host = authpart uriRegName'
+
+{- Port of an URL repo, if it has a nonstandard one. -}
+port :: Repo -> Maybe Integer
+port r = 
+	case authpart uriPort r of
+		":" -> Nothing
+		(':':p) -> readMaybe p
+		_ -> Nothing
+
+{- Hostname of an URL repo, including any username (ie, "user@host") -}
+hostuser :: Repo -> String
+hostuser r = authpart uriUserInfo r ++ authpart uriRegName' r
+
+{- The full authority portion an URL repo. (ie, "user@host:port") -}
+authority :: Repo -> String
+authority = authpart assemble
+	where
+		assemble a = uriUserInfo a ++ uriRegName' a ++ uriPort a
+
+{- Applies a function to extract part of the uriAuthority of an URL repo. -}
+authpart :: (URIAuth -> a) -> Repo -> a
+authpart a Repo { location = Url u } = a auth
+	where
+		auth = fromMaybe (error $ "bad url " ++ show u) (uriAuthority u)
+authpart _ repo = notUrl repo
+
+notUrl :: Repo -> a
+notUrl repo = error $
+	"acting on local git repo " ++ repoDescribe repo ++ " not supported"

Remote/Git.hs

@@ -37,16 +37,17 @@ remote = RemoteType {
 
 list :: Annex [Git.Repo]
 list = do
-	c <- fromRepo Git.configMap
+	c <- fromRepo Git.config
 	mapM (tweakurl c) =<< fromRepo Git.remotes
 	where
 		annexurl n = "remote." ++ n ++ ".annexurl"
 		tweakurl c r = do
-			let n = fromJust $ Git.repoRemoteName r
+			let n = fromJust $ Git.remoteName r
 			case M.lookup (annexurl n) c of
 				Nothing -> return r
-				Just url -> Git.repoRemoteNameSet n <$>
-					inRepo (Git.Construct.fromRemoteLocation url)
+				Just url -> inRepo $ \g ->
+					Git.Construct.remoteNamed n $
+						Git.Construct.fromRemoteLocation url g
 
 gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
 gen r u _ = do
@@ -84,7 +85,7 @@ gen r u _ = do
  - returns the updated repo. -}
 tryGitConfigRead :: Git.Repo -> Annex Git.Repo
 tryGitConfigRead r 
-	| not $ M.null $ Git.configMap r = return r -- already read
+	| not $ M.null $ Git.config r = return r -- already read
 	| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
 	| Git.repoIsHttp r = store $ safely geturlconfig
 	| Git.repoIsUrl r = return r
@@ -116,13 +117,13 @@ tryGitConfigRead r
 			r' <- a
 			g <- gitRepo
 			let l = Git.remotes g
-			let g' = Git.remotesAdd g $ exchange l r'
+			let g' = g { Git.remotes = exchange l r' }
 			Annex.changeState $ \s -> s { Annex.repo = g' }
 			return r'
 
 		exchange [] _ = []
 		exchange (old:ls) new =
-			if Git.repoRemoteName old == Git.repoRemoteName new
+			if Git.remoteName old == Git.remoteName new
 				then new : exchange ls new
 				else old : exchange ls new
 
@@ -167,7 +168,7 @@ onLocal :: Git.Repo -> Annex a -> IO a
 onLocal r a = do
 	-- Avoid re-reading the repository's configuration if it was
 	-- already read.
-	state <- if M.null $ Git.configMap r
+	state <- if M.null $ Git.config r
 		then Annex.new r
 		else return $ Annex.newState r
 	Annex.eval state $ do

Remote/Helper/Special.hs

@@ -20,11 +20,11 @@ import qualified Git.Construct
  -}
 findSpecialRemotes :: String -> Annex [Git.Repo]
 findSpecialRemotes s = do
-	m <- fromRepo Git.configMap
-	return $ map construct $ remotepairs m
+	m <- fromRepo Git.config
+	liftIO $ mapM construct $ remotepairs m
 	where
 		remotepairs = M.toList . M.filterWithKey match
-		construct (k,_) = Git.repoRemoteNameFromKey k Git.Construct.fromUnknown
+		construct (k,_) = Git.Construct.remoteNamedFromKey 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

@@ -27,7 +27,9 @@ 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.Construct.fromUnknown]
+list = do
+	r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
+	return [r]
 
 gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
 gen r _ _ = 

git-union-merge.hs

@@ -12,6 +12,7 @@ import qualified Git.UnionMerge
 import qualified Git.Config
 import qualified Git.Construct
 import qualified Git.Branch
+import qualified Git.Index
 import qualified Git
 
 header :: String
@@ -42,7 +43,7 @@ main :: IO ()
 main = do
 	[aref, bref, newref] <- map Git.Ref <$> parseArgs
 	g <- Git.Config.read =<< Git.Construct.fromCwd
-	_ <- Git.useIndex (tmpIndex g)
+	_ <- Git.Index.override (tmpIndex g)
 	setup g
 	Git.UnionMerge.merge aref bref g
 	_ <- Git.Branch.commit "union merge" newref [aref, bref] g

test.hs

@@ -24,7 +24,6 @@ import qualified Utility.SafeCommand
 import qualified Annex
 import qualified Annex.UUID
 import qualified Backend
-import qualified Git
 import qualified Git.Config
 import qualified Git.Construct
 import qualified Git.Filename