summaryrefslogtreecommitdiff
path: root/Git
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-03-16 01:59:07 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-03-16 01:59:07 -0400
commit184a69171d5d983ee2f08cce28011d235f44cc5c (patch)
treeff85fc620618b55c8cbed0d8c99212e73004f5b5 /Git
parentc0c9991c9f5322aef05f4c97d2c3f3bdc3101e46 (diff)
removed another 10 lines via ifM
Diffstat (limited to 'Git')
-rw-r--r--Git/Branch.hs10
-rw-r--r--Git/Config.hs13
-rw-r--r--Git/Construct.hs59
3 files changed, 36 insertions, 46 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs
index cd9188228..6edc1c306 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -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
diff --git a/Git/Config.hs b/Git/Config.hs
index 0d73a0b9a..8190a62ad 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -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
diff --git a/Git/Construct.hs b/Git/Construct.hs
index ef6094a21..49905f818 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -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