add whenM and unlessM

Just more golfing.. I am pretty sure something in a library somewhere can
do this, but I have been unable to find it.

Command/Drop.hs

@@ -7,8 +7,6 @@
 
 module Command.Drop where
 
-import Control.Monad (when)
-
 import Command
 import qualified Backend
 import LocationLog
@@ -46,7 +44,6 @@ perform key backend numcopies = do
 
 cleanup :: Key -> CommandCleanup
 cleanup key = do
-	inannex <- inAnnex key
-	when inannex $ removeAnnex key
+	whenM (inAnnex key) $ removeAnnex key
 	logStatus key ValueMissing
 	return True

Command/DropUnused.hs

@@ -7,7 +7,6 @@
 
 module Command.DropUnused where
 
-import Control.Monad (when)
 import Control.Monad.State (liftIO)
 import qualified Data.Map as M
 import System.Directory
@@ -24,6 +23,7 @@ import qualified Remote
 import qualified GitRepo as Git
 import Backend
 import Key
+import Utility
 
 type UnusedMap = M.Map String Key
 
@@ -72,8 +72,7 @@ performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
 performOther filespec key = do
 	g <- Annex.gitRepo
 	let f = filespec g key
-	e <- liftIO $ doesFileExist f
-	when e $ liftIO $ removeFile f
+	liftIO $ whenM (doesFileExist f) $ removeFile f
 	next $ return True
 
 readUnusedLog :: FilePath -> Annex UnusedMap

Command/Find.hs

@@ -7,11 +7,11 @@
 
 module Command.Find where
 
-import Control.Monad (when)
 import Control.Monad.State (liftIO)
 
 import Command
 import Content
+import Utility
 
 command :: [Command]
 command = [repoCommand "find" (paramOptional $ paramRepeating paramPath) seek
@@ -23,6 +23,5 @@ seek = [withFilesInGit start]
 {- Output a list of files. -}
 start :: CommandStartString
 start file = isAnnexed file $ \(key, _) -> do
-	exists <- inAnnex key
-	when exists $ liftIO $ putStrLn file
+	whenM (inAnnex key) $ liftIO $ putStrLn file
 	stop

Command/Migrate.hs

@@ -8,7 +8,6 @@
 module Command.Migrate where
 
 import Control.Monad.State (liftIO)
-import Control.Monad (unless, when)
 import System.Posix.Files
 import System.Directory
 import System.FilePath
@@ -20,6 +19,7 @@ import Locations
 import Types
 import Content
 import Messages
+import Utility
 import qualified Command.Add
 
 command :: [Command]
@@ -63,9 +63,7 @@ perform file oldkey newbackend = do
 			ok <- getViaTmpUnchecked newkey $ \t -> do
 				-- Make a hard link to the old backend's
 				-- cached key, to avoid wasting disk space.
-				liftIO $ do
-					exists <- doesFileExist t
-					unless exists $ createLink src t
+				liftIO $ unlessM (doesFileExist t) $ createLink src t
 				return True
 			if ok
 				then do
@@ -74,6 +72,4 @@ perform file oldkey newbackend = do
 					next $ Command.Add.cleanup file newkey
 				else stop
 	where
-		cleantmp t = do
-			exists <- doesFileExist t
-			when exists $ removeFile t
+		cleantmp t = whenM (doesFileExist t) $ removeFile t

Command/RecvKey.hs

@@ -7,13 +7,13 @@
 
 module Command.RecvKey where
 
-import Control.Monad (when)
 import Control.Monad.State (liftIO)
 import System.Exit
 
 import Command
 import CmdLine
 import Content
+import Utility
 import RsyncFile
 
 command :: [Command]
@@ -25,9 +25,7 @@ seek = [withKeys start]
 
 start :: CommandStartKey
 start key = do
-	present <- inAnnex key
-	when present $
-		error "key is already present in annex"
+	whenM (inAnnex key) $ error "key is already present in annex"
 	
 	ok <- getViaTmp key (liftIO . rsyncServerReceive)
 	if ok

Command/SendKey.hs

@@ -7,7 +7,6 @@
 
 module Command.SendKey where
 
-import Control.Monad (when)
 import Control.Monad.State (liftIO)
 import System.Exit
 
@@ -15,6 +14,7 @@ import Locations
 import qualified Annex
 import Command
 import Content
+import Utility
 import RsyncFile
 
 command :: [Command]
@@ -26,9 +26,8 @@ seek = [withKeys start]
 
 start :: CommandStartKey
 start key = do
-	present <- inAnnex key
 	g <- Annex.gitRepo
 	let file = gitAnnexLocation g key
-	when present $
-		liftIO $ rsyncServerSend file
+	whenM (inAnnex key) $
+		liftIO $ rsyncServerSend file -- does not return
 	liftIO exitFailure

Command/Uninit.hs

@@ -8,7 +8,6 @@
 module Command.Uninit where
 
 import Control.Monad.State (liftIO)
-import Control.Monad (when)
 import System.Directory
 
 import Command
@@ -44,8 +43,7 @@ perform = do
 gitPreCommitHookUnWrite :: Git.Repo -> Annex ()
 gitPreCommitHookUnWrite repo = do
 	let hook = Command.Init.preCommitHook repo
-	hookexists <- liftIO $ doesFileExist hook
-	when hookexists $ do
+	whenM (liftIO $ doesFileExist hook) $ do
 		c <- liftIO $ readFile hook
 		if c == Command.Init.preCommitScript
 			then liftIO $ removeFile hook
@@ -56,8 +54,7 @@ gitPreCommitHookUnWrite repo = do
 gitAttributesUnWrite :: Git.Repo -> IO ()
 gitAttributesUnWrite repo = do
 	let attributes = Git.attributes repo
-	attrexists <- doesFileExist attributes
-	when attrexists $ do
+	whenM (doesFileExist attributes) $ do
 		c <- readFileStrict attributes
 		safeWriteFile attributes $ unlines $
 			filter (\l -> not $ l `elem` Command.Init.attrLines) $ lines c

Command/Unlock.hs

@@ -7,7 +7,6 @@
 
 module Command.Unlock where
 
-import Control.Monad (when)
 import Control.Monad.State (liftIO)
 import System.Directory hiding (copyFile)
 
@@ -19,6 +18,7 @@ import Messages
 import Locations
 import Content
 import CopyFile
+import Utility
 
 command :: [Command]
 command =
@@ -38,9 +38,7 @@ start file = isAnnexed file $ \(key, _) -> do
 
 perform :: FilePath -> Key -> CommandPerform
 perform dest key = do
-	inbackend <- Backend.hasKey key
-	when (not inbackend) $
-		error "content not present"
+	unlessM (Backend.hasKey key) $ error "content not present"
 	
 	checkDiskSpace key