fun with symbols

Nothing at all on hackage is using <&&> or <||>.

(Also, <&&> should short-circuit on failure.)
This commit is contained in:
Joey Hess 2012-03-17 00:22:05 -04:00
parent d6624b6c79
commit a362c46b70
4 changed files with 15 additions and 20 deletions

View file

@ -42,7 +42,7 @@ start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandSta
start format file (key, _) = do start format file (key, _) = do
-- only files inAnnex are shown, unless the user has requested -- only files inAnnex are shown, unless the user has requested
-- others via a limit -- others via a limit
whenM (orM limited (inAnnex key)) $ whenM (limited <||> inAnnex key) $
unlessM (showFullJSON vars) $ unlessM (showFullJSON vars) $
case format of case format of
Nothing -> liftIO $ putStrLn file Nothing -> liftIO $ putStrLn file

View file

@ -7,8 +7,8 @@
module Remote.Git (remote, repoAvail) where module Remote.Git (remote, repoAvail) where
import Control.Exception.Extensible
import qualified Data.Map as M import qualified Data.Map as M
import Control.Exception.Extensible
import Common.Annex import Common.Annex
import Utility.CopyFile import Utility.CopyFile
@ -102,11 +102,8 @@ tryGitConfigRead r
where where
-- Reading config can fail due to IO error or -- Reading config can fail due to IO error or
-- for other reasons; catch all possible exceptions. -- for other reasons; catch all possible exceptions.
safely a = do safely a = either (const $ return r) return
result <- liftIO (try a :: IO (Either SomeException Git.Repo)) =<< liftIO (try a :: IO (Either SomeException Git.Repo))
case result of
Left _ -> return r
Right r' -> return r'
pipedconfig cmd params = safely $ pipedconfig cmd params = safely $
pOpen ReadFromPipe cmd (toCommand params) $ pOpen ReadFromPipe cmd (toCommand params) $

View file

@ -78,8 +78,8 @@ match a m v = go m
where where
go MAny = True go MAny = True
go (MAnd m1 m2) = go m1 && go m2 go (MAnd m1 m2) = go m1 && go m2
go (MOr m1 m2) = go m1 || go m2 go (MOr m1 m2) = go m1 || go m2
go (MNot m1) = not (go m1) go (MNot m1) = not $ go m1
go (MOp o) = a o v go (MOp o) = a o v
{- Runs a monadic Matcher, where Operations are actions in the monad. -} {- 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 matchM m v = go m
where where
go MAny = return True go MAny = return True
go (MAnd m1 m2) = andM (go m1) (go m2) go (MAnd m1 m2) = go m1 <&&> go m2
go (MOr m1 m2) = orM (go m1) (go m2) go (MOr m1 m2) = go m1 <||> go m2
go (MNot m1) = liftM not (go m1) go (MNot m1) = liftM not (go m1)
go (MOp o) = o v go (MOp o) = o v

View file

@ -8,7 +8,7 @@
module Utility.Monad where module Utility.Monad where
import Data.Maybe import Data.Maybe
import Control.Monad (liftM, liftM2) import Control.Monad (liftM)
{- Return the first value from a list, if any, satisfying the given {- Return the first value from a list, if any, satisfying the given
- predicate -} - predicate -}
@ -31,15 +31,13 @@ ifM cond (thenclause, elseclause) = do
c <- cond c <- cond
if c then thenclause else elseclause if c then thenclause else elseclause
{- monadic || {- short-circuiting monadic || -}
- (<||>) :: Monad m => m Bool -> m Bool -> m Bool
- Compare with (||) <$> ma <*> mb, which always runs both ma and mb. -} ma <||> mb = ifM ma ( return True , mb )
orM :: Monad m => m Bool -> m Bool -> m Bool
orM ma mb = ifM ma ( return True , mb )
{- monadic && (for completeness) -} {- short-circuiting monadic && -}
andM :: Monad m => m Bool -> m Bool -> m Bool (<&&>) :: Monad m => m Bool -> m Bool -> m Bool
andM = liftM2 (&&) ma <&&> mb = ifM ma ( mb , return False )
{- Runs an action, passing its value to an observer before returning it. -} {- Runs an action, passing its value to an observer before returning it. -}
observe :: Monad m => (a -> m b) -> m a -> m a observe :: Monad m => (a -> m b) -> m a -> m a