summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-03-17 00:22:05 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-03-17 00:38:40 -0400
commita362c46b70c45872ff8c479ba5a6716cf13cc8d8 (patch)
treee8f08204dc679a1d7c23b5cd466606e7877a2469
parentd6624b6c798df401eb9e715810537d2b93935a76 (diff)
fun with symbols
Nothing at all on hackage is using <&&> or <||>. (Also, <&&> should short-circuit on failure.)
-rw-r--r--Command/Find.hs2
-rw-r--r--Remote/Git.hs9
-rw-r--r--Utility/Matcher.hs8
-rw-r--r--Utility/Monad.hs16
4 files changed, 15 insertions, 20 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