summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-06-15 14:44:43 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-06-15 14:44:43 -0400
commit2834b8880407cd4942766ddfacff94f22da1700a (patch)
tree69a2c584773fd81180172746e4d0d7a943dfaffd /Utility
parent2c0428907a8f17b2957ec08cd7ba6bd05e173a4e (diff)
assistant: In direct mode, objects are now only dropped when all associated files are unwanted. This avoids a repreated drop/get loop of a file that has a copy in an archive directory, and a copy not in an archive directory. (Indirect mode still has some buggy behavior in this area, since it does not keep track of associated files.) Closes: #712060
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Monad.hs4
1 files changed, 4 insertions, 0 deletions
diff --git a/Utility/Monad.hs b/Utility/Monad.hs
index 4c3c30473..b66419f76 100644
--- a/Utility/Monad.hs
+++ b/Utility/Monad.hs
@@ -27,6 +27,10 @@ getM p (x:xs) = maybe (getM p xs) (return . Just) =<< p x
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM p = liftM isJust . firstM p
+allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
+allM _ [] = return True
+allM p (x:xs) = p x <&&> allM p xs
+
{- Runs an action on values from a list until it succeeds. -}
untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool
untilTrue = flip anyM