Commit acb70e7c authored by twanvl's avatar twanvl

Add 'util/MonadUtils.hs' with common monad (and applicative) combinators

parent 16ad556b
-- | Utilities related to Monad and Applicative classes
-- Mostly for backwards compatability.
module MonadUtils
( Applicative(..)
, (<$>)
, MonadFix(..)
, MonadIO(..)
, mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M
, mapAccumLM
, mapSndM
, concatMapM
, anyM
, foldlM, foldrM
) where
----------------------------------------------------------------------------------------
-- Detection of available libraries
----------------------------------------------------------------------------------------
#define HAVE_APPLICATIVE 1
-- we don't depend on MTL for now
#define HAVE_MTL 0
----------------------------------------------------------------------------------------
-- Imports
----------------------------------------------------------------------------------------
#if HAVE_APPLICATIVE
import Control.Applicative
#endif
#if HAVE_MTL
import Control.Monad.Trans
#endif
import Control.Monad
import Control.Monad.Fix
----------------------------------------------------------------------------------------
-- Applicative
----------------------------------------------------------------------------------------
#if !HAVE_APPLICATIVE
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
(<$>) :: Functor f => (a -> b) -> (f a -> f b)
(<$>) = fmap
infixl 4 <$>
infixl 4 <*>
#endif
----------------------------------------------------------------------------------------
-- MTL
----------------------------------------------------------------------------------------
#if !HAVE_MTL
class Monad m => MonadIO m where
liftIO :: IO a -> m a
#endif
----------------------------------------------------------------------------------------
-- Common functions
-- These are used throught the compiler
----------------------------------------------------------------------------------------
-- | mapAndUnzipM for triples
mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])
mapAndUnzip3M _ [] = return ([],[],[])
mapAndUnzip3M f (x:xs) = do
(r1, r2, r3) <- f x
(rs1, rs2, rs3) <- mapAndUnzip3M f xs
return (r1:rs1, r2:rs2, r3:rs3)
mapAndUnzip4M :: Monad m => (a -> m (b,c,d,e)) -> [a] -> m ([b],[c],[d],[e])
mapAndUnzip4M _ [] = return ([],[],[],[])
mapAndUnzip4M f (x:xs) = do
(r1, r2, r3, r4) <- f x
(rs1, rs2, rs3, rs4) <- mapAndUnzip4M f xs
return (r1:rs1, r2:rs2, r3:rs3, r4:rs4)
-- | Monadic version of mapAccumL
mapAccumLM :: Monad m
=> (acc -> x -> m (acc, y)) -- ^ combining funcction
-> acc -- ^ initial state
-> [x] -- ^ inputs
-> m (acc, [y]) -- ^ final state, outputs
mapAccumLM _ s [] = return (s, [])
mapAccumLM f s (x:xs) = do
(s1, x') <- f s x
(s2, xs') <- mapAccumLM f s1 xs
return (s2, x' : xs')
-- | Monadic version of mapSnd
mapSndM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
mapSndM _ [] = return []
mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }
-- | Monadic version of concatMap
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM f xs = liftM concat (mapM f xs)
-- | Monadic version of 'any', aborts the computation at the first False value
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM _ [] = return False
anyM f (x:xs) = do b <- f x
if b then return True
else anyM f xs
-- | Monadic version of foldl
foldlM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldlM = foldM
-- | Monadic version of foldr
foldrM :: (Monad m) => (b -> a -> m a) -> a -> [b] -> m a
foldrM _ z [] = return z
foldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment