diff options
Diffstat (limited to 'Git/CurrentRepo.hs')
-rw-r--r-- | Git/CurrentRepo.hs | 44 |
1 files changed, 35 insertions, 9 deletions
diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs index 69a679e..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 } + 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 } |