summaryrefslogtreecommitdiff
path: root/Git/Construct.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-09-15 22:40:04 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-09-15 22:40:04 -0400
commitda63b7e96c6f20a9e50f4c4a5c473c108b4b83e2 (patch)
treed898aec73c9cea72dcb5fd1858f9d1912fc5afd1 /Git/Construct.hs
parentba0334116cd8811d49b96cd39dd83e565e0bedb7 (diff)
Support repositories created with --separate-git-dir. Closes: #684405
Diffstat (limited to 'Git/Construct.hs')
-rw-r--r--Git/Construct.hs53
1 files changed, 35 insertions, 18 deletions
diff --git a/Git/Construct.hs b/Git/Construct.hs
index 90bedbde1..ce12f9b66 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -28,13 +28,19 @@ import Git.Types
import Git
import qualified Git.Url as Url
-{- Finds the git repository used for the Cwd, which may be in a parent
+{- 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
+fromCwd = getCurrentDirectory >>= seekUp checkForRepo
where
- makerepo = newFrom . LocalUnknown
norepo = error "Not in a git repository."
+ seekUp check dir = do
+ r <- check dir
+ case r of
+ Nothing -> case parentDir dir of
+ "" -> norepo
+ d -> seekUp check d
+ Just loc -> newFrom loc
{- Local Repo constructor, accepts a relative or absolute path. -}
fromPath :: FilePath -> IO Repo
@@ -201,22 +207,33 @@ expandTilde = expandt True
| c == '/' = (n, cs)
| otherwise = findname (n++[c]) cs
-seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
-seekUp want dir =
- ifM (want dir)
- ( return $ Just dir
- , case parentDir dir of
- "" -> return Nothing
- d -> seekUp want d
- )
-
-isRepoTop :: FilePath -> IO Bool
-isRepoTop dir = ifM isRepo ( return True , isBareRepo )
+checkForRepo :: FilePath -> IO (Maybe RepoLocation)
+checkForRepo dir =
+ check isRepo $
+ check gitDirFile $
+ check isBareRepo $
+ return Nothing
where
- isRepo = gitSignature (".git" </> "config")
- isBareRepo = ifM (doesDirectoryExist $ dir </> "objects")
- ( gitSignature "config" , return False )
- gitSignature file = doesFileExist (dir </> file)
+ check test cont = maybe cont (return . Just) =<< test
+ checkdir c = ifM c
+ ( return $ Just $ LocalUnknown dir
+ , return Nothing
+ )
+ isRepo = checkdir $ gitSignature $ ".git" </> "config"
+ isBareRepo = checkdir $ gitSignature "config"
+ <&&> doesDirectoryExist (dir </> "objects")
+ gitDirFile = do
+ c <- firstLine <$>
+ catchDefaultIO (readFile $ dir </> ".git") ""
+ return $ if gitdirprefix `isPrefixOf` c
+ then Just $ Local
+ { gitdir = drop (length gitdirprefix) c
+ , worktree = Just dir
+ }
+ else Nothing
+ where
+ gitdirprefix = "gitdir: "
+ gitSignature file = doesFileExist $ dir </> file
newFrom :: RepoLocation -> IO Repo
newFrom l = return Repo