Update Trac ticket URLs to point to GitLab
[ghc.git] / compiler / utils / MonadUtils.hs
1 -- | Utilities related to Monad and Applicative classes
2 -- Mostly for backwards compatibility.
3
4 module MonadUtils
5 ( Applicative(..)
6 , (<$>)
7
8 , MonadFix(..)
9 , MonadIO(..)
10
11 , liftIO1, liftIO2, liftIO3, liftIO4
12
13 , zipWith3M, zipWith3M_, zipWith4M, zipWithAndUnzipM
14 , mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M, mapAndUnzip5M
15 , mapAccumLM
16 , mapSndM
17 , concatMapM
18 , mapMaybeM
19 , fmapMaybeM, fmapEitherM
20 , anyM, allM, orM
21 , foldlM, foldlM_, foldrM
22 , maybeMapM
23 , whenM, unlessM
24 , filterOutM
25 ) where
26
27 -------------------------------------------------------------------------------
28 -- Imports
29 -------------------------------------------------------------------------------
30
31 import GhcPrelude
32
33 import Control.Applicative
34 import Control.Monad
35 import Control.Monad.Fix
36 import Control.Monad.IO.Class
37 import Data.Foldable (sequenceA_)
38 import Data.List (unzip4, unzip5, zipWith4)
39
40 -------------------------------------------------------------------------------
41 -- Lift combinators
42 -- These are used throughout the compiler
43 -------------------------------------------------------------------------------
44
45 -- | Lift an 'IO' operation with 1 argument into another monad
46 liftIO1 :: MonadIO m => (a -> IO b) -> a -> m b
47 liftIO1 = (.) liftIO
48
49 -- | Lift an 'IO' operation with 2 arguments into another monad
50 liftIO2 :: MonadIO m => (a -> b -> IO c) -> a -> b -> m c
51 liftIO2 = ((.).(.)) liftIO
52
53 -- | Lift an 'IO' operation with 3 arguments into another monad
54 liftIO3 :: MonadIO m => (a -> b -> c -> IO d) -> a -> b -> c -> m d
55 liftIO3 = ((.).((.).(.))) liftIO
56
57 -- | Lift an 'IO' operation with 4 arguments into another monad
58 liftIO4 :: MonadIO m => (a -> b -> c -> d -> IO e) -> a -> b -> c -> d -> m e
59 liftIO4 = (((.).(.)).((.).(.))) liftIO
60
61 -------------------------------------------------------------------------------
62 -- Common functions
63 -- These are used throughout the compiler
64 -------------------------------------------------------------------------------
65
66 {-
67
68 Note [Inline @zipWithNM@ functions]
69 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
70
71 The inline principle for 'zipWith3M', 'zipWith4M' and 'zipWith3M_' is the same
72 as for 'zipWithM' and 'zipWithM_' in "Control.Monad", see
73 Note [Fusion for zipN/zipWithN] in GHC/List.hs for more details.
74
75 The 'zipWithM'/'zipWithM_' functions are inlined so that the `zipWith` and
76 `sequenceA` functions with which they are defined have an opportunity to fuse.
77
78 Furthermore, 'zipWith3M'/'zipWith4M' and 'zipWith3M_' have been explicitly
79 rewritten in a non-recursive way similarly to 'zipWithM'/'zipWithM_', and for
80 more than just uniformity: after [D5241](https://phabricator.haskell.org/D5241)
81 for issue #14037, all @zipN@/@zipWithN@ functions fuse, meaning
82 'zipWith3M'/'zipWIth4M' and 'zipWith3M_'@ now behave like 'zipWithM' and
83 'zipWithM_', respectively, with regards to fusion.
84
85 As such, since there are not any differences between 2-ary 'zipWithM'/
86 'zipWithM_' and their n-ary counterparts below aside from the number of
87 arguments, the `INLINE` pragma should be replicated in the @zipWithNM@
88 functions below as well.
89
90 -}
91
92 zipWith3M :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]
93 {-# INLINE zipWith3M #-}
94 -- Inline so that fusion with 'zipWith3' and 'sequenceA' has a chance to fire.
95 -- See Note [Inline @zipWithNM@ functions] above.
96 zipWith3M f xs ys zs = sequenceA (zipWith3 f xs ys zs)
97
98 zipWith3M_ :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m ()
99 {-# INLINE zipWith3M_ #-}
100 -- Inline so that fusion with 'zipWith4' and 'sequenceA' has a chance to fire.
101 -- See Note [Inline @zipWithNM@ functions] above.
102 zipWith3M_ f xs ys zs = sequenceA_ (zipWith3 f xs ys zs)
103
104 zipWith4M :: Monad m => (a -> b -> c -> d -> m e)
105 -> [a] -> [b] -> [c] -> [d] -> m [e]
106 {-# INLINE zipWith4M #-}
107 -- Inline so that fusion with 'zipWith5' and 'sequenceA' has a chance to fire.
108 -- See Note [Inline @zipWithNM@ functions] above.
109 zipWith4M f xs ys ws zs = sequenceA (zipWith4 f xs ys ws zs)
110
111 zipWithAndUnzipM :: Monad m
112 => (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
113 {-# INLINABLE zipWithAndUnzipM #-}
114 -- See Note [flatten_many performance] in TcFlatten for why this
115 -- pragma is essential.
116 zipWithAndUnzipM f (x:xs) (y:ys)
117 = do { (c, d) <- f x y
118 ; (cs, ds) <- zipWithAndUnzipM f xs ys
119 ; return (c:cs, d:ds) }
120 zipWithAndUnzipM _ _ _ = return ([], [])
121
122 {-
123
124 Note [Inline @mapAndUnzipNM@ functions]
125 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
126
127 The inline principle is the same as 'mapAndUnzipM' in "Control.Monad".
128 The 'mapAndUnzipM' function is inlined so that the `unzip` and `traverse`
129 functions with which it is defined have an opportunity to fuse, see
130 Note [Inline @unzipN@ functions] in Data/OldList.hs for more details.
131
132 Furthermore, the @mapAndUnzipNM@ functions have been explicitly rewritten in a
133 non-recursive way similarly to 'mapAndUnzipM', and for more than just
134 uniformity: after [D5249](https://phabricator.haskell.org/D5249) for Trac
135 ticket #14037, all @unzipN@ functions fuse, meaning 'mapAndUnzip3M',
136 'mapAndUnzip4M' and 'mapAndUnzip5M' now behave like 'mapAndUnzipM' with regards
137 to fusion.
138
139 As such, since there are not any differences between 2-ary 'mapAndUnzipM' and
140 its n-ary counterparts below aside from the number of arguments, the `INLINE`
141 pragma should be replicated in the @mapAndUnzipNM@ functions below as well.
142
143 -}
144
145 -- | mapAndUnzipM for triples
146 mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])
147 {-# INLINE mapAndUnzip3M #-}
148 -- Inline so that fusion with 'unzip3' and 'traverse' has a chance to fire.
149 -- See Note [Inline @mapAndUnzipNM@ functions] above.
150 mapAndUnzip3M f xs = unzip3 <$> traverse f xs
151
152 mapAndUnzip4M :: Monad m => (a -> m (b,c,d,e)) -> [a] -> m ([b],[c],[d],[e])
153 {-# INLINE mapAndUnzip4M #-}
154 -- Inline so that fusion with 'unzip4' and 'traverse' has a chance to fire.
155 -- See Note [Inline @mapAndUnzipNM@ functions] above.
156 mapAndUnzip4M f xs = unzip4 <$> traverse f xs
157
158 mapAndUnzip5M :: Monad m => (a -> m (b,c,d,e,f)) -> [a] -> m ([b],[c],[d],[e],[f])
159 {-# INLINE mapAndUnzip5M #-}
160 -- Inline so that fusion with 'unzip5' and 'traverse' has a chance to fire.
161 -- See Note [Inline @mapAndUnzipNM@ functions] above.
162 mapAndUnzip5M f xs = unzip5 <$> traverse f xs
163
164 -- | Monadic version of mapAccumL
165 mapAccumLM :: Monad m
166 => (acc -> x -> m (acc, y)) -- ^ combining function
167 -> acc -- ^ initial state
168 -> [x] -- ^ inputs
169 -> m (acc, [y]) -- ^ final state, outputs
170 mapAccumLM _ s [] = return (s, [])
171 mapAccumLM f s (x:xs) = do
172 (s1, x') <- f s x
173 (s2, xs') <- mapAccumLM f s1 xs
174 return (s2, x' : xs')
175
176 -- | Monadic version of mapSnd
177 mapSndM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
178 mapSndM _ [] = return []
179 mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }
180
181 -- | Monadic version of concatMap
182 concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
183 concatMapM f xs = liftM concat (mapM f xs)
184
185 -- | Applicative version of mapMaybe
186 mapMaybeM :: Applicative m => (a -> m (Maybe b)) -> [a] -> m [b]
187 mapMaybeM f = foldr g (pure [])
188 where g a = liftA2 (maybe id (:)) (f a)
189
190 -- | Monadic version of fmap
191 fmapMaybeM :: (Monad m) => (a -> m b) -> Maybe a -> m (Maybe b)
192 fmapMaybeM _ Nothing = return Nothing
193 fmapMaybeM f (Just x) = f x >>= (return . Just)
194
195 -- | Monadic version of fmap
196 fmapEitherM :: Monad m => (a -> m b) -> (c -> m d) -> Either a c -> m (Either b d)
197 fmapEitherM fl _ (Left a) = fl a >>= (return . Left)
198 fmapEitherM _ fr (Right b) = fr b >>= (return . Right)
199
200 -- | Monadic version of 'any', aborts the computation at the first @True@ value
201 anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
202 anyM _ [] = return False
203 anyM f (x:xs) = do b <- f x
204 if b then return True
205 else anyM f xs
206
207 -- | Monad version of 'all', aborts the computation at the first @False@ value
208 allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
209 allM _ [] = return True
210 allM f (b:bs) = (f b) >>= (\bv -> if bv then allM f bs else return False)
211
212 -- | Monadic version of or
213 orM :: Monad m => m Bool -> m Bool -> m Bool
214 orM m1 m2 = m1 >>= \x -> if x then return True else m2
215
216 -- | Monadic version of foldl
217 foldlM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
218 foldlM = foldM
219
220 -- | Monadic version of foldl that discards its result
221 foldlM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
222 foldlM_ = foldM_
223
224 -- | Monadic version of foldr
225 foldrM :: (Monad m) => (b -> a -> m a) -> a -> [b] -> m a
226 foldrM _ z [] = return z
227 foldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }
228
229 -- | Monadic version of fmap specialised for Maybe
230 maybeMapM :: Monad m => (a -> m b) -> (Maybe a -> m (Maybe b))
231 maybeMapM _ Nothing = return Nothing
232 maybeMapM m (Just x) = liftM Just $ m x
233
234 -- | Monadic version of @when@, taking the condition in the monad
235 whenM :: Monad m => m Bool -> m () -> m ()
236 whenM mb thing = do { b <- mb
237 ; when b thing }
238
239 -- | Monadic version of @unless@, taking the condition in the monad
240 unlessM :: Monad m => m Bool -> m () -> m ()
241 unlessM condM acc = do { cond <- condM
242 ; unless cond acc }
243
244 -- | Like 'filterM', only it reverses the sense of the test.
245 filterOutM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]
246 filterOutM p =
247 foldr (\ x -> liftA2 (\ flg -> if flg then id else (x:)) (p x)) (pure [])