remove Utility.Conditional and use IfElse
This drops the >>! and >>? with the nice low fixity. IfElse does have undocumented >>=>>! and >>=>>? operators, but I deem that too fishy. Anyway, using whenM and unlessM is easier; I sometimes mixed the operators up.
This commit is contained in:
parent
ba6088b249
commit
ce5637498f
12 changed files with 23 additions and 40 deletions
|
@ -1,6 +1,7 @@
|
|||
module Common (module X) where
|
||||
|
||||
import Control.Monad as X hiding (join)
|
||||
import Control.Monad.IfElse as X
|
||||
import Control.Applicative as X
|
||||
import Control.Monad.State as X (liftIO)
|
||||
import Control.Exception.Extensible as X (IOException)
|
||||
|
@ -20,7 +21,6 @@ import System.Posix.Process as X hiding (executeFile)
|
|||
import System.Exit as X
|
||||
|
||||
import Utility.Misc as X
|
||||
import Utility.Conditional as X
|
||||
import Utility.SafeCommand as X
|
||||
import Utility.Path as X
|
||||
import Utility.Directory as X
|
||||
|
|
|
@ -30,8 +30,8 @@ runBool subcommand params repo = assertLocal repo $
|
|||
{- Runs git in the specified repo, throwing an error if it fails. -}
|
||||
run :: String -> [CommandParam] -> Repo -> IO ()
|
||||
run subcommand params repo = assertLocal repo $
|
||||
runBool subcommand params repo
|
||||
>>! error $ "git " ++ show params ++ " failed"
|
||||
unlessM (runBool subcommand params repo) $
|
||||
error $ "git " ++ show params ++ " failed"
|
||||
|
||||
{- Runs a git subcommand and returns its output, lazily.
|
||||
-
|
||||
|
|
|
@ -69,7 +69,7 @@ bupSetup u c = do
|
|||
-- bup init will create the repository.
|
||||
-- (If the repository already exists, bup init again appears safe.)
|
||||
showAction "bup init"
|
||||
bup "init" buprepo [] >>! error "bup init failed"
|
||||
unlessM (bup "init" buprepo []) $ error "bup init failed"
|
||||
|
||||
storeBupUUID u buprepo
|
||||
|
||||
|
@ -167,9 +167,9 @@ storeBupUUID u buprepo = do
|
|||
if Git.repoIsUrl r
|
||||
then do
|
||||
showAction "storing uuid"
|
||||
onBupRemote r boolSystem "git"
|
||||
[Params $ "config annex.uuid " ++ v]
|
||||
>>! error "ssh failed"
|
||||
unlessM (onBupRemote r boolSystem "git"
|
||||
[Params $ "config annex.uuid " ++ v]) $
|
||||
error "ssh failed"
|
||||
else liftIO $ do
|
||||
r' <- Git.Config.read r
|
||||
let olduuid = Git.Config.get "annex.uuid" "" r'
|
||||
|
|
|
@ -55,8 +55,8 @@ directorySetup u c = do
|
|||
-- verify configuration is sane
|
||||
let dir = fromMaybe (error "Specify directory=") $
|
||||
M.lookup "directory" c
|
||||
liftIO $ doesDirectoryExist dir
|
||||
>>! error $ "Directory does not exist: " ++ dir
|
||||
liftIO $ unlessM (doesDirectoryExist dir) $
|
||||
error $ "Directory does not exist: " ++ dir
|
||||
c' <- encryptionSetup c
|
||||
|
||||
-- The directory is stored in git config, not in this remote's
|
||||
|
|
|
@ -181,8 +181,8 @@ withRsyncScratchDir a = do
|
|||
liftIO $ createDirectoryIfMissing True tmp
|
||||
nuke tmp `after` a tmp
|
||||
where
|
||||
nuke d = liftIO $
|
||||
doesDirectoryExist d >>? removeDirectoryRecursive d
|
||||
nuke d = liftIO $ whenM (doesDirectoryExist d) $
|
||||
removeDirectoryRecursive d
|
||||
|
||||
rsyncRemote :: RsyncOpts -> [CommandParam] -> Annex Bool
|
||||
rsyncRemote o params = do
|
||||
|
|
|
@ -1,26 +0,0 @@
|
|||
{- monadic conditional operators
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Utility.Conditional where
|
||||
|
||||
import Control.Monad (when, unless)
|
||||
|
||||
whenM :: Monad m => m Bool -> m () -> m ()
|
||||
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 ()
|
||||
(>>!) = unlessM
|
||||
|
||||
-- low fixity allows eg, foo bar >>! error $ "failed " ++ meep
|
||||
infixr 0 >>?
|
||||
infixr 0 >>!
|
|
@ -8,8 +8,8 @@
|
|||
module Utility.CopyFile (copyFileExternal) where
|
||||
|
||||
import System.Directory (doesFileExist, removeFile)
|
||||
import Control.Monad.IfElse
|
||||
|
||||
import Utility.Conditional
|
||||
import Utility.SafeCommand
|
||||
import qualified Build.SysConfig as SysConfig
|
||||
|
||||
|
|
|
@ -12,9 +12,9 @@ import System.Posix.Files
|
|||
import System.Directory
|
||||
import Control.Exception (throw)
|
||||
import Control.Monad
|
||||
import Control.Monad.IfElse
|
||||
|
||||
import Utility.SafeCommand
|
||||
import Utility.Conditional
|
||||
import Utility.TempFile
|
||||
|
||||
{- Moves one filename to another.
|
||||
|
|
6
debian/changelog
vendored
6
debian/changelog
vendored
|
@ -1,3 +1,9 @@
|
|||
git-annex (3.20120124) UNRELEASED; urgency=low
|
||||
|
||||
* Use the haskell IfElse library.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Tue, 24 Jan 2012 16:21:55 -0400
|
||||
|
||||
git-annex (3.20120123) unstable; urgency=low
|
||||
|
||||
* fsck --from: Fscking a remote is now supported. It's done by retrieving
|
||||
|
|
1
debian/control
vendored
1
debian/control
vendored
|
@ -17,6 +17,7 @@ Build-Depends:
|
|||
libghc-monad-control-dev (>= 0.3),
|
||||
libghc-lifted-base-dev,
|
||||
libghc-json-dev,
|
||||
libghc-ifelse-dev,
|
||||
ikiwiki,
|
||||
perlmagick,
|
||||
git,
|
||||
|
|
|
@ -34,6 +34,7 @@ To build and use git-annex, you will need:
|
|||
* [HTTP](http://hackage.haskell.org/package/HTTP)
|
||||
* [hS3](http://hackage.haskell.org/package/hS3)
|
||||
* [json](http://hackage.haskell.org/package/json)
|
||||
* [IfElse](http://hackage.haskell.org/package/IfElse)
|
||||
* Shell commands
|
||||
* [git](http://git-scm.com/)
|
||||
* [uuid](http://www.ossp.org/pkg/lib/uuid/)
|
||||
|
|
|
@ -31,7 +31,8 @@ Executable git-annex
|
|||
Build-Depends: MissingH, hslogger, directory, filepath,
|
||||
unix, containers, utf8-string, network, mtl, bytestring, old-locale, time,
|
||||
pcre-light, extensible-exceptions, dataenc, SHA, process, hS3, json, HTTP,
|
||||
base < 5, monad-control, transformers-base, lifted-base, QuickCheck >= 2.1
|
||||
base < 5, monad-control, transformers-base, lifted-base, IfElse,
|
||||
QuickCheck >= 2.1
|
||||
|
||||
Executable git-annex-shell
|
||||
Main-Is: git-annex-shell.hs
|
||||
|
|
Loading…
Reference in a new issue