remove Utility.Conditional and use IfElse

This drops the >>! and >>? with the nice low fixity. IfElse does have
undocumented >>=>>! and >>=>>? operators, but I deem that too fishy.
Anyway, using whenM and unlessM is easier; I sometimes mixed the operators
up.

Common.hs

@@ -1,6 +1,7 @@
 module Common (module X) where
 
 import Control.Monad as X hiding (join)
+import Control.Monad.IfElse as X
 import Control.Applicative as X
 import Control.Monad.State as X (liftIO)
 import Control.Exception.Extensible as X (IOException)
@@ -20,7 +21,6 @@ import System.Posix.Process as X hiding (executeFile)
 import System.Exit as X
 
 import Utility.Misc as X
-import Utility.Conditional as X
 import Utility.SafeCommand as X
 import Utility.Path as X
 import Utility.Directory as X

Git/Command.hs

@@ -30,8 +30,8 @@ runBool subcommand params repo = assertLocal repo $
 {- Runs git in the specified repo, throwing an error if it fails. -}
 run :: String -> [CommandParam] -> Repo -> IO ()
 run subcommand params repo = assertLocal repo $
-	runBool subcommand params repo
+	unlessM (runBool subcommand params repo) $
-		>>! error $ "git " ++ show params ++ " failed"
+		error $ "git " ++ show params ++ " failed"
 
 {- Runs a git subcommand and returns its output, lazily. 
  -

Remote/Bup.hs

@@ -69,7 +69,7 @@ bupSetup u c = do
 	-- bup init will create the repository.
 	-- (If the repository already exists, bup init again appears safe.)
 	showAction "bup init"
-	bup "init" buprepo [] >>! error "bup init failed"
+	unlessM (bup "init" buprepo []) $ error "bup init failed"
 
 	storeBupUUID u buprepo
 
@@ -167,9 +167,9 @@ storeBupUUID u buprepo = do
 	if Git.repoIsUrl r
 		then do
 			showAction "storing uuid"
-			onBupRemote r boolSystem "git"
+			unlessM (onBupRemote r boolSystem "git"
-				[Params $ "config annex.uuid " ++ v]
+				[Params $ "config annex.uuid " ++ v]) $
-					>>! error "ssh failed"
+					error "ssh failed"
 		else liftIO $ do
 			r' <- Git.Config.read r
 			let olduuid = Git.Config.get "annex.uuid" "" r'

Remote/Directory.hs

@@ -55,8 +55,8 @@ directorySetup u c = do
 	-- verify configuration is sane
 	let dir = fromMaybe (error "Specify directory=") $
 		M.lookup "directory" c
-	liftIO $ doesDirectoryExist dir
+	liftIO $ unlessM (doesDirectoryExist dir) $
-		>>! error $ "Directory does not exist: " ++ dir
+		error $ "Directory does not exist: " ++ dir
 	c' <- encryptionSetup c
 
 	-- The directory is stored in git config, not in this remote's

Remote/Rsync.hs

@@ -181,8 +181,8 @@ withRsyncScratchDir a = do
 	liftIO $ createDirectoryIfMissing True tmp
 	nuke tmp `after` a tmp
 	where
-		nuke d = liftIO $ 
+		nuke d = liftIO $ whenM (doesDirectoryExist d) $
-			doesDirectoryExist d >>? removeDirectoryRecursive d
+			removeDirectoryRecursive d
 
 rsyncRemote :: RsyncOpts -> [CommandParam] -> Annex Bool
 rsyncRemote o params = do

Utility/Conditional.hs

@@ -1,26 +0,0 @@
-{- monadic conditional operators
- -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Utility.Conditional where
-
-import Control.Monad (when, unless)
-
-whenM :: Monad m => m Bool -> m () -> m ()
-whenM c a = c >>= flip when a
-
-unlessM :: Monad m => m Bool -> m () -> m ()
-unlessM c a = c >>= flip unless a
-
-(>>?) :: Monad m => m Bool -> m () -> m ()
-(>>?) = whenM
-
-(>>!) :: Monad m => m Bool -> m () -> m ()
-(>>!) = unlessM
-
--- low fixity allows eg, foo bar >>! error $ "failed " ++ meep
-infixr 0 >>?
-infixr 0 >>!

Utility/CopyFile.hs

@@ -8,8 +8,8 @@
 module Utility.CopyFile (copyFileExternal) where
 
 import System.Directory (doesFileExist, removeFile)
+import Control.Monad.IfElse
 
-import Utility.Conditional
 import Utility.SafeCommand
 import qualified Build.SysConfig as SysConfig
 

Utility/Directory.hs

@@ -12,9 +12,9 @@ import System.Posix.Files
 import System.Directory
 import Control.Exception (throw)
 import Control.Monad
+import Control.Monad.IfElse
 
 import Utility.SafeCommand
-import Utility.Conditional
 import Utility.TempFile
 
 {- Moves one filename to another.

debian/changelog

@@ -1,3 +1,9 @@
+git-annex (3.20120124) UNRELEASED; urgency=low
+
+  * Use the haskell IfElse library.
+
+ -- Joey Hess <joeyh@debian.org>  Tue, 24 Jan 2012 16:21:55 -0400
+
 git-annex (3.20120123) unstable; urgency=low
 
   * fsck --from: Fscking a remote is now supported. It's done by retrieving

debian/control

@@ -17,6 +17,7 @@ Build-Depends:
 	libghc-monad-control-dev (>= 0.3),
 	libghc-lifted-base-dev,
 	libghc-json-dev,
+	libghc-ifelse-dev,
 	ikiwiki,
 	perlmagick,
 	git,

doc/install.mdwn

@@ -34,6 +34,7 @@ To build and use git-annex, you will need:
   * [HTTP](http://hackage.haskell.org/package/HTTP)
   * [hS3](http://hackage.haskell.org/package/hS3)
   * [json](http://hackage.haskell.org/package/json)
+  * [IfElse](http://hackage.haskell.org/package/IfElse)
 * Shell commands
   * [git](http://git-scm.com/)
   * [uuid](http://www.ossp.org/pkg/lib/uuid/)

git-annex.cabal

@@ -31,7 +31,8 @@ Executable git-annex
   Build-Depends: MissingH, hslogger, directory, filepath,
    unix, containers, utf8-string, network, mtl, bytestring, old-locale, time,
    pcre-light, extensible-exceptions, dataenc, SHA, process, hS3, json, HTTP,
-   base < 5, monad-control, transformers-base, lifted-base, QuickCheck >= 2.1
+   base < 5, monad-control, transformers-base, lifted-base, IfElse,
+   QuickCheck >= 2.1
 
 Executable git-annex-shell
   Main-Is: git-annex-shell.hs