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 -> String -> [CommandParam] -> IO ()
|
||||||
run repo subcommand params = assertLocal repo $
|
run repo subcommand params = assertLocal repo $
|
||||||
boolSystem "git" (gitCommandLine repo ((Param subcommand):params))
|
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.
|
{- Runs a git subcommand and returns it output, lazily.
|
||||||
-
|
-
|
||||||
|
|
|
@ -75,7 +75,7 @@ bupSetup u c = do
|
||||||
-- bup init will create the repository.
|
-- bup init will create the repository.
|
||||||
-- (If the repository already exists, bup init again appears safe.)
|
-- (If the repository already exists, bup init again appears safe.)
|
||||||
showNote "bup init"
|
showNote "bup init"
|
||||||
bup "init" buprepo [] <|> error "bup init failed"
|
bup "init" buprepo [] >>! error "bup init failed"
|
||||||
|
|
||||||
storeBupUUID u buprepo
|
storeBupUUID u buprepo
|
||||||
|
|
||||||
|
@ -173,7 +173,7 @@ storeBupUUID u buprepo = do
|
||||||
showNote "storing uuid"
|
showNote "storing uuid"
|
||||||
onBupRemote r boolSystem "git"
|
onBupRemote r boolSystem "git"
|
||||||
[Params $ "config annex.uuid " ++ u]
|
[Params $ "config annex.uuid " ++ u]
|
||||||
<|> error "ssh failed"
|
>>! error "ssh failed"
|
||||||
else liftIO $ do
|
else liftIO $ do
|
||||||
r' <- Git.configRead r
|
r' <- Git.configRead r
|
||||||
let olduuid = Git.configGet r' "annex.uuid" ""
|
let olduuid = Git.configGet r' "annex.uuid" ""
|
||||||
|
|
|
@ -63,7 +63,7 @@ directorySetup u c = do
|
||||||
let dir = maybe (error "Specify directory=") id $
|
let dir = maybe (error "Specify directory=") id $
|
||||||
M.lookup "directory" c
|
M.lookup "directory" c
|
||||||
liftIO $ doesDirectoryExist dir
|
liftIO $ doesDirectoryExist dir
|
||||||
<|> error $ "Directory does not exist: " ++ dir
|
>>! error $ "Directory does not exist: " ++ dir
|
||||||
c' <- encryptionSetup c
|
c' <- encryptionSetup c
|
||||||
|
|
||||||
-- The directory is stored in git config, not in this remote's
|
-- The directory is stored in git config, not in this remote's
|
||||||
|
|
|
@ -169,7 +169,7 @@ withRsyncScratchDir a = do
|
||||||
return res
|
return res
|
||||||
where
|
where
|
||||||
nuke d = liftIO $
|
nuke d = liftIO $
|
||||||
doesDirectoryExist d <&> removeDirectoryRecursive d
|
doesDirectoryExist d >>? removeDirectoryRecursive d
|
||||||
|
|
||||||
rsyncRemote :: RsyncOpts -> [CommandParam] -> Annex Bool
|
rsyncRemote :: RsyncOpts -> [CommandParam] -> Annex Bool
|
||||||
rsyncRemote o params = do
|
rsyncRemote o params = do
|
||||||
|
|
16
Utility.hs
16
Utility.hs
|
@ -27,9 +27,9 @@ module Utility (
|
||||||
myHomeDir,
|
myHomeDir,
|
||||||
catchBool,
|
catchBool,
|
||||||
whenM,
|
whenM,
|
||||||
(<&>),
|
(>>?),
|
||||||
unlessM,
|
unlessM,
|
||||||
(<|>),
|
(>>!),
|
||||||
|
|
||||||
prop_idempotent_shellEscape,
|
prop_idempotent_shellEscape,
|
||||||
prop_idempotent_shellEscape_multiword,
|
prop_idempotent_shellEscape_multiword,
|
||||||
|
@ -271,12 +271,12 @@ whenM c a = c >>= flip when a
|
||||||
unlessM :: Monad m => m Bool -> m () -> m ()
|
unlessM :: Monad m => m Bool -> m () -> m ()
|
||||||
unlessM c a = c >>= flip unless a
|
unlessM c a = c >>= flip unless a
|
||||||
|
|
||||||
(<&>) :: Monad m => m Bool -> m () -> m ()
|
(>>?) :: Monad m => m Bool -> m () -> m ()
|
||||||
(<&>) = whenM
|
(>>?) = whenM
|
||||||
|
|
||||||
(<|>) :: Monad m => m Bool -> m () -> m ()
|
(>>!) :: Monad m => m Bool -> m () -> m ()
|
||||||
(<|>) = unlessM
|
(>>!) = unlessM
|
||||||
|
|
||||||
-- low fixity allows eg, foo bar <|> error $ "failed " ++ meep
|
-- low fixity allows eg, foo bar <|> error $ "failed " ++ meep
|
||||||
infixr 0 <&>
|
infixr 0 >>?
|
||||||
infixr 0 <|>
|
infixr 0 >>!
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue