{- monadic stuff
 -
 - Copyright 2010-2012 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -}

{-# OPTIONS_GHC -fno-warn-tabs #-}

module Utility.Monad where

import Data.Maybe
import Control.Monad

{- Return the first value from a list, if any, satisfying the given
 - predicate -}
firstM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
firstM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM a -> m Bool
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
firstM a -> m Bool
p (a
x:[a]
xs) = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (a -> m Bool
p a
x) (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x , forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM a -> m Bool
p [a]
xs)

{- Runs the action on values from the list until it succeeds, returning
 - its result. -}
getM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM a -> m (Maybe b)
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getM a -> m (Maybe b)
p (a
x:[a]
xs) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM a -> m (Maybe b)
p [a]
xs) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m (Maybe b)
p a
x

{- Returns true if any value in the list satisfies the predicate,
 - stopping once one is found. -}
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM a -> m Bool
p = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM a -> m Bool
p

allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
allM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM a -> m Bool
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
allM a -> m Bool
p (a
x:[a]
xs) = a -> m Bool
p a
x forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM a -> m Bool
p [a]
xs

{- Runs an action on values from a list until it succeeds. -}
untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool
untilTrue :: forall (m :: * -> *) a. Monad m => [a] -> (a -> m Bool) -> m Bool
untilTrue = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM

{- if with a monadic conditional. -}
ifM :: Monad m => m Bool -> (m a, m a) -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM m Bool
cond (m a
thenclause, m a
elseclause) = do
	Bool
c <- m Bool
cond
	if Bool
c then m a
thenclause else m a
elseclause

{- short-circuiting monadic || -}
(<||>) :: Monad m => m Bool -> m Bool -> m Bool
m Bool
ma <||> :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> m Bool
mb = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM m Bool
ma ( forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True , m Bool
mb )

{- short-circuiting monadic && -}
(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
m Bool
ma <&&> :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> m Bool
mb = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM m Bool
ma ( m Bool
mb , forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False )

{- Same fixity as && and || -}
infixr 3 <&&>
infixr 2 <||>

{- Runs an action, passing its value to an observer before returning it. -}
observe :: Monad m => (a -> m b) -> m a -> m a
observe :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m a
observe a -> m b
observer m a
a = do
	a
r <- m a
a
	b
_ <- a -> m b
observer a
r
	forall (m :: * -> *) a. Monad m => a -> m a
return a
r

{- b `after` a runs first a, then b, and returns the value of a -}
after :: Monad m => m b -> m a -> m a
after :: forall (m :: * -> *) b a. Monad m => m b -> m a -> m a
after = forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m a
observe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

{- do nothing -}
noop :: Monad m => m ()
noop :: forall (m :: * -> *). Monad m => m ()
noop = forall (m :: * -> *) a. Monad m => a -> m a
return ()