{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- The 'Monad' library defines the 'MonadPlus' class, and provides some useful operations on monads.
--
-- The functions in this library use the following naming conventions: 
--
-- * A postfix `M' always stands for a function in the Kleisli category:
-- @m@ is added to function results (modulo currying) and nowhere else. So, for example, 
-- 
-- >  filter  ::              (a ->   Bool) -> [a] ->   [a]
-- >  filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
-- 
-- * A postfix `_' changes the result type from @(m a)@ to @(m ())@. Thus (in the "Prelude"): 
-- 
-- >  sequence  :: Monad m => [m a] -> m [a] 
-- >  sequence_ :: Monad m => [m a] -> m () 
-- 
-- * A prefix `m' generalises an existing function to a monadic form. Thus, for example: 
-- 
-- >  sum  :: Num a       => [a]   -> a
-- >  msum :: MonadPlus m => [m a] -> m a

module Control.Monad
    ( MonadPlus (   -- class context: Monad
	  mzero     -- :: (MonadPlus m) => m a
	, mplus     -- :: (MonadPlus m) => m a -> m a -> m a
	)
    , join          -- :: (Monad m) => m (m a) -> m a
    , guard         -- :: (MonadPlus m) => Bool -> m ()
    , when          -- :: (Monad m) => Bool -> m () -> m ()
    , unless        -- :: (Monad m) => Bool -> m () -> m ()
    , ap            -- :: (Monad m) => m (a -> b) -> m a -> m b
    , msum          -- :: (MonadPlus m) => [m a] -> m a
    , filterM       -- :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
    , mapAndUnzipM  -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
    , zipWithM      -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
    , zipWithM_     -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
    , foldM         -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a 
    , foldM_        -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
    
    , liftM         -- :: (Monad m) => (a -> b) -> (m a -> m b)
    , liftM2        -- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
    , liftM3        -- :: ...
    , liftM4        -- :: ...
    , liftM5        -- :: ...

    , Monad((>>=), (>>), return, fail)
    , Functor(fmap)

    , mapM          -- :: (Monad m) => (a -> m b) -> [a] -> m [b]
    , mapM_         -- :: (Monad m) => (a -> m b) -> [a] -> m ()
    , sequence      -- :: (Monad m) => [m a] -> m [a]
    , sequence_     -- :: (Monad m) => [m a] -> m ()
    , replicateM    -- :: (Monad m) => Int -> m a -> m [a]
    , replicateM_   -- :: (Monad m) => Int -> m a -> m ()
    , (=<<)         -- :: (Monad m) => (a -> m b) -> m a -> m b
    ) where

import Data.Maybe

-- -----------------------------------------------------------------------------
-- |The MonadPlus class definition

class Monad m => MonadPlus m where
   mzero :: m a
   mplus :: m a -> m a -> m a

instance MonadPlus [] where
   mzero = []
   mplus = (++)

instance MonadPlus Maybe where
   mzero = Nothing

   Nothing `mplus` ys  = ys
   xs      `mplus` _ys = xs

-- -----------------------------------------------------------------------------
-- Functions mandated by the Prelude

guard           :: (MonadPlus m) => Bool -> m ()
guard True      =  return ()
guard False     =  mzero

-- This subsumes the list-based filter function.

filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
filterM _ []     =  return []
filterM p (x:xs) =  do
   flg <- p x
   ys  <- filterM p xs
   return (if flg then x:ys else ys)

-- This subsumes the list-based concat function.

msum        :: MonadPlus m => [m a] -> m a
{-# INLINE msum #-}
msum        =  foldr mplus mzero

-- -----------------------------------------------------------------------------
-- Other monad functions

-- | The 'join' function is the conventional monad join operator. It is used to
-- remove one level of monadic structure, projecting its bound argument into the
-- outer level.
join              :: (Monad m) => m (m a) -> m a
join x            =  x >>= id

-- | The 'mapAndUnzipM' function maps its first argument over a list, returning
-- the result as a pair of lists. This function is mainly used with complicated
-- data structures or a state- transforming monad.
mapAndUnzipM      :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
mapAndUnzipM f xs =  sequence (map f xs) >>= return . unzip

-- | The 'zipWithM' function generalises zipWith to arbitrary monads.
zipWithM          :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM f xs ys  =  sequence (zipWith f xs ys)

-- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.
zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)

{- | The 'foldM' function is analogous to 'foldl', except that its result is
encapsulated in a monad. Note that 'foldM' works from left-to-right over
the list arguments. This could be an issue where '(>>)' and the `folded
function' are not commutative.

>	foldM f a1 [x1, x2, ..., xm ]
==  
>	do
>	  a2 <- f a1 x1
>	  a3 <- f a2 x2
>	  ...
>	  f am xm

If right-to-left evaluation is required, the input list should be reversed.

The when and unless functions provide conditional execution of monadic expressions. For example, 

>	when debug (putStr "Debugging\n")

will output the string @Debugging\\n@ if the Boolean value @debug@ is @True@, and otherwise do nothing.

The monadic lifting operators promote a function to a monad. The function arguments are scanned left to right. For example, 

>	liftM2 (+) [0,1] [0,2] = [0,2,1,3]
>	liftM2 (+) (Just 1) Nothing = Nothing

In many situations, the 'liftM' operations can be replaced by uses of 'ap', which promotes function application. 

>	return f `ap` x1 `ap` ... `ap` xn

is equivalent to 

>	liftMn f x1 x2 ... xn

-}
foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM _ a []      =  return a
foldM f a (x:xs)  =  f a x >>= \fax -> foldM f fax xs

foldM_            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
foldM_ f a xs     = foldM f a xs >> return ()

replicateM        :: (Monad m) => Int -> m a -> m [a]
replicateM n x    = sequence (replicate n x)

replicateM_       :: (Monad m) => Int -> m a -> m ()
replicateM_ n x   = sequence_ (replicate n x)

unless            :: (Monad m) => Bool -> m () -> m ()
unless p s        =  if p then return () else s

when              :: (Monad m) => Bool -> m () -> m ()
when p s          =  if p then s else return ()

ap                :: (Monad m) => m (a -> b) -> m a -> m b
ap                =  liftM2 id

liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r
liftM2  :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM3  :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM4  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM5  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r

liftM f m1              = do { x1 <- m1; return (f x1) }
liftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }
liftM3 f m1 m2 m3       = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }
liftM4 f m1 m2 m3 m4    = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }
liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }
