{-# 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 test action = test >>= \t -> if t then action else return ()

-- | Like a switch statement, and less cluttered than if else if
-- 
-- > cond [ (t1,a1), (t2,a2), ... ]
cond :: Monad m => [(Bool, m ())] -> m ()
cond [] = return ()
cond ((True,action) : _) = action 
cond ((False,_) : rest) = cond 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 [] = return ()
condM ((test,action) : rest) = test >>= \t -> if t then action else condM 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 Nothing _ = return ()
awhen (Just x) action = action x 

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

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

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

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

-- | IO lifted @ && @
(&&^) = liftM2 (&&)

-- | IO lifted @ || @
(||^) = liftM2 (||)

-- | Conditionally do the right action based on the truth value of the left expression
(>>?) = when
infixl 1 >>?

-- | Bind the result of the last expression in an anaphoric when.  
(>>=?) = awhen
infixl 1 >>=?

-- | composition of @ >>= @ and @ >>? @
(>>=>>?) = whenM
infixl 1 >>=>>?

-- | composition of @ >>= @ and @ >>=? @
(>>=>>=?) = awhenM
infixl 1 >>=>>=?