utils: detabify/dewhitespace GraphPpr
[ghc.git] / compiler / utils / MonadUtils.hs
1
2 -- | Utilities related to Monad and Applicative classes
3 -- Mostly for backwards compatability.
4
5 module MonadUtils
6 ( Applicative(..)
7 , (<$>)
8
9 , MonadFix(..)
10 , MonadIO(..)
11
12 , liftIO1, liftIO2, liftIO3, liftIO4
13
14 , zipWith3M
15 , mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M
16 , mapAccumLM
17 , mapSndM
18 , concatMapM
19 , mapMaybeM
20 , fmapMaybeM, fmapEitherM
21 , anyM, allM
22 , foldlM, foldlM_, foldrM
23 , maybeMapM
24 ) where
25
26 -------------------------------------------------------------------------------
27 -- Imports
28 -------------------------------------------------------------------------------
29
30 import Maybes
31
32 import Control.Applicative
33 import Control.Monad
34 import Control.Monad.Fix
35 import Control.Monad.IO.Class
36
37 -------------------------------------------------------------------------------
38 -- Lift combinators
39 -- These are used throughout the compiler
40 -------------------------------------------------------------------------------
41
42 -- | Lift an 'IO' operation with 1 argument into another monad
43 liftIO1 :: MonadIO m => (a -> IO b) -> a -> m b
44 liftIO1 = (.) liftIO
45
46 -- | Lift an 'IO' operation with 2 arguments into another monad
47 liftIO2 :: MonadIO m => (a -> b -> IO c) -> a -> b -> m c
48 liftIO2 = ((.).(.)) liftIO
49
50 -- | Lift an 'IO' operation with 3 arguments into another monad
51 liftIO3 :: MonadIO m => (a -> b -> c -> IO d) -> a -> b -> c -> m d
52 liftIO3 = ((.).((.).(.))) liftIO
53
54 -- | Lift an 'IO' operation with 4 arguments into another monad
55 liftIO4 :: MonadIO m => (a -> b -> c -> d -> IO e) -> a -> b -> c -> d -> m e
56 liftIO4 = (((.).(.)).((.).(.))) liftIO
57
58 -------------------------------------------------------------------------------
59 -- Common functions
60 -- These are used throughout the compiler
61 -------------------------------------------------------------------------------
62
63 zipWith3M :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]
64 zipWith3M _ [] _ _ = return []
65 zipWith3M _ _ [] _ = return []
66 zipWith3M _ _ _ [] = return []
67 zipWith3M f (x:xs) (y:ys) (z:zs)
68 = do { r <- f x y z
69 ; rs <- zipWith3M f xs ys zs
70 ; return $ r:rs
71 }
72
73 -- | mapAndUnzipM for triples
74 mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])
75 mapAndUnzip3M _ [] = return ([],[],[])
76 mapAndUnzip3M f (x:xs) = do
77 (r1, r2, r3) <- f x
78 (rs1, rs2, rs3) <- mapAndUnzip3M f xs
79 return (r1:rs1, r2:rs2, r3:rs3)
80
81 mapAndUnzip4M :: Monad m => (a -> m (b,c,d,e)) -> [a] -> m ([b],[c],[d],[e])
82 mapAndUnzip4M _ [] = return ([],[],[],[])
83 mapAndUnzip4M f (x:xs) = do
84 (r1, r2, r3, r4) <- f x
85 (rs1, rs2, rs3, rs4) <- mapAndUnzip4M f xs
86 return (r1:rs1, r2:rs2, r3:rs3, r4:rs4)
87
88 -- | Monadic version of mapAccumL
89 mapAccumLM :: Monad m
90 => (acc -> x -> m (acc, y)) -- ^ combining funcction
91 -> acc -- ^ initial state
92 -> [x] -- ^ inputs
93 -> m (acc, [y]) -- ^ final state, outputs
94 mapAccumLM _ s [] = return (s, [])
95 mapAccumLM f s (x:xs) = do
96 (s1, x') <- f s x
97 (s2, xs') <- mapAccumLM f s1 xs
98 return (s2, x' : xs')
99
100 -- | Monadic version of mapSnd
101 mapSndM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
102 mapSndM _ [] = return []
103 mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }
104
105 -- | Monadic version of concatMap
106 concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
107 concatMapM f xs = liftM concat (mapM f xs)
108
109 -- | Monadic version of mapMaybe
110 mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
111 mapMaybeM f = liftM catMaybes . mapM f
112
113 -- | Monadic version of fmap
114 fmapMaybeM :: (Monad m) => (a -> m b) -> Maybe a -> m (Maybe b)
115 fmapMaybeM _ Nothing = return Nothing
116 fmapMaybeM f (Just x) = f x >>= (return . Just)
117
118 -- | Monadic version of fmap
119 fmapEitherM :: Monad m => (a -> m b) -> (c -> m d) -> Either a c -> m (Either b d)
120 fmapEitherM fl _ (Left a) = fl a >>= (return . Left)
121 fmapEitherM _ fr (Right b) = fr b >>= (return . Right)
122
123 -- | Monadic version of 'any', aborts the computation at the first @True@ value
124 anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
125 anyM _ [] = return False
126 anyM f (x:xs) = do b <- f x
127 if b then return True
128 else anyM f xs
129
130 -- | Monad version of 'all', aborts the computation at the first @False@ value
131 allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
132 allM _ [] = return True
133 allM f (b:bs) = (f b) >>= (\bv -> if bv then allM f bs else return False)
134
135 -- | Monadic version of foldl
136 foldlM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
137 foldlM = foldM
138
139 -- | Monadic version of foldl that discards its result
140 foldlM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
141 foldlM_ = foldM_
142
143 -- | Monadic version of foldr
144 foldrM :: (Monad m) => (b -> a -> m a) -> a -> [b] -> m a
145 foldrM _ z [] = return z
146 foldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }
147
148 -- | Monadic version of fmap specialised for Maybe
149 maybeMapM :: Monad m => (a -> m b) -> (Maybe a -> m (Maybe b))
150 maybeMapM _ Nothing = return Nothing
151 maybeMapM m (Just x) = liftM Just $ m x