    {- 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 :: (a -> m Bool) -> [a] -> m (Maybe a)
    firstM _ [] = Maybe a -> m (Maybe a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
    firstM p :: a -> m Bool
    p (x :: a
    x:xs :: [a]
    xs) = m Bool -> (m (Maybe a), m (Maybe a)) -> m (Maybe a)
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (a -> m Bool
    p a
    x) (Maybe a -> m (Maybe a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x , (a -> m Bool) -> [a] -> m (Maybe a)
    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 :: (a -> m (Maybe b)) -> [a] -> m (Maybe b)
    getM _ [] = Maybe b -> m (Maybe b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe b
    forall a. Maybe a
    Nothing
    getM p :: a -> m (Maybe b)
    p (x :: a
    x:xs :: [a]
    xs) = m (Maybe b) -> (b -> m (Maybe b)) -> Maybe b -> m (Maybe b)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ((a -> m (Maybe b)) -> [a] -> m (Maybe b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m (Maybe b)) -> [a] -> m (Maybe b)
    getM a -> m (Maybe b)
    p [a]
    xs) (Maybe b -> m (Maybe b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe b -> m (Maybe b)) -> (b -> Maybe b) -> b -> m (Maybe b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> Maybe b
    forall a. a -> Maybe a
    Just) (Maybe b -> m (Maybe b)) -> m (Maybe b) -> m (Maybe b)
    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 :: (a -> m Bool) -> [a] -> m Bool
    anyM p :: a -> m Bool
    p = (Maybe a -> Bool) -> m (Maybe a) -> m Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Maybe a -> Bool
    forall a. Maybe a -> Bool
    isJust (m (Maybe a) -> m Bool) -> ([a] -> m (Maybe a)) -> [a] -> m Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> m Bool) -> [a] -> m (Maybe a)
    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 :: (a -> m Bool) -> [a] -> m Bool
    allM _ [] = Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    allM p :: a -> m Bool
    p (x :: a
    x:xs :: [a]
    xs) = a -> m Bool
    p a
    x m Bool -> m Bool -> m Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <&&> (a -> m Bool) -> [a] -> 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 :: [a] -> (a -> m Bool) -> m Bool
    untilTrue = ((a -> m Bool) -> [a] -> m Bool) -> [a] -> (a -> m Bool) -> m Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (a -> m Bool) -> [a] -> m Bool
    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 :: m Bool -> (m a, m a) -> m a
    ifM cond :: m Bool
    cond (thenclause :: m a
    thenclause, elseclause :: 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
    ma :: m Bool
    ma <||> :: m Bool -> m Bool -> m Bool
    <||> mb :: m Bool
    mb = m Bool -> (m Bool, m Bool) -> m Bool
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM m Bool
    ma ( Bool -> m Bool
    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
    ma :: m Bool
    ma <&&> :: m Bool -> m Bool -> m Bool
    <&&> mb :: m Bool
    mb = m Bool -> (m Bool, m Bool) -> m Bool
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM m Bool
    ma ( m Bool
    mb , Bool -> m Bool
    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 :: (a -> m b) -> m a -> m a
    observe observer :: a -> m b
    observer a :: m a
    a = do
    	a
    r <- m a
    a
    	b
    _ <- a -> m b
    observer a
    r
    	a -> m a
    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 :: m b -> m a -> m a
    after = (a -> m b) -> m a -> m a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m a
    observe ((a -> m b) -> m a -> m a)
    -> (m b -> a -> m b) -> m b -> m a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m b -> a -> m b
    forall a b. a -> b -> a
    const

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