2011-10-16 04:31:25 +00:00
|
|
|
{- monadic stuff
|
|
|
|
-
|
|
|
|
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Utility.Monad where
|
|
|
|
|
|
|
|
import Data.Maybe
|
|
|
|
import Control.Monad (liftM)
|
|
|
|
|
|
|
|
{- Return the first value from a list, if any, satisfying the given
|
|
|
|
- predicate -}
|
2012-01-21 06:24:12 +00:00
|
|
|
firstM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
|
2011-10-16 04:31:25 +00:00
|
|
|
firstM _ [] = return Nothing
|
|
|
|
firstM p (x:xs) = do
|
|
|
|
q <- p x
|
|
|
|
if q
|
|
|
|
then return (Just x)
|
|
|
|
else firstM p xs
|
|
|
|
|
2012-01-03 22:36:31 +00:00
|
|
|
{- Returns true if any value in the list satisfies the predicate,
|
2011-10-16 04:31:25 +00:00
|
|
|
- stopping once one is found. -}
|
2012-01-21 06:24:12 +00:00
|
|
|
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
|
2011-10-16 04:31:25 +00:00
|
|
|
anyM p = liftM isJust . firstM p
|
2011-12-03 13:10:23 +00:00
|
|
|
|
|
|
|
{- Runs an action on values from a list until it succeeds. -}
|
2012-01-21 06:24:12 +00:00
|
|
|
untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool
|
2011-12-03 13:10:23 +00:00
|
|
|
untilTrue = flip anyM
|
2012-01-02 15:01:08 +00:00
|
|
|
|
2012-01-03 04:29:27 +00:00
|
|
|
{- Runs an action, passing its value to an observer before returning it. -}
|
2012-01-21 06:24:12 +00:00
|
|
|
observe :: Monad m => (a -> m b) -> m a -> m a
|
2012-01-02 15:01:08 +00:00
|
|
|
observe observer a = do
|
|
|
|
r <- a
|
|
|
|
_ <- observer r
|
|
|
|
return r
|
2012-01-02 18:54:23 +00:00
|
|
|
|
2012-01-03 04:29:27 +00:00
|
|
|
{- b `after` a runs first a, then b, and returns the value of a -}
|
2012-01-21 06:24:12 +00:00
|
|
|
after :: Monad m => m b -> m a -> m a
|
2012-01-03 04:29:27 +00:00
|
|
|
after = observe . const
|