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

@ -7,8 +7,6 @@
module Command.Drop where
import Control.Monad (when)
import Command
import qualified Backend
import LocationLog
@ -46,7 +44,6 @@ perform key backend numcopies = do
cleanup :: Key -> CommandCleanup
cleanup key = do
inannex <- inAnnex key
when inannex $ removeAnnex key
whenM (inAnnex key) $ removeAnnex key
logStatus key ValueMissing
return True

View file

@ -7,7 +7,6 @@
module Command.DropUnused where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import qualified Data.Map as M
import System.Directory
@ -24,6 +23,7 @@ import qualified Remote
import qualified GitRepo as Git
import Backend
import Key
import Utility
type UnusedMap = M.Map String Key
@ -72,8 +72,7 @@ performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
performOther filespec key = do
g <- Annex.gitRepo
let f = filespec g key
e <- liftIO $ doesFileExist f
when e $ liftIO $ removeFile f
liftIO $ whenM (doesFileExist f) $ removeFile f
next $ return True
readUnusedLog :: FilePath -> Annex UnusedMap

View file

@ -7,11 +7,11 @@
module Command.Find where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import Command
import Content
import Utility
command :: [Command]
command = [repoCommand "find" (paramOptional $ paramRepeating paramPath) seek
@ -23,6 +23,5 @@ seek = [withFilesInGit start]
{- Output a list of files. -}
start :: CommandStartString
start file = isAnnexed file $ \(key, _) -> do
exists <- inAnnex key
when exists $ liftIO $ putStrLn file
whenM (inAnnex key) $ liftIO $ putStrLn file
stop

View file

@ -8,7 +8,6 @@
module Command.Migrate where
import Control.Monad.State (liftIO)
import Control.Monad (unless, when)
import System.Posix.Files
import System.Directory
import System.FilePath
@ -20,6 +19,7 @@ import Locations
import Types
import Content
import Messages
import Utility
import qualified Command.Add
command :: [Command]
@ -63,9 +63,7 @@ perform file oldkey newbackend = do
ok <- getViaTmpUnchecked newkey $ \t -> do
-- Make a hard link to the old backend's
-- cached key, to avoid wasting disk space.
liftIO $ do
exists <- doesFileExist t
unless exists $ createLink src t
liftIO $ unlessM (doesFileExist t) $ createLink src t
return True
if ok
then do
@ -74,6 +72,4 @@ perform file oldkey newbackend = do
next $ Command.Add.cleanup file newkey
else stop
where
cleantmp t = do
exists <- doesFileExist t
when exists $ removeFile t
cleantmp t = whenM (doesFileExist t) $ removeFile t

View file

@ -7,13 +7,13 @@
module Command.RecvKey where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Exit
import Command
import CmdLine
import Content
import Utility
import RsyncFile
command :: [Command]
@ -25,9 +25,7 @@ seek = [withKeys start]
start :: CommandStartKey
start key = do
present <- inAnnex key
when present $
error "key is already present in annex"
whenM (inAnnex key) $ error "key is already present in annex"
ok <- getViaTmp key (liftIO . rsyncServerReceive)
if ok

View file

@ -7,7 +7,6 @@
module Command.SendKey where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Exit
@ -15,6 +14,7 @@ import Locations
import qualified Annex
import Command
import Content
import Utility
import RsyncFile
command :: [Command]
@ -26,9 +26,8 @@ seek = [withKeys start]
start :: CommandStartKey
start key = do
present <- inAnnex key
g <- Annex.gitRepo
let file = gitAnnexLocation g key
when present $
liftIO $ rsyncServerSend file
whenM (inAnnex key) $
liftIO $ rsyncServerSend file -- does not return
liftIO exitFailure

View file

@ -8,7 +8,6 @@
module Command.Uninit where
import Control.Monad.State (liftIO)
import Control.Monad (when)
import System.Directory
import Command
@ -44,8 +43,7 @@ perform = do
gitPreCommitHookUnWrite :: Git.Repo -> Annex ()
gitPreCommitHookUnWrite repo = do
let hook = Command.Init.preCommitHook repo
hookexists <- liftIO $ doesFileExist hook
when hookexists $ do
whenM (liftIO $ doesFileExist hook) $ do
c <- liftIO $ readFile hook
if c == Command.Init.preCommitScript
then liftIO $ removeFile hook
@ -56,8 +54,7 @@ gitPreCommitHookUnWrite repo = do
gitAttributesUnWrite :: Git.Repo -> IO ()
gitAttributesUnWrite repo = do
let attributes = Git.attributes repo
attrexists <- doesFileExist attributes
when attrexists $ do
whenM (doesFileExist attributes) $ do
c <- readFileStrict attributes
safeWriteFile attributes $ unlines $
filter (\l -> not $ l `elem` Command.Init.attrLines) $ lines c

View file

@ -7,7 +7,6 @@
module Command.Unlock where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Directory hiding (copyFile)
@ -19,6 +18,7 @@ import Messages
import Locations
import Content
import CopyFile
import Utility
command :: [Command]
command =
@ -38,9 +38,7 @@ start file = isAnnexed file $ \(key, _) -> do
perform :: FilePath -> Key -> CommandPerform
perform dest key = do
inbackend <- Backend.hasKey key
when (not inbackend) $
error "content not present"
unlessM (Backend.hasKey key) $ error "content not present"
checkDiskSpace key