more standard names for whenM and unlessM operators

These are defined in ifelse, but it's not currently available and I don't
want to pull in a library for 6 lines of code anyhow.

Also, ifelse sets the fixity to 1, which does not allow >>? error $ ...
This commit is contained in:
Joey Hess 2011-05-17 11:44:13 -04:00
parent c91929f693
commit 21d9c84e72
5 changed files with 13 additions and 13 deletions

View file

@ -331,7 +331,7 @@ gitCommandLine repo _ = assertLocal repo $ error "internal"
run :: Repo -> String -> [CommandParam] -> IO ()
run repo subcommand params = assertLocal repo $
boolSystem "git" (gitCommandLine repo ((Param subcommand):params))
<|> error $ "git " ++ show params ++ " failed"
>>! error $ "git " ++ show params ++ " failed"
{- Runs a git subcommand and returns it output, lazily.
-

View file

@ -75,7 +75,7 @@ bupSetup u c = do
-- bup init will create the repository.
-- (If the repository already exists, bup init again appears safe.)
showNote "bup init"
bup "init" buprepo [] <|> error "bup init failed"
bup "init" buprepo [] >>! error "bup init failed"
storeBupUUID u buprepo
@ -173,7 +173,7 @@ storeBupUUID u buprepo = do
showNote "storing uuid"
onBupRemote r boolSystem "git"
[Params $ "config annex.uuid " ++ u]
<|> error "ssh failed"
>>! error "ssh failed"
else liftIO $ do
r' <- Git.configRead r
let olduuid = Git.configGet r' "annex.uuid" ""

View file

@ -63,7 +63,7 @@ directorySetup u c = do
let dir = maybe (error "Specify directory=") id $
M.lookup "directory" c
liftIO $ 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

View file

@ -169,7 +169,7 @@ withRsyncScratchDir a = do
return res
where
nuke d = liftIO $
doesDirectoryExist d <&> removeDirectoryRecursive d
doesDirectoryExist d >>? removeDirectoryRecursive d
rsyncRemote :: RsyncOpts -> [CommandParam] -> Annex Bool
rsyncRemote o params = do

View file

@ -27,9 +27,9 @@ module Utility (
myHomeDir,
catchBool,
whenM,
(<&>),
(>>?),
unlessM,
(<|>),
(>>!),
prop_idempotent_shellEscape,
prop_idempotent_shellEscape_multiword,
@ -271,12 +271,12 @@ 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 ()
(>>?) = whenM
(<|>) :: Monad m => m Bool -> m () -> m ()
(<|>) = unlessM
(>>!) :: Monad m => m Bool -> m () -> m ()
(>>!) = unlessM
-- low fixity allows eg, foo bar <|> error $ "failed " ++ meep
infixr 0 <&>
infixr 0 <|>
infixr 0 >>?
infixr 0 >>!