diff options
author | Joey Hess <joey@kitenet.net> | 2012-03-16 01:59:07 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-03-16 01:59:07 -0400 |
commit | 184a69171d5d983ee2f08cce28011d235f44cc5c (patch) | |
tree | ff85fc620618b55c8cbed0d8c99212e73004f5b5 /Git | |
parent | c0c9991c9f5322aef05f4c97d2c3f3bdc3101e46 (diff) |
removed another 10 lines via ifM
Diffstat (limited to 'Git')
-rw-r--r-- | Git/Branch.hs | 10 | ||||
-rw-r--r-- | Git/Config.hs | 13 | ||||
-rw-r--r-- | Git/Construct.hs | 59 |
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 |