From a4f3e112954e1b785c84c339bcbd83597a89335e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 3 Dec 2013 15:02:21 -0400 Subject: git-repair (1.20131203) unstable; urgency=low * Fix build deps. Closes: #731179 # imported from the archive --- Git/CurrentRepo.hs | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 Git/CurrentRepo.hs (limited to 'Git/CurrentRepo.hs') diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs new file mode 100644 index 0000000..ee91a6b --- /dev/null +++ b/Git/CurrentRepo.hs @@ -0,0 +1,67 @@ +{- The current git repository. + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Git.CurrentRepo where + +import Common +import Git.Types +import Git.Construct +import qualified Git.Config +#ifndef mingw32_HOST_OS +import Utility.Env +#endif + +{- 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 <- pathenv "GIT_DIR" + r <- configure gd =<< fromCwd + wt <- maybe (worktree $ location r) Just <$> pathenv "GIT_WORK_TREE" + case wt of + Nothing -> return r + Just d -> do + cwd <- getCurrentDirectory + unless (d `dirContains` cwd) $ + setCurrentDirectory d + return $ addworktree wt r + where +#ifndef mingw32_HOST_OS + pathenv s = do + v <- getEnv s + case v of + Just d -> do + void $ unsetEnv s + Just <$> absPath d + Nothing -> return Nothing +#else + pathenv _ = return Nothing +#endif + + configure Nothing (Just r) = Git.Config.read r + configure (Just d) _ = do + absd <- absPath d + cwd <- getCurrentDirectory + r <- newFrom $ Local { gitdir = absd, worktree = Just cwd } + Git.Config.read r + configure Nothing Nothing = error "Not in a git repository." + + addworktree w r = changelocation r $ + Local { gitdir = gitdir (location r), worktree = w } + changelocation r l = r { location = l } -- cgit v1.2.3