diff options
| -rw-r--r-- | Command/Find.hs | 2 | ||||
| -rw-r--r-- | Remote/Git.hs | 9 | ||||
| -rw-r--r-- | Utility/Matcher.hs | 8 | ||||
| -rw-r--r-- | Utility/Monad.hs | 16 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 8 |
5 files changed, 22 insertions, 21 deletions
diff --git a/Command/Find.hs b/Command/Find.hs index f5bd2734b..e568c3510 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -42,7 +42,7 @@ start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandSta start format file (key, _) = do -- only files inAnnex are shown, unless the user has requested -- others via a limit - whenM (orM limited (inAnnex key)) $ + whenM (limited <||> inAnnex key) $ unlessM (showFullJSON vars) $ case format of Nothing -> liftIO $ putStrLn file diff --git a/Remote/Git.hs b/Remote/Git.hs index 5c10c0fc9..3725edd3a 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -7,8 +7,8 @@ module Remote.Git (remote, repoAvail) where -import Control.Exception.Extensible import qualified Data.Map as M +import Control.Exception.Extensible import Common.Annex import Utility.CopyFile @@ -102,11 +102,8 @@ tryGitConfigRead r where -- Reading config can fail due to IO error or -- for other reasons; catch all possible exceptions. - safely a = do - result <- liftIO (try a :: IO (Either SomeException Git.Repo)) - case result of - Left _ -> return r - Right r' -> return r' + safely a = either (const $ return r) return + =<< liftIO (try a :: IO (Either SomeException Git.Repo)) pipedconfig cmd params = safely $ pOpen ReadFromPipe cmd (toCommand params) $ diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs index 71e1e17f4..9b6005767 100644 --- a/Utility/Matcher.hs +++ b/Utility/Matcher.hs @@ -78,8 +78,8 @@ match a m v = go m where go MAny = True go (MAnd m1 m2) = go m1 && go m2 - go (MOr m1 m2) = go m1 || go m2 - go (MNot m1) = not (go m1) + go (MOr m1 m2) = go m1 || go m2 + go (MNot m1) = not $ go m1 go (MOp o) = a o v {- Runs a monadic Matcher, where Operations are actions in the monad. -} @@ -87,8 +87,8 @@ matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool matchM m v = go m where go MAny = return True - go (MAnd m1 m2) = andM (go m1) (go m2) - go (MOr m1 m2) = orM (go m1) (go m2) + go (MAnd m1 m2) = go m1 <&&> go m2 + go (MOr m1 m2) = go m1 <||> go m2 go (MNot m1) = liftM not (go m1) go (MOp o) = o v diff --git a/Utility/Monad.hs b/Utility/Monad.hs index 5cc243290..9c85d31ca 100644 --- a/Utility/Monad.hs +++ b/Utility/Monad.hs @@ -8,7 +8,7 @@ module Utility.Monad where import Data.Maybe -import Control.Monad (liftM, liftM2) +import Control.Monad (liftM) {- Return the first value from a list, if any, satisfying the given - predicate -} @@ -31,15 +31,13 @@ ifM cond (thenclause, elseclause) = do c <- cond if c then thenclause else elseclause -{- monadic || - - - - Compare with (||) <$> ma <*> mb, which always runs both ma and mb. -} -orM :: Monad m => m Bool -> m Bool -> m Bool -orM ma mb = ifM ma ( return True , mb ) +{- short-circuiting monadic || -} +(<||>) :: Monad m => m Bool -> m Bool -> m Bool +ma <||> mb = ifM ma ( return True , mb ) -{- monadic && (for completeness) -} -andM :: Monad m => m Bool -> m Bool -> m Bool -andM = liftM2 (&&) +{- short-circuiting monadic && -} +(<&&>) :: Monad m => m Bool -> m Bool -> m Bool +ma <&&> mb = ifM ma ( mb , return False ) {- Runs an action, passing its value to an observer before returning it. -} observe :: Monad m => (a -> m b) -> m a -> m a diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 10899d12c..dd94ccc0c 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -649,7 +649,7 @@ Here are all the supported configuration settings. A command to run when git-annex begins to use the remote. This can be used to, for example, mount the directory containing the remote. - The command may be run repeatedly in multiple git-annex processes + The command may be run repeatedly when multiple git-annex processes are running concurrently. * `remote.<name>.annex-stop-command` @@ -713,6 +713,12 @@ Here are all the supported configuration settings. Default ssh, rsync, wget/curl, and bup options to use if a remote does not have specific options. +* `remote.<name>.rsyncurl` + + Used by rsunc special remotes, this configures + the location of the rsync repository to use. Normally this is automaticaly + set up by `git annex initremote`, but you can change it if needed. + * `remote.<name>.buprepo` Used by bup special remotes, this configures |