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