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:
parent
75a3f5027f
commit
c91929f693
16 changed files with 60 additions and 63 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue