{-# 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 :: m Bool -> m () -> m ()
whenM test :: m Bool
test action :: m ()
action = m Bool
test m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: Bool
t -> if Bool
t then m ()
action else () -> m ()
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 :: [(Bool, m ())] -> m ()
cond [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cond ((True,action :: m ()
action) : _) = m ()
action 
cond ((False,_) : rest :: [(Bool, m ())]
rest) = [(Bool, m ())] -> m ()
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 :: [(m Bool, m ())] -> m ()
condM [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
condM ((test :: m Bool
test,action :: m ()
action) : rest :: [(m Bool, m ())]
rest) = m Bool
test m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: Bool
t -> if Bool
t then m ()
action else [(m Bool, m ())] -> m ()
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 :: Maybe a -> (a -> m ()) -> m ()
awhen Nothing _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
awhen (Just x :: a
x) action :: a -> m ()
action = a -> m ()
action a
x 

-- | Chainable anaphoric whenM.
awhenM :: Monad m => m (Maybe a) -> (a -> m ()) -> m ()
awhenM :: m (Maybe a) -> (a -> m ()) -> m ()
awhenM test :: m (Maybe a)
test action :: a -> m ()
action = m (Maybe a)
test m (Maybe a) -> (Maybe a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: Maybe a
t -> case Maybe a
t of 
                                      Just x :: a
x -> a -> m ()
action a
x 
                                      Nothing -> () -> m ()
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 :: [(Maybe a, a -> m ())] -> m ()
acond ((Nothing,_) : rest :: [(Maybe a, a -> m ())]
rest) = [(Maybe a, a -> m ())] -> m ()
forall (m :: * -> *) a. Monad m => [(Maybe a, a -> m ())] -> m ()
acond [(Maybe a, a -> m ())]
rest
acond ((Just x :: a
x, action :: a -> m ()
action) : _) = a -> m ()
action a
x 
acond [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Anaphoric if.
aif :: Monad m => Maybe a -> (a -> m b) -> m b -> m b
aif :: Maybe a -> (a -> m b) -> m b -> m b
aif Nothing _ elseclause :: m b
elseclause = m b
elseclause
aif (Just x :: a
x) ifclause :: a -> m b
ifclause _ = 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 :: m (Maybe a) -> (a -> m b) -> m b -> m b
aifM test :: m (Maybe a)
test ifclause :: a -> m b
ifclause elseclause :: m b
elseclause = m (Maybe a)
test m (Maybe a) -> (Maybe a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: Maybe a
t -> Maybe a -> (a -> m b) -> m b -> m b
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 a :: m Bool
a = m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((Bool -> Bool) -> m Bool -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ m Bool
a)

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

-- | IO lifted @ && @
&&^ :: m Bool -> m Bool -> m Bool
(&&^) = (Bool -> Bool -> Bool) -> 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
(||^) = (Bool -> Bool -> Bool) -> 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 ()
(>>?) = 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 ()
(>>!) = 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 ()
(>>=>>!) = 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 ()
(>>=?) = 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 ()
(>>=>>?) = m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM
infixl 1 >>=>>?

-- | composition of @ >>= @ and @ >>=? @
>>=>>=? :: m (Maybe a) -> (a -> m ()) -> m ()
(>>=>>=?) = 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 :: m Bool -> m () -> m ()
whileM mb :: m Bool
mb m :: m ()
m = do Bool
b <- m Bool
mb ; Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (m ()
m m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Bool -> m () -> m ()
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 :: m Bool -> m () -> m ()
untilM mb :: m Bool
mb m :: m ()
m = do Bool
b <- m Bool
mb ; Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (m ()
m m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Bool -> m () -> m ()
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' :: a -> m a
return' x :: a
x = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
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)
f :: a -> m b
f returning :: (a -> m b) -> a -> m a
`returning` x :: a
x = a -> m b
f a
x m b -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
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 :: Maybe a -> m a
maybeMP  = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

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