Add support for core.worktree, and fix support for GIT_WORK_TREE and GIT_DIR.

The environment needs to override git-config. Changed when git config is
read, and avoid rereading it once it's been read.

chdir for both worktree settings.

1 files changed, 54 insertions, 0 deletions

diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs
new file mode 100644
index 000000000..4325f452c
--- /dev/null
+++ b/Git/CurrentRepo.hs
@@ -0,0 +1,54 @@
+{- The current git repository.
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.CurrentRepo where
+
+import System.Posix.Directory (changeWorkingDirectory)
+import System.Posix.Env (getEnv, unsetEnv)
+
+import Common
+import Git.Types
+import Git.Construct
+import qualified Git.Config
+
+{- Gets the current git repository.
+ -
+ - Honors GIT_DIR and GIT_WORK_TREE.
+ - Both environment variables are unset, to avoid confusing other git
+ - commands that also look at them. Instead, the Git module passes
+ - --work-tree and --git-dir to git commands it runs.
+ -
+ - When GIT_WORK_TREE or core.worktree are set, changes the working
+ - directory if necessary to ensure it is within the repository's work
+ - tree. While not needed for git commands, this is useful for anything
+ - else that looks for files in the worktree.
+ -}
+get :: IO Repo
+get = do
+	gd <- takeenv "GIT_DIR"
+	r <- configure gd =<< maybe fromCwd fromPath gd
+	wt <- maybe (worktree $ location r) Just <$> takeenv "GIT_WORK_TREE"
+	case wt of
+		Nothing -> return r
+		Just d -> do
+			changeWorkingDirectory d
+			return $ addworktree wt r
+	where
+		takeenv s = do
+			v <- getEnv s
+			when (isJust v) $
+				unsetEnv s
+			return v
+		configure Nothing r = Git.Config.read r
+		configure (Just d) r = do
+			r' <- Git.Config.read r
+			-- Let GIT_DIR override the default gitdir.
+			return $ changelocation r' $
+				Local { gitdir = d, worktree = worktree (location r') }
+		addworktree w r = changelocation r $
+			Local { gitdir = gitdir (location r), worktree = w }
+		changelocation r l = r { location = l }