git-annex, git-union-merge: Support GIT_DIR and GIT_WORK_TREE.

Note that GIT_WORK_TREE cannot influence GIT_DIR; that is necessary for
git-fake-bare and vcsh type things to work.

Git/Construct.hs

@@ -6,6 +6,7 @@
  -}
 
 module Git.Construct (
+	fromCurrent,
 	fromCwd,
 	fromAbsPath,
 	fromUrl,
@@ -19,6 +20,8 @@ module Git.Construct (
 ) where
 
 import System.Posix.User
+import System.Posix.Env (getEnv)
+import System.Posix.Directory (changeWorkingDirectory)
 import qualified Data.Map as M hiding (map, split)
 import Network.URI
 
@@ -27,7 +30,23 @@ import Git.Types
 import Git
 import qualified Git.Url as Url
 
-{- Finds the current git repository, which may be in a parent directory. -}
+{- Finds the current git repository.
+ -
+ - GIT_DIR can override the location of the .git directory.
+ -
+ - When GIT_WORK_TREE is set, chdir to it, so that anything using
+ - this repository runs in the right location. However, this chdir is
+ - done after determining GIT_DIR; git does not let GIT_WORK_TREE
+ - influence the git directory.
+ -}
+fromCurrent :: IO Repo
+fromCurrent = do
+	r <- maybe fromCwd fromAbsPath =<< getEnv "GIT_DIR"
+	maybe (return ()) changeWorkingDirectory =<< getEnv "GIT_WORK_TREE"
+	return r
+
+{- Finds the git repository used for the Cwd, which may be in a parent
+ - directory. -}
 fromCwd :: IO Repo
 fromCwd = getCurrentDirectory >>= seekUp isRepoTop >>= maybe norepo makerepo
 	where

GitAnnex.hs

@@ -129,4 +129,4 @@ header :: String
 header = "Usage: git-annex command [option ..]"
 
 run :: [String] -> IO ()
-run args = dispatch args cmds options header Git.Construct.fromCwd
+run args = dispatch args cmds options header Git.Construct.fromCurrent

debian/changelog

@@ -4,6 +4,7 @@ git-annex (3.20120107) UNRELEASED; urgency=low
   * map: Fix display of remote repos
   * Add annex-trustlevel configuration settings, which can be used to 
     override the trust level of a remote.
+  * git-annex, git-union-merge: Support GIT_DIR and GIT_WORK_TREE.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 07 Jan 2012 18:12:09 -0400
 

doc/bugs/on--git-dir_and_--work-tree_options.mdwn

@@ -27,3 +27,5 @@ regular git add works:
 
 git-annex version: 3.20110702
 
+> [[done]], git-annex now honors `GIT_DIR` and `GIT_WORK_TREE` like other
+> git commands do. --[[Joey]]

git-union-merge.hs

@@ -40,7 +40,7 @@ parseArgs = do
 main :: IO ()
 main = do
 	[aref, bref, newref] <- map Git.Ref <$> parseArgs
-	g <- Git.Config.read =<< Git.Construct.fromCwd
+	g <- Git.Config.read =<< Git.Construct.fromCurrent
 	_ <- Git.Index.override $ tmpIndex g
 	setup g
 	Git.UnionMerge.merge aref bref g

test.hs

@@ -727,7 +727,7 @@ git_annex_expectoutput command params expected = 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.Construct.fromCwd
+	g <- Git.Construct.fromCurrent
 	g' <- Git.Config.read g
 	s <- Annex.new g'
 	Annex.eval s { Annex.output = Annex.QuietOutput } a