1 files changed, 36 insertions, 10 deletions

diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs
index dab4ad2..054a81e 100644
--- a/Git/CurrentRepo.hs
+++ b/Git/CurrentRepo.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2012 Joey Hess <id@joeyh.name>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - Licensed under the GNU AGPL version 3 or higher.
  -}
 
 module Git.CurrentRepo where
@@ -12,6 +12,7 @@ import Git.Types
 import Git.Construct
 import qualified Git.Config
 import Utility.Env
+import Utility.Env.Set
 
 {- Gets the current git repository.
  -
@@ -24,12 +25,20 @@ import Utility.Env
  - 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.
+ -
+ - Also works around a git bug when running some hooks. It
+ - runs the hooks in the top of the repository, but if GIT_WORK_TREE
+ - was relative (but not "."), it then points to the wrong directory.
+ - In this situation GIT_PREFIX contains the directory that 
+ - GIT_WORK_TREE is relative to.
  -}
 get :: IO Repo
 get = do
-	gd <- pathenv "GIT_DIR"
+	gd <- getpathenv "GIT_DIR"
 	r <- configure gd =<< fromCwd
-	wt <- maybe (worktree $ location r) Just <$> pathenv "GIT_WORK_TREE"
+	prefix <- getpathenv "GIT_PREFIX"
+	wt <- maybe (fromRawFilePath <$> worktree (location r)) Just
+		<$> getpathenvprefix "GIT_WORK_TREE" prefix
 	case wt of
 		Nothing -> return r
 		Just d -> do
@@ -38,22 +47,39 @@ get = do
 				setCurrentDirectory d
 			return $ addworktree wt r
   where
-	pathenv s = do
+	getpathenv s = do
 		v <- getEnv s
 		case v of
 			Just d -> do
 				unsetEnv s
-				Just <$> absPath d
+				return (Just d)
+			Nothing -> return Nothing
+	
+	getpathenvprefix s (Just prefix) | not (null prefix) =
+		getpathenv s >>= \case
 			Nothing -> return Nothing
+			Just d
+				| d == "." -> return (Just d)
+				| otherwise -> Just <$> absPath (prefix </> d)
+	getpathenvprefix s _ = getpathenv s
 
 	configure Nothing (Just r) = Git.Config.read r
 	configure (Just d) _ = do
 		absd <- absPath d
 		curr <- getCurrentDirectory
-		Git.Config.read $ newFrom $
-			Local { gitdir = absd, worktree = Just curr }
-	configure Nothing Nothing = error "Not in a git repository."
+		r <- Git.Config.read $ newFrom $
+			Local
+				{ gitdir = toRawFilePath absd
+				, worktree = Just (toRawFilePath curr)
+				}
+		return $ if Git.Config.isBare r
+			then r { location = (location r) { worktree = Nothing } }
+			else r
+
+	configure Nothing Nothing = giveup "Not in a git repository."
 
-	addworktree w r = changelocation r $
-		Local { gitdir = gitdir (location r), worktree = w }
+	addworktree w r = changelocation r $ Local
+		{ gitdir = gitdir (location r)
+		, worktree = fmap toRawFilePath w
+		}
 	changelocation r l = r { location = l }