MonadUtils.hs 4.63 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11

-- | Utilities related to Monad and Applicative classes
--   Mostly for backwards compatability.

module MonadUtils
        ( Applicative(..)
        , (<$>)
        
        , MonadFix(..)
        , MonadIO(..)
        
12 13
        , liftIO1, liftIO2, liftIO3, liftIO4
        
14 15 16 17
        , mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M
        , mapAccumLM
        , mapSndM
        , concatMapM
18
        , mapMaybeM
batterseapower's avatar
batterseapower committed
19
        , anyM, allM
20 21 22 23 24 25 26 27 28 29 30 31 32 33
        , foldlM, foldrM
        ) where

----------------------------------------------------------------------------------------
-- Detection of available libraries
----------------------------------------------------------------------------------------

-- we don't depend on MTL for now
#define HAVE_MTL 0

----------------------------------------------------------------------------------------
-- Imports
----------------------------------------------------------------------------------------

34 35
import Maybes

36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
import Control.Applicative
#if HAVE_MTL
import Control.Monad.Trans
#endif
import Control.Monad
import Control.Monad.Fix

----------------------------------------------------------------------------------------
-- MTL
----------------------------------------------------------------------------------------

#if !HAVE_MTL

class Monad m => MonadIO m where
    liftIO :: IO a -> m a

52
instance MonadIO IO where liftIO = id
53 54
#endif

55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
----------------------------------------------------------------------------------------
-- Lift combinators
--  These are used throughout the compiler
----------------------------------------------------------------------------------------

-- | Lift an 'IO' operation with 1 argument into another monad
liftIO1 :: MonadIO m => (a -> IO b) -> a -> m b
liftIO1 = (.) liftIO

-- | Lift an 'IO' operation with 2 arguments into another monad
liftIO2 :: MonadIO m => (a -> b -> IO c) -> a -> b -> m c
liftIO2 = ((.).(.)) liftIO

-- | Lift an 'IO' operation with 3 arguments into another monad
liftIO3 :: MonadIO m => (a -> b -> c -> IO d) -> a -> b -> c -> m d
liftIO3 = ((.).((.).(.))) liftIO

-- | Lift an 'IO' operation with 4 arguments into another monad
liftIO4 :: MonadIO m => (a -> b -> c -> d -> IO e) -> a -> b -> c -> d -> m e
liftIO4 = (((.).(.)).((.).(.))) liftIO

76 77
----------------------------------------------------------------------------------------
-- Common functions
78
--  These are used throughout the compiler
79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
----------------------------------------------------------------------------------------

-- | 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)

117 118 119 120
-- | Monadic version of mapMaybe
mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM f = liftM catMaybes . mapM f

batterseapower's avatar
batterseapower committed
121
-- | Monadic version of 'any', aborts the computation at the first @True@ value
122 123 124 125 126 127
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

batterseapower's avatar
batterseapower committed
128 129 130 131 132
-- | Monad version of 'all', aborts the computation at the first @False@ value
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
allM _ []     = return True
allM f (b:bs) = (f b) >>= (\bv -> if bv then allM f bs else return False)

133 134 135 136 137 138 139
-- | 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
Simon Marlow's avatar
Simon Marlow committed
140
foldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }