diff options
| -rw-r--r-- | Git/Construct.hs | 53 | ||||
| -rw-r--r-- | debian/changelog | 1 |
2 files changed, 36 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 diff --git a/debian/changelog b/debian/changelog index fe1dd4c87..4e005e2f5 100644 --- a/debian/changelog +++ b/debian/changelog @@ -17,6 +17,7 @@ git-annex (3.20120826) UNRELEASED; urgency=low too long (and use relative path to minimise path to the control socket). * migrate: Check content before generating the new key, to avoid generating a key for corrupt data. + * Support repositories created with --separate-git-dir. Closes: #684405 -- Joey Hess <joeyh@debian.org> Mon, 27 Aug 2012 13:27:39 -0400 |