diff options
| -rw-r--r-- | Command/Find.hs | 2 | ||||
| -rw-r--r-- | Utility/Matcher.hs | 6 | ||||
| -rw-r--r-- | Utility/Monad.hs | 12 | ||||
| -rw-r--r-- | Utility/Url.hs | 4 |
4 files changed, 15 insertions, 9 deletions
diff --git a/Command/Find.hs b/Command/Find.hs index 33f512e39..f5bd2734b 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 (liftM2 (||) limited (inAnnex key)) $ + whenM (orM limited (inAnnex key)) $ unlessM (showFullJSON vars) $ case format of Nothing -> liftIO $ putStrLn file diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs index 01500a211..71e1e17f4 100644 --- a/Utility/Matcher.hs +++ b/Utility/Matcher.hs @@ -25,7 +25,7 @@ module Utility.Matcher ( matchesAny ) where -import Control.Monad +import Common {- A Token can be an Operation of an arbitrary type, or one of a few - predefined peices of syntax. -} @@ -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) = liftM2 (&&) (go m1) (go m2) - go (MOr m1 m2) = liftM2 (||) (go m1) (go m2) + go (MAnd m1 m2) = andM (go m1) (go m2) + go (MOr m1 m2) = orM (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 23c0c4c19..5cc243290 100644 --- a/Utility/Monad.hs +++ b/Utility/Monad.hs @@ -8,7 +8,7 @@ module Utility.Monad where import Data.Maybe -import Control.Monad (liftM) +import Control.Monad (liftM, liftM2) {- Return the first value from a list, if any, satisfying the given - predicate -} @@ -31,6 +31,16 @@ 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 ) + +{- monadic && (for completeness) -} +andM :: Monad m => m Bool -> m Bool -> m Bool +andM = liftM2 (&&) + {- Runs an action, passing its value to an observer before returning it. -} observe :: Monad m => (a -> m b) -> m a -> m a observe observer a = do diff --git a/Utility/Url.hs b/Utility/Url.hs index 8a8d732a3..86d66d83b 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -9,7 +9,6 @@ module Utility.Url ( URLString, check, exists, - canDownload, download, get ) where @@ -44,9 +43,6 @@ exists url = where size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders -canDownload :: IO Bool -canDownload = (||) <$> inPath "wget" <*> inPath "curl" - {- Used to download large files, such as the contents of keys. - - Uses wget or curl program for its progress bar. (Wget has a better one, |