removed another 10 lines via ifM

Git.hs

@@ -31,7 +31,6 @@ module Git (
 import qualified Data.Map as M
 import Data.Char
 import Network.URI (uriPath, uriScheme, unEscapeString)
-import System.Directory
 import System.Posix.Files
 
 import Common
@@ -83,11 +82,14 @@ repoIsLocalBare r@(Repo { location = Dir _ }) = configAvail r && configBare r
 repoIsLocalBare _ = False
 
 assertLocal :: Repo -> a -> a
-assertLocal repo action = 
-	if not $ repoIsUrl repo
-		then action
-		else error $ "acting on non-local git repo " ++  repoDescribe repo ++ 
-				" not supported"
+assertLocal repo action
+	| repoIsUrl repo = error $ unwords
+		[ "acting on non-local git repo"
+		, repoDescribe repo
+		, "not supported"
+		]
+	| otherwise = action
+
 configBare :: Repo -> Bool
 configBare repo = maybe unknown (fromMaybe False . configTrue) $
 	M.lookup "core.bare" $ config repo
@@ -113,12 +115,10 @@ gitDir repo
 hookPath :: String -> Repo -> IO (Maybe FilePath)
 hookPath script repo = do
 	let hook = gitDir repo </> "hooks" </> script
-	e <- doesFileExist hook
-	if e
-		then do
-			m <- fileMode <$> getFileStatus hook
-			return $ if isExecutable m then Just hook else Nothing
-		else return Nothing
+	ifM (catchBoolIO $ isexecutable hook)
+		( return $ Just hook , return Nothing )
+	where
+		isexecutable f = isExecutable . fileMode <$> getFileStatus f
 
 {- Path to a repository's --work-tree, that is, its top.
  -

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

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
 

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

Init.hs

@@ -58,13 +58,13 @@ gitPreCommitHookWrite = unlessBare $ do
 gitPreCommitHookUnWrite :: Annex ()
 gitPreCommitHookUnWrite = unlessBare $ do
 	hook <- preCommitHook
-	whenM (liftIO $ doesFileExist hook) $ do
-		c <- liftIO $ readFile hook
-		if c == preCommitScript
-			then liftIO $ removeFile hook
-			else warning $ "pre-commit hook (" ++ hook ++ 
+	whenM (liftIO $ doesFileExist hook) $
+		ifM (liftIO $ (==) preCommitScript <$> readFile hook)
+			( liftIO $ removeFile hook
+			, warning $ "pre-commit hook (" ++ hook ++ 
 				") contents modified; not deleting." ++
 				" Edit it to remove call to git annex."
+			)
 
 unlessBare :: Annex () -> Annex ()
 unlessBare = unlessM $ fromRepo Git.repoIsLocalBare

Logs/Presence.hs

@@ -99,10 +99,9 @@ type LogMap = M.Map String LogLine
 {- Inserts a log into a map of logs, if the log has better (ie, newer)
  - information than the other logs in the map -}
 mapLog :: LogLine -> LogMap -> LogMap
-mapLog l m = 
-	if better
-		then M.insert i l m
-		else m
+mapLog l m
+	| better = M.insert i l m
+	| otherwise = m
 	where
 		better = maybe True newer $ M.lookup i m
 		newer l' = date l' <= date l

Logs/Remote.hs

@@ -72,14 +72,15 @@ configUnEscape = unescape
 		unescape (c:rest)
 			| c == '&' = entity rest
 			| otherwise = c : unescape rest
-		entity s = if ok
-				then chr (Prelude.read num) : unescape rest
-				else '&' : unescape s
+		entity s
+			| not (null num) && ";" `isPrefixOf` r =
+				chr (Prelude.read num) : unescape rest
+			| otherwise =
+				'&' : unescape s
 			where
 				num = takeWhile isNumber s
 				r = drop (length num) s
 				rest = drop 1 r
-				ok = not (null num) && ";" `isPrefixOf` r
 
 {- for quickcheck -}
 prop_idempotent_configEscape :: String -> Bool

Upgrade/V0.hs

@@ -35,14 +35,11 @@ lookupFile0 :: FilePath -> Annex (Maybe (Key, Backend))
 lookupFile0 = Upgrade.V1.lookupFile1
 
 getKeysPresent0 :: FilePath -> Annex [Key]
-getKeysPresent0 dir = do
-	exists <- liftIO $ doesDirectoryExist dir
-	if not exists
-		then return []
-		else do
-			contents <- liftIO $ getDirectoryContents dir
-			files <- liftIO $ filterM present contents
-			return $ map fileKey0 files
+getKeysPresent0 dir = ifM (liftIO $ doesDirectoryExist dir)
+	( liftIO $ map fileKey0
+		<$> (filterM present =<< getDirectoryContents dir)
+	, return []
+	)
 	where
 		present d = do
 			result <- tryIO $

Upgrade/V1.hs

@@ -50,18 +50,18 @@ upgrade :: Annex Bool
 upgrade = do
 	showAction "v1 to v2"
 	
-	bare <- fromRepo Git.repoIsLocalBare
-	if bare
-		then do
+	ifM (fromRepo Git.repoIsLocalBare)
+		( do
 			moveContent
 			setVersion
-		else do
+		, do
 			moveContent
 			updateSymlinks
 			moveLocationLogs
 	
 			Annex.Queue.flush True
 			setVersion
+		)
 	
 	Upgrade.V2.upgrade
 
@@ -104,12 +104,11 @@ moveLocationLogs = do
 		where
 			oldlocationlogs = do
 				dir <- fromRepo Upgrade.V2.gitStateDir
-				exists <- liftIO $ doesDirectoryExist dir
-				if exists
-					then do
-						contents <- liftIO $ getDirectoryContents dir
-						return $ mapMaybe oldlog2key contents
-					else return []
+				ifM (liftIO $ doesDirectoryExist dir)
+					( mapMaybe oldlog2key
+						<$> (liftIO $ getDirectoryContents dir)
+					, return []
+					)
 			move (l, k) = do
 				dest <- fromRepo $ logFile2 k
 				dir <- fromRepo Upgrade.V2.gitStateDir
@@ -127,14 +126,13 @@ moveLocationLogs = do
 				Annex.Queue.add "rm" [Param "--quiet", Param "-f", Param "--"] [f]
 		
 oldlog2key :: FilePath -> Maybe (FilePath, Key)
-oldlog2key l = 
-	let len = length l - 4 in
-		if drop len l == ".log"
-		then let k = readKey1 (take len l) in
-			if null (keyName k) || null (keyBackendName k)
-			then Nothing
-			else Just (l, k)
-		else Nothing
+oldlog2key l
+	| drop len l == ".log" && sane = Just (l, k)
+	| otherwise = Nothing
+	where
+		len = length l - 4
+		k = readKey1 (take len l)
+		sane = (not . null $ keyName k) && (not . null $ keyBackendName k)
 
 -- WORM backend keys: "WORM:mtime:size:filename"
 -- all the rest: "backend:key"
@@ -143,10 +141,14 @@ oldlog2key l =
 -- v2 and v1; that infelicity is worked around by treating the value
 -- as the v2 key that it is.
 readKey1 :: String -> Key
-readKey1 v = 
-	if mixup
-		then fromJust $ readKey $ join ":" $ Prelude.tail bits
-		else Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t }
+readKey1 v
+	| mixup = fromJust $ readKey $ join ":" $ Prelude.tail bits
+	| otherwise = Key
+		{ keyName = n
+		, keyBackendName = b
+		, keySize = s
+		, keyMtime = t
+		}
 	where
 		bits = split ":" v
 		b = Prelude.head bits
@@ -205,14 +207,14 @@ lookupFile1 file = do
 getKeyFilesPresent1 :: Annex [FilePath]
 getKeyFilesPresent1  = getKeyFilesPresent1' =<< fromRepo gitAnnexObjectDir
 getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
-getKeyFilesPresent1' dir = do
-	exists <- liftIO $ doesDirectoryExist dir
-	if not exists
-		then return []
-		else do
+getKeyFilesPresent1' dir =
+	ifM (liftIO $ doesDirectoryExist dir)
+		(  do
 			dirs <- liftIO $ getDirectoryContents dir
 			let files = map (\d -> dir ++ "/" ++ d ++ "/" ++ takeFileName d) dirs
 			liftIO $ filterM present files
+		, return []
+		)
 	where
 		present f = do
 			result <- tryIO $ getFileStatus f