diff options
| -rw-r--r-- | Common.hs | 2 | ||||
| -rw-r--r-- | Git/Command.hs | 4 | ||||
| -rw-r--r-- | Remote/Bup.hs | 8 | ||||
| -rw-r--r-- | Remote/Directory.hs | 4 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 4 | ||||
| -rw-r--r-- | Utility/Conditional.hs | 26 | ||||
| -rw-r--r-- | Utility/CopyFile.hs | 2 | ||||
| -rw-r--r-- | Utility/Directory.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 6 | ||||
| -rw-r--r-- | debian/control | 1 | ||||
| -rw-r--r-- | doc/install.mdwn | 1 | ||||
| -rw-r--r-- | git-annex.cabal | 3 |
12 files changed, 23 insertions, 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 diff --git a/Git/Command.hs b/Git/Command.hs index 2350bb0ca..61b7728db 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -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. - diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 7329167da..9b54d8c85 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -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' diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 52f426340..85f644607 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -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 diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 8de6ba6a7..c7efe4200 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -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 diff --git a/Utility/Conditional.hs b/Utility/Conditional.hs deleted file mode 100644 index 85e39ec64..000000000 --- a/Utility/Conditional.hs +++ /dev/null @@ -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 >>! diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs index 5d6855bf0..c42506485 100644 --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -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 diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 249ed6935..b5fedb9c7 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -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. diff --git a/debian/changelog b/debian/changelog index 2f573e6d3..e1c861d19 100644 --- a/debian/changelog +++ b/debian/changelog @@ -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 diff --git a/debian/control b/debian/control index 3f171a11c..c3ddad932 100644 --- a/debian/control +++ b/debian/control @@ -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, diff --git a/doc/install.mdwn b/doc/install.mdwn index 7da46b351..b48914197 100644 --- a/doc/install.mdwn +++ b/doc/install.mdwn @@ -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/) diff --git a/git-annex.cabal b/git-annex.cabal index 43901b693..3f152ea4b 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -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 |