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.
This commit is contained in:
Joey Hess 2011-05-17 03:10:13 -04:00
parent 75a3f5027f
commit c91929f693
16 changed files with 60 additions and 63 deletions

View file

@ -11,7 +11,7 @@ import qualified Data.ByteString.Lazy.Char8 as L
import IO
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M
import Control.Monad (unless, when)
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Process
import System.Exit
@ -75,8 +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"
ok <- bup "init" buprepo []
unless ok $ error "bup init failed"
bup "init" buprepo [] <|> error "bup init failed"
storeBupUUID u buprepo
@ -172,9 +171,9 @@ storeBupUUID u buprepo = do
if Git.repoIsUrl r
then do
showNote "storing uuid"
ok <- onBupRemote r boolSystem "git"
onBupRemote r boolSystem "git"
[Params $ "config annex.uuid " ++ u]
unless ok $ do error "ssh failed"
<|> error "ssh failed"
else liftIO $ do
r' <- Git.configRead r
let olduuid = Git.configGet r' "annex.uuid" ""

View file

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

View file

@ -10,7 +10,7 @@ module Remote.Rsync (remote) where
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M
import Control.Monad.State (liftIO, when)
import Control.Monad.State (liftIO)
import System.FilePath
import System.Directory
import System.Posix.Files
@ -168,9 +168,8 @@ withRsyncScratchDir a = do
nuke tmp
return res
where
nuke d = liftIO $ do
e <- doesDirectoryExist d
when e $ liftIO $ removeDirectoryRecursive d
nuke d = liftIO $
doesDirectoryExist d <&> removeDirectoryRecursive d
rsyncRemote :: RsyncOpts -> [CommandParam] -> Annex Bool
rsyncRemote o params = do