added ifM and nuked 11 lines of code

no behavior changes

Annex/Content.hs

@@ -150,16 +150,16 @@ prepTmp key = do
 getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool
 getViaTmpUnchecked key action = do
 	tmp <- prepTmp key
-	success <- action tmp
-	if success
-		then do
+	ifM (action tmp)
+		( do
 			moveAnnex key tmp
 			logStatus key InfoPresent
 			return True
-		else do
+		, do
 			-- the tmp file is left behind, in case caller wants
 			-- to resume its transfer
 			return False
+		)
 
 {- Creates a temp file, runs an action on it, and cleans up the temp file. -}
 withTmp :: Key -> (FilePath -> Annex a) -> Annex a
@@ -230,15 +230,15 @@ moveAnnex :: Key -> FilePath -> Annex ()
 moveAnnex key src = do
 	dest <- inRepo $ gitAnnexLocation key
 	let dir = parentDir dest
-	e <- liftIO $ doesFileExist dest
-	if e
-		then liftIO $ removeFile src
-		else liftIO $ do
+	liftIO $ ifM (doesFileExist dest)
+		( removeFile src
+		, do
 			createDirectoryIfMissing True dir
 			allowWrite dir -- in case the directory already exists
 			moveFile src dest
 			preventWrite dest
 			preventWrite dir
+		)
 
 withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
 withObjectLoc key a = do
@@ -314,12 +314,12 @@ getKeysPresent = liftIO . traverse (2 :: Int) =<< fromRepo gitAnnexObjectDir
 saveState :: Bool -> Annex ()
 saveState oneshot = do
 	Annex.Queue.flush False
-	unless oneshot $ do
-		alwayscommit <- fromMaybe True . Git.configTrue
+	unless oneshot $
+		ifM alwayscommit
+			( Annex.Branch.commit "update" , Annex.Branch.stage)
+	where
+		alwayscommit = fromMaybe True . Git.configTrue
 			<$> fromRepo (Git.Config.get "annex.alwayscommit" "")
-		if alwayscommit
-			then Annex.Branch.commit "update"
-			else Annex.Branch.stage
 
 {- Downloads content from any of a list of urls. -}
 downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool
@@ -338,10 +338,9 @@ preseedTmp key file = go =<< inAnnex key
 			ok <- copy
 			when ok $ liftIO $ allowWrite file
 			return ok
-		copy = do
-			present <- liftIO $ doesFileExist file
-			if present
-				then return True
-				else do
+		copy = ifM (liftIO $ doesFileExist file)
+				( return True
+				, do
 					s <- inRepo $ gitAnnexLocation key
 					liftIO $ copyFileExternal s file
+				)

Annex/Ssh.hs

@@ -37,15 +37,17 @@ sshParams (host, port) opts = go =<< sshInfo (host, port)
 			sshCleanup
 
 sshInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
-sshInfo (host, port) = do
-	caching <- fromMaybe SysConfig.sshconnectioncaching . Git.configTrue
-		<$> fromRepo (Git.Config.get "annex.sshcaching" "")
-	if caching
-		then do
-			dir <- fromRepo gitAnnexSshDir
-			let socketfile = dir </> hostport2socket host port
-		 	return (Just socketfile, cacheParams socketfile)
-		else return (Nothing, [])
+sshInfo (host, port) = ifM caching
+	( do
+		dir <- fromRepo gitAnnexSshDir
+		let socketfile = dir </> hostport2socket host port
+	 	return (Just socketfile, cacheParams socketfile)
+	, return (Nothing, [])
+	)
+	where
+		caching = fromMaybe SysConfig.sshconnectioncaching 
+			. Git.configTrue
+			<$> fromRepo (Git.Config.get "annex.sshcaching" "")
 
 cacheParams :: FilePath -> [CommandParam]
 cacheParams socketfile =

Annex/UUID.hs

@@ -34,11 +34,11 @@ genUUID :: IO UUID
 genUUID = pOpen ReadFromPipe command params $ liftM toUUID . hGetLine
 	where
 		command = SysConfig.uuid
-		params = if command == "uuid"
+		params
 			-- request a random uuid be generated
-			then ["-m"]
+			| command == "uuid" = ["-m"]
 			-- uuidgen generates random uuid by default
-			else []
+			| otherwise = []
 
 {- Get current repository's UUID. -}
 getUUID :: Annex UUID

Command.hs

@@ -65,9 +65,7 @@ stop = return Nothing
 
 {- Stops unless a condition is met. -}
 stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
-stopUnless c a = do
-	ok <- c
-	if ok then a else stop
+stopUnless c a = ifM c ( a , stop )
 
 {- Prepares to run a command via the check and seek stages, returning a
  - list of actions to perform to run the command. -}

Command/Add.hs

@@ -85,8 +85,9 @@ cleanup file key hascontent = do
 				mtime <- modificationTime <$> getFileStatus file
 				touch file (TimeSpec mtime) False
 
-	force <- Annex.getState Annex.force
-	if force
-		then Annex.Queue.add "add" [Param "-f", Param "--"] [file]
-		else Annex.Queue.add "add" [Param "--"] [file]
+	params <- ifM (Annex.getState Annex.force)
+		( return [Param "-f"]
+		, return []
+		)
+	Annex.Queue.add "add" (params++[Param "--"]) [file]
 	return True

Command/AddUrl.hs

@@ -51,17 +51,17 @@ perform url file = ifAnnexed file addurl geturl
 	where
 		geturl = do
 			liftIO $ createDirectoryIfMissing True (parentDir file)
-			fast <- Annex.getState Annex.fast
-			if fast then nodownload url file else download url file
-		addurl (key, _backend) = do
-			ok <- liftIO $ Url.check url (keySize key)
-			if ok
-				then do
+			ifM (Annex.getState Annex.fast)
+				( nodownload url file , download url file )
+		addurl (key, _backend) =
+			ifM (liftIO $ Url.check url $ keySize key)
+				( do
 					setUrlPresent key url
 					next $ return True
-				else do
+				, do
 					warning $ "failed to verify url: " ++ url
 					stop
+				)
 
 download :: String -> FilePath -> CommandPerform
 download url file = do

Command/Fsck.hs

@@ -62,17 +62,18 @@ perform key file backend numcopies = check
 {- To fsck a remote, the content is retrieved to a tmp file,
  - and checked locally. -}
 performRemote :: Key -> FilePath -> Backend -> Maybe Int -> Remote -> CommandPerform
-performRemote key file backend numcopies remote = do
-	v <- Remote.hasKey remote key
-	case v of
-		Left err -> do
+performRemote key file backend numcopies remote =
+	dispatch =<< Remote.hasKey remote key
+	where
+		dispatch (Left err) = do
 			showNote err
 			stop
-		Right True -> withtmp $ \tmpfile -> do
-			copied <- getfile tmpfile
-			if copied then go True (Just tmpfile) else go True Nothing
-		Right False -> go False Nothing
-	where
+		dispatch (Right True) = withtmp $ \tmpfile ->
+			ifM (getfile tmpfile)
+				( go True (Just tmpfile)
+				, go True Nothing
+				)
+		dispatch (Right False) = go False Nothing
 		go present localcopy = check
 			[ verifyLocationLogRemote key file remote present
 			, checkKeySizeRemote key remote localcopy
@@ -87,15 +88,14 @@ performRemote key file backend numcopies remote = do
 			let cleanup = liftIO $ catchIO (removeFile tmp) (const $ return ())
 			cleanup
 			cleanup `after` a tmp
-		getfile tmp = do
-			ok <- Remote.retrieveKeyFileCheap remote key tmp
-			if ok
-				then return ok
-				else do
-					fast <- Annex.getState Annex.fast
-					if fast
-						then return False
-						else Remote.retrieveKeyFile remote key tmp
+		getfile tmp =
+			ifM (Remote.retrieveKeyFileCheap remote key tmp)
+				( return True
+				, ifM (Annex.getState Annex.fast)
+					( return False
+					, Remote.retrieveKeyFile remote key tmp
+					)
+				)
 
 {- To fsck a bare repository, fsck each key in the location log. -}
 withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek
@@ -205,10 +205,10 @@ verifyLocationLog' key desc present u bad = do
 checkKeySize :: Key -> Annex Bool
 checkKeySize key = do
 	file <- inRepo $ gitAnnexLocation key
-	present <- liftIO $ doesFileExist file
-	if present
-		then checkKeySize' key file badContent
-		else return True
+	ifM (liftIO $ doesFileExist file)
+		( checkKeySize' key file badContent
+		, return True
+		)
 
 checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool
 checkKeySizeRemote _ _ Nothing = return True
@@ -219,16 +219,22 @@ checkKeySize' :: Key -> FilePath -> (Key -> Annex String) -> Annex Bool
 checkKeySize' key file bad = case Types.Key.keySize key of
 	Nothing -> return True
 	Just size -> do
-		stat <- liftIO $ getFileStatus file
-		let size' = fromIntegral (fileSize stat)
-		if size == size'
-			then return True
-			else do
-				msg <- bad key
-				warning $ "Bad file size (" ++
-					compareSizes storageUnits True size size' ++
-					"); " ++ msg
-				return False
+		size' <- fromIntegral . fileSize
+			<$> (liftIO $ getFileStatus file)
+		comparesizes size size'
+	where
+		comparesizes a b = do
+			let same = a == b
+			unless same $ badsize a b
+			return same
+		badsize a b = do
+			msg <- bad key
+			warning $ concat
+				[ "Bad file size ("
+				, compareSizes storageUnits True a b
+				, "); "
+				, msg
+				]
 
 checkBackend :: Backend -> Key -> Annex Bool
 checkBackend backend key = do

Command/Get.hs

@@ -42,37 +42,29 @@ perform key = stopUnless (getViaTmp key $ getKeyFile key) $
 {- Try to find a copy of the file in one of the remotes,
  - and copy it to here. -}
 getKeyFile :: Key -> FilePath -> Annex Bool
-getKeyFile key file = do
-	remotes <- Remote.keyPossibilities key
-	if null remotes
-		then do
+getKeyFile key file = dispatch =<< Remote.keyPossibilities key
+	where
+		dispatch [] = do
 			showNote "not available"
 			Remote.showLocations key []
 			return False
-		else trycopy remotes remotes
-	where
+		dispatch remotes = trycopy remotes remotes
 		trycopy full [] = do
 			Remote.showTriedRemotes full
 			Remote.showLocations key []
 			return False
-		trycopy full (r:rs) = do
-			probablythere <- probablyPresent r
-			if probablythere
-				then docopy r (trycopy full rs)
-				else trycopy full rs
+		trycopy full (r:rs) =
+			ifM (probablyPresent r)
+				( docopy r (trycopy full rs)
+				, trycopy full rs
+				)
 		-- This check is to avoid an ugly message if a remote is a
 		-- drive that is not mounted.
-		probablyPresent r =
-			if Remote.hasKeyCheap r
-				then do
-					res <- Remote.hasKey r key
-					case res of
-						Right b -> return b
-						Left _ -> return False
-				else return True
+		probablyPresent r
+			| Remote.hasKeyCheap r =
+				either (const False) id <$> Remote.hasKey r key
+			| otherwise = return True
 		docopy r continue = do
 			showAction $ "from " ++ Remote.name r
-			copied <- Remote.retrieveKeyFile r key file
-			if copied
-				then return True
-				else continue
+			ifM (Remote.retrieveKeyFile r key file)
+				( return True , continue)

Command/Map.hs

@@ -41,14 +41,14 @@ start = do
 	trusted <- trustGet Trusted
 
 	liftIO $ writeFile file (drawMap rs umap trusted)
-	next $ next $ do
-		fast <- Annex.getState Annex.fast
-		if fast
-			then return True
-			else do
+	next $ next $
+		ifM (Annex.getState Annex.fast)
+			( return True
+			, do
 				showLongNote $ "running: dot -Tx11 " ++ file
 				showOutput
 				liftIO $ boolSystem "dot" [Param "-Tx11", File file]
+			)
 	where
 		file = "map.dot"
 

Command/Move.hs

@@ -131,13 +131,13 @@ fromOk src key
 			return $ u /= Remote.uuid src && any (== src) remotes
 fromPerform :: Remote -> Bool -> Key -> CommandPerform
 fromPerform src move key = moveLock move key $ do
-	ishere <- inAnnex key
-	if ishere
-		then handle move True
-		else do
+	ifM (inAnnex key)
+		( handle move True
+		, do
 			showAction $ "from " ++ Remote.name src
 			ok <- getViaTmp key $ Remote.retrieveKeyFile src key
 			handle move ok
+		)
 	where
 		handle _ False = stop -- failed
 		handle False True = next $ return True -- copy complete

Command/PreCommit.hs

@@ -7,6 +7,7 @@
 
 module Command.PreCommit where
 
+import Common.Annex
 import Command
 import qualified Command.Add
 import qualified Command.Fix
@@ -26,7 +27,6 @@ start file = next $ perform file
 
 perform :: FilePath -> CommandPerform
 perform file = do
-	ok <- doCommand $ Command.Add.start file
-	if ok
-		then next $ return True
-		else error $ "failed to add " ++ file ++ "; canceling commit"
+	unlessM (doCommand $ Command.Add.start file) $
+		error $ "failed to add " ++ file ++ "; canceling commit"
+	next $ return True

Command/Sync.hs

@@ -51,11 +51,7 @@ remoteBranch :: Remote -> Git.Ref -> Git.Ref
 remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote
 
 syncRemotes :: [String] -> Annex [Remote]
-syncRemotes rs = do
-	fast <- Annex.getState Annex.fast
-	if fast
-		then nub <$> pickfast
-		else wanted
+syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
 	where
 		pickfast = (++) <$> listed <*> (good =<< fastest <$> available)
 		wanted
@@ -113,11 +109,11 @@ pullRemote remote branch = do
 	showStart "pull" (Remote.name remote)
 	next $ do
 		showOutput
-		fetched <- inRepo $ Git.Command.runBool "fetch"
+		stopUnless fetch $
+			next $ mergeRemote remote branch
+	where
+		fetch = inRepo $ Git.Command.runBool "fetch"
 			[Param $ Remote.name remote]
-		if fetched
-			then next $ mergeRemote remote branch
-			else stop
 
 {- The remote probably has both a master and a synced/master branch.
  - Which to merge from? Well, the master has whatever latest changes
@@ -159,15 +155,15 @@ mergeFrom branch = do
 changed :: Remote -> Git.Ref -> Annex Bool
 changed remote b = do
 	let r = remoteBranch remote b
-	e <- inRepo $ Git.Ref.exists r
-	if e
-		then inRepo $ Git.Branch.changed b r
-		else return False
+	ifM (inRepo $ Git.Ref.exists r)
+		( inRepo $ Git.Branch.changed b r
+		, return False
+		)
 
 newer :: Remote -> Git.Ref -> Annex Bool
 newer remote b = do
 	let r = remoteBranch remote b
-	e <- inRepo $ Git.Ref.exists r
-	if e
-		then inRepo $ Git.Branch.changed r b
-		else return True
+	ifM (inRepo $ Git.Ref.exists r)
+		( inRepo $ Git.Branch.changed r b
+		, return True
+		)

Command/Unannex.hs

@@ -47,16 +47,16 @@ cleanup file key = do
 			Params "-m", Param "content removed from git annex",
 			Param "--", File file]
 
-	fast <- Annex.getState Annex.fast
-	if fast
-		then do
+	ifM (Annex.getState Annex.fast)
+		( do
 			-- fast mode: hard link to content in annex
 			src <- inRepo $ gitAnnexLocation key
 			liftIO $ do
 				createLink src file
 				allowWrite file
-		else do
+		, do
 			fromAnnex key file
 			logStatus key InfoMissing
+		)
 
 	return True

Command/Unused.hs

@@ -299,11 +299,11 @@ staleKeysPrune dirspec = do
 staleKeys :: (Git.Repo -> FilePath) -> Annex [Key]
 staleKeys dirspec = do
 	dir <- fromRepo dirspec
-	exists <- liftIO $ doesDirectoryExist dir
-	if not exists
-		then return []
-		else do
+	ifM (liftIO $ doesDirectoryExist dir)
+		( do
 			contents <- liftIO $ getDirectoryContents dir
 			files <- liftIO $ filterM doesFileExist $
 				map (dir </>) contents
 			return $ mapMaybe (fileKey . takeFileName) files
+		, return []
+		)

Init.hs

@@ -38,23 +38,22 @@ uninitialize = gitPreCommitHookUnWrite
 ensureInitialized :: Annex ()
 ensureInitialized = getVersion >>= maybe needsinit checkVersion
 	where
-		needsinit = do
-			annexed <- Annex.Branch.hasSibling
-			if annexed
-				then initialize Nothing
-				else error "First run: git-annex init"
+		needsinit = ifM Annex.Branch.hasSibling
+				( initialize Nothing
+				, error "First run: git-annex init"
+				)
 
 {- set up a git pre-commit hook, if one is not already present -}
 gitPreCommitHookWrite :: Annex ()
 gitPreCommitHookWrite = unlessBare $ do
 	hook <- preCommitHook
-	exists <- liftIO $ doesFileExist hook
-	if exists
-		then warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
-		else liftIO $ do
+	ifM (liftIO $ doesFileExist hook)
+		( warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
+		, liftIO $ do
 			viaTmp writeFile hook preCommitScript
 			p <- getPermissions hook
 			setPermissions hook $ p {executable = True}
+		)
 
 gitPreCommitHookUnWrite :: Annex ()
 gitPreCommitHookUnWrite = unlessBare $ do

Remote.hs

@@ -70,19 +70,13 @@ addName desc n
  - (Or it can be a UUID.) Only finds currently configured git remotes. -}
 byName :: Maybe String -> Annex (Maybe Remote)
 byName Nothing = return Nothing
-byName (Just n) = do
-	res <- byName' n
-	case res of
-		Left e -> error e
-		Right r -> return $ Just r
+byName (Just n) = either error Just <$> byName' n
 byName' :: String -> Annex (Either String Remote)
 byName' "" = return $ Left "no remote specified"
-byName' n = do
-	match <- filter matching <$> remoteList
-	if null match
-		then return $ Left $ "there is no git remote named \"" ++ n ++ "\""
-		else return $ Right $ Prelude.head match
+byName' n = handle . filter matching <$> remoteList
 	where
+		handle [] = Left $ "there is no git remote named \"" ++ n ++ "\""
+		handle match = Right $ Prelude.head match
 		matching r = n == name r || toUUID n == uuid r
 
 {- Looks up a remote by name (or by UUID, or even by description),

Utility/Monad.hs

@@ -1,6 +1,6 @@
 {- monadic stuff
  -
- - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -14,11 +14,7 @@ import Control.Monad (liftM)
  - predicate -}
 firstM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
 firstM _ [] = return Nothing
-firstM p (x:xs) = do
-	q <- p x
-	if q
-		then return (Just x)
-		else firstM p xs
+firstM p (x:xs) = ifM (p x) (return $ Just x , firstM p xs)
 
 {- Returns true if any value in the list satisfies the predicate,
  - stopping once one is found. -}
@@ -29,6 +25,12 @@ anyM p = liftM isJust . firstM p
 untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool
 untilTrue = flip anyM
 
+{- if with a monadic conditional. -}
+ifM :: Monad m => m Bool -> (m a, m a) -> m a
+ifM cond (thenclause, elseclause) = do
+	c <- cond
+	if c then thenclause else elseclause
+
 {- Runs an action, passing its value to an observer before returning it. -}
 observe :: Monad m => (a -> m b) -> m a -> m a
 observe observer a = do