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:
parent
c91929f693
commit
21d9c84e72
5 changed files with 13 additions and 13 deletions
|
@ -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.
|
||||
-
|
||||
|
|
|
@ -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" ""
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
16
Utility.hs
16
Utility.hs
|
@ -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 >>!
|
||||
|
|
Loading…
Add table
Reference in a new issue