MonadUtils.hs 5.97 KB
Newer Older
1 2 3 4

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

Ian Lynagh's avatar
Ian Lynagh committed
5 6 7 8 9 10 11
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

12 13 14 15 16 17
module MonadUtils
        ( Applicative(..)
        , (<$>)
        
        , MonadFix(..)
        , MonadIO(..)
18
	
19
        , liftIO1, liftIO2, liftIO3, liftIO4
20 21

        , zipWith3M        
22 23 24 25
        , mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M
        , mapAccumLM
        , mapSndM
        , concatMapM
26
        , mapMaybeM
27
	, fmapMaybeM, fmapEitherM
batterseapower's avatar
batterseapower committed
28
        , anyM, allM
29
        , foldlM, foldlM_, foldrM
30
        , maybeMapM
31 32
        ) where

33
-------------------------------------------------------------------------------
34
-- Detection of available libraries
35
-------------------------------------------------------------------------------
36 37 38 39

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

40
-------------------------------------------------------------------------------
41
-- Imports
42
-------------------------------------------------------------------------------
43

44 45
import Maybes

46 47 48 49 50 51 52
import Control.Applicative
#if HAVE_MTL
import Control.Monad.Trans
#endif
import Control.Monad
import Control.Monad.Fix

53
-------------------------------------------------------------------------------
54
-- MTL
55
-------------------------------------------------------------------------------
56 57 58 59 60 61

#if !HAVE_MTL

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

62
instance MonadIO IO where liftIO = id
63 64
#endif

65
-------------------------------------------------------------------------------
66 67
-- Lift combinators
--  These are used throughout the compiler
68
-------------------------------------------------------------------------------
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85

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

86
-------------------------------------------------------------------------------
87
-- Common functions
88
--  These are used throughout the compiler
89
-------------------------------------------------------------------------------
90

91 92 93 94 95 96 97 98 99 100
zipWith3M :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]
zipWith3M _ []     _      _      = return []
zipWith3M _ _      []     _      = return []
zipWith3M _ _      _      []     = return []
zipWith3M f (x:xs) (y:ys) (z:zs) 
  = do { r  <- f x y z
       ; rs <- zipWith3M f xs ys zs
       ; return $ r:rs
       }

101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
-- | 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)

137 138 139 140
-- | Monadic version of mapMaybe
mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM f = liftM catMaybes . mapM f

141 142 143 144 145 146 147 148 149 150
-- | Monadic version of fmap
fmapMaybeM :: (Monad m) => (a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybeM _ Nothing  = return Nothing
fmapMaybeM f (Just x) = f x >>= (return . Just)

-- | Monadic version of fmap
fmapEitherM :: Monad m => (a -> m b) -> (c -> m d) -> Either a c -> m (Either b d)
fmapEitherM fl _ (Left  a) = fl a >>= (return . Left)
fmapEitherM _ fr (Right b) = fr b >>= (return . Right)

batterseapower's avatar
batterseapower committed
151
-- | Monadic version of 'any', aborts the computation at the first @True@ value
152 153 154 155 156 157
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
158 159 160 161 162
-- | 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)

163 164 165 166
-- | Monadic version of foldl
foldlM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldlM = foldM

167 168 169 170
-- | Monadic version of foldl that discards its result
foldlM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
foldlM_ = foldM_

171 172 173
-- | 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
174
foldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }
175 176 177 178 179

-- | Monadic version of fmap specialised for Maybe
maybeMapM :: Monad m => (a -> m b) -> (Maybe a -> m (Maybe b))
maybeMapM _ Nothing  = return Nothing
maybeMapM m (Just x) = liftM Just $ m x