removed another 10 lines via ifM

This commit is contained in:
Joey Hess 2012-03-16 01:59:07 -04:00
parent c0c9991c9f
commit 184a69171d
9 changed files with 95 additions and 106 deletions

View file

@ -41,14 +41,14 @@ changed origbranch newbranch repo
-}
fastForward :: Branch -> [Ref] -> Repo -> IO Bool
fastForward _ [] _ = return True
fastForward branch (first:rest) repo = do
fastForward branch (first:rest) repo =
-- First, check that the branch does not contain any
-- new commits that are not in the first ref. If it does,
-- cannot fast-forward.
diverged <- changed first branch repo
if diverged
then no_ff
else maybe no_ff do_ff =<< findbest first rest
ifM (changed first branch repo)
( no_ff
, maybe no_ff do_ff =<< findbest first rest
)
where
no_ff = return False
do_ff to = do

View file

@ -26,16 +26,15 @@ getMaybe key repo = M.lookup key (config repo)
{- Runs git config and populates a repo with its config. -}
read :: Repo -> IO Repo
read repo@(Repo { location = Dir d }) = do
read repo@(Repo { location = Dir d }) = bracketcd d $
{- Cannot use pipeRead because it relies on the config having
been already read. Instead, chdir to the repo. -}
cwd <- getCurrentDirectory
if dirContains d cwd
then go
else bracket_ (changeWorkingDirectory d) (changeWorkingDirectory cwd) go
pOpen ReadFromPipe "git" ["config", "--null", "--list"] $ hRead repo
where
go = pOpen ReadFromPipe "git" ["config", "--null", "--list"] $
hRead repo
bracketcd to a = bracketcd' to a =<< getCurrentDirectory
bracketcd' to a cwd
| dirContains to cwd = a
| otherwise = bracket_ (changeWorkingDirectory to) (changeWorkingDirectory cwd) a
read r = assertLocal r $
error $ "internal error; trying to read config of " ++ show r

View file

@ -69,27 +69,25 @@ fromPath dir = fromAbsPath =<< absPath dir
- specified. -}
fromAbsPath :: FilePath -> IO Repo
fromAbsPath dir
| "/" `isPrefixOf` dir = do
-- Git always looks for "dir.git" in preference to
-- to "dir", even if dir ends in a "/".
let canondir = dropTrailingPathSeparator dir
let dir' = canondir ++ ".git"
e <- doesDirectoryExist dir'
if e
then ret dir'
else if "/.git" `isSuffixOf` canondir
then do
-- When dir == "foo/.git", git looks
-- for "foo/.git/.git", and failing
-- that, uses "foo" as the repository.
e' <- doesDirectoryExist $ dir </> ".git"
if e'
then ret dir
else ret $ takeDirectory canondir
else ret dir
| otherwise = error $ "internal error, " ++ dir ++ " is not absolute"
| "/" `isPrefixOf` dir =
ifM (doesDirectoryExist dir') ( ret dir' , hunt )
| otherwise =
error $ "internal error, " ++ dir ++ " is not absolute"
where
ret = newFrom . Dir
{- Git always looks for "dir.git" in preference to
- to "dir", even if dir ends in a "/". -}
canondir = dropTrailingPathSeparator dir
dir' = canondir ++ ".git"
{- When dir == "foo/.git", git looks for "foo/.git/.git",
- and failing that, uses "foo" as the repository. -}
hunt
| "/.git" `isSuffixOf` canondir =
ifM (doesDirectoryExist $ dir </> ".git")
( ret dir
, ret $ takeDirectory canondir
)
| otherwise = ret dir
{- Remote Repo constructor. Throws exception on invalid url.
-
@ -229,27 +227,20 @@ expandTilde = expandt True
| otherwise = findname (n++[c]) cs
seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
seekUp want dir = do
ok <- want dir
if ok
then return $ Just dir
else case parentDir dir of
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 = do
r <- isRepo
if r
then return r
else isBareRepo
isRepoTop dir = ifM isRepo ( return True , isBareRepo )
where
isRepo = gitSignature (".git" </> "config")
isBareRepo = do
e <- doesDirectoryExist (dir </> "objects")
if not e
then return e
else gitSignature "config"
isBareRepo = ifM (doesDirectoryExist $ dir </> "objects")
( gitSignature "config" , return False )
gitSignature file = doesFileExist (dir </> file)
newFrom :: RepoLocation -> IO Repo