{-# LANGUAGE NoMonomorphismRestriction #-}
-- | Library for control flow inside of monads with anaphoric variants on if and when and a C-like \"switch\" function.
-- 
-- Information: 
-- 
--   [@Author@] Jeff Heard
-- 
--   [@Copyright@] 2008 Jeff Heard
--   
--   [@License@] BSD
--  
--   [@Version@] 1.0
--
--   [@Status@] Alpha
module Control.Monad.IfElse where

import Control.Monad

-- A if with no else for unit returning thunks.  
--   Returns the value of the test.
-- when :: Monad m => Bool -> m () -> m Bool
-- when True action = action >> return True
-- when False _ = return False

-- | A if with no else for unit returning thunks.
--   Returns the value of the test.
whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
test m ()
action = m Bool
test forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
t -> if Bool
t then m ()
action else forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Like a switch statement, and less cluttered than if else if
-- 
-- > cond [ (t1,a1), (t2,a2), ... ]
cond :: Monad m => [(Bool, m ())] -> m ()
cond :: forall (m :: * -> *). Monad m => [(Bool, m ())] -> m ()
cond [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
cond ((Bool
True,m ()
action) : [(Bool, m ())]
_) = m ()
action 
cond ((Bool
False,m ()
_) : [(Bool, m ())]
rest) = forall (m :: * -> *). Monad m => [(Bool, m ())] -> m ()
cond [(Bool, m ())]
rest

-- | Like a switch statement, and less cluttered than if else if 
-- 
-- > condM [ (t1,a1), (t2,a2), ... ]
condM :: Monad m => [(m Bool, m ())] -> m ()
condM :: forall (m :: * -> *). Monad m => [(m Bool, m ())] -> m ()
condM [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
condM ((m Bool
test,m ()
action) : [(m Bool, m ())]
rest) = m Bool
test forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
t -> if Bool
t then m ()
action else forall (m :: * -> *). Monad m => [(m Bool, m ())] -> m ()
condM [(m Bool, m ())]
rest

-- | Chainable anaphoric when.  Takes a maybe value.  
--  
-- if the value is Just x then execute @ action x @ , then return @ True @ .  otherwise return @ False @ .
awhen :: Monad m => Maybe a -> (a -> m ()) -> m ()
awhen :: forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
awhen Maybe a
Nothing a -> m ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
awhen (Just a
x) a -> m ()
action = a -> m ()
action a
x 

-- | Chainable anaphoric whenM.
awhenM :: Monad m => m (Maybe a) -> (a -> m ()) -> m ()
awhenM :: forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
awhenM m (Maybe a)
test a -> m ()
action = m (Maybe a)
test forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
t -> case Maybe a
t of 
                                      Just a
x -> a -> m ()
action a
x 
                                      Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Anaphoric when-else chain.  Like a switch statement, but less cluttered
acond :: Monad m => [(Maybe a, a -> m ())] -> m ()
acond :: forall (m :: * -> *) a. Monad m => [(Maybe a, a -> m ())] -> m ()
acond ((Maybe a
Nothing,a -> m ()
_) : [(Maybe a, a -> m ())]
rest) = forall (m :: * -> *) a. Monad m => [(Maybe a, a -> m ())] -> m ()
acond [(Maybe a, a -> m ())]
rest
acond ((Just a
x, a -> m ()
action) : [(Maybe a, a -> m ())]
_) = a -> m ()
action a
x 
acond [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Anaphoric if.
aif :: Monad m => Maybe a -> (a -> m b) -> m b -> m b
aif :: forall (m :: * -> *) a b.
Monad m =>
Maybe a -> (a -> m b) -> m b -> m b
aif Maybe a
Nothing a -> m b
_ m b
elseclause = m b
elseclause
aif (Just a
x) a -> m b
ifclause m b
_ = a -> m b
ifclause a
x

-- | Anaphoric if where the test is in Monad m.
aifM :: Monad m => m (Maybe a) -> (a -> m b) -> m b -> m b
aifM :: forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> (a -> m b) -> m b -> m b
aifM m (Maybe a)
test a -> m b
ifclause m b
elseclause = m (Maybe a)
test forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
t -> forall (m :: * -> *) a b.
Monad m =>
Maybe a -> (a -> m b) -> m b -> m b
aif Maybe a
t a -> m b
ifclause m b
elseclause

-- | Contrapositive of whenM, if not x then do y
unlessM :: m Bool -> m () -> m ()
unlessM m Bool
a = forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ m Bool
a)

-- | unless-else chain.
ncond :: [(Bool, m ())] -> m ()
ncond [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
ncond ((Bool
test , m ()
action) : [(Bool, m ())]
rest) = if Bool -> Bool
not Bool
test then m ()
action else [(Bool, m ())] -> m ()
ncond [(Bool, m ())]
rest

-- | monadic unless-else chain
ncondM :: Monad m => [(m Bool, m ())] -> m ()
ncondM :: forall (m :: * -> *). Monad m => [(m Bool, m ())] -> m ()
ncondM [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
ncondM ((m Bool
test , m ()
action) : [(m Bool, m ())]
rest) = m Bool
test forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
t -> if Bool -> Bool
not Bool
t then m ()
action else forall (m :: * -> *). Monad m => [(m Bool, m ())] -> m ()
ncondM [(m Bool, m ())]
rest

-- | IO lifted @ && @
&&^ :: m Bool -> m Bool -> m Bool
(&&^) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&)

-- | IO lifted @ || @
||^ :: m Bool -> m Bool -> m Bool
(||^) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(||)

-- | Conditionally do the right action based on the truth value of the left expression
>>? :: Bool -> f () -> f ()
(>>?) = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
infixl 1 >>?

-- | unless the left side is true, perform the right action
>>! :: Bool -> f () -> f ()
(>>!) = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
infixl 1 >>!

-- | unless the (monadic) left side is true, perform the right action
>>=>>! :: m Bool -> m () -> m ()
(>>=>>!) = forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM
infixl 1 >>=>>!

-- | Bind the result of the last expression in an anaphoric when.  
>>=? :: Maybe a -> (a -> m ()) -> m ()
(>>=?) = forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
awhen
infixl 1 >>=?

-- | composition of @ >>= @ and @ >>? @
>>=>>? :: m Bool -> m () -> m ()
(>>=>>?) = forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM
infixl 1 >>=>>?

-- | composition of @ >>= @ and @ >>=? @
>>=>>=? :: m (Maybe a) -> (a -> m ()) -> m ()
(>>=>>=?) = forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
awhenM
infixl 1 >>=>>=?

--
-- The following is from Control.Monad.Extras by Wren Thornton.
--

-- | Execute a monadic action so long as a monadic boolean returns
-- true.
{-# SPECIALIZE whileM :: IO Bool -> IO () -> IO () #-}
whileM                :: (Monad m) => m Bool -> m () -> m ()
whileM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whileM m Bool
mb m ()
m = do Bool
b <- m Bool
mb ; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (m ()
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whileM m Bool
mb m ()
m)


-- Named with M because 'Prelude.until' exists
-- | Negation of 'whileM': execute an action so long as the boolean
-- returns false.
{-# SPECIALIZE untilM :: IO Bool -> IO () -> IO () #-}
untilM                :: (Monad m) => m Bool -> m () -> m ()
untilM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
untilM m Bool
mb m ()
m = do Bool
b <- m Bool
mb ; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (m ()
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
untilM m Bool
mb m ()
m)


-- | Strict version of 'return' because usually we don't need that
-- extra thunk.
{-# INLINE return' #-}
return'  :: (Monad m) => a -> m a
return' :: forall (m :: * -> *) a. Monad m => a -> m a
return' a
x = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
x


-- | Take an action and make it into a side-effecting 'return'.
-- Because I seem to keep running into @m ()@ and the like.
infixr 8 `returning`
{-# INLINE returning #-}
returning      :: (Monad m) => (a -> m b) -> (a -> m a)
a -> m b
f returning :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> a -> m a
`returning` a
x = a -> m b
f a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
x


-- For reference this is also helpful:
-- >    liftM2 (>>) f g == \x -> f x >> g x


-- | This conversion is common enough to make a name for.
{-# INLINE maybeMP #-}
maybeMP :: (MonadPlus m) => Maybe a -> m a
maybeMP :: forall (m :: * -> *) a. MonadPlus m => Maybe a -> m a
maybeMP  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return

-- This rule should only fire when type-safe
{-# RULES "maybeMP/id" maybeMP = id #-}