Typos in comments (notes too) [ci skip]
[ghc.git] / libraries / base / Data / Bifoldable.hs
1 {-# LANGUAGE Safe #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module : Data.Bifoldable
7 -- Copyright : (C) 2011-2016 Edward Kmett
8 -- License : BSD-style (see the file LICENSE)
9 --
10 -- Maintainer : libraries@haskell.org
11 -- Stability : provisional
12 -- Portability : portable
13 --
14 -- @since 4.10.0.0
15 ----------------------------------------------------------------------------
16 module Data.Bifoldable
17 ( Bifoldable(..)
18 , bifoldr'
19 , bifoldr1
20 , bifoldrM
21 , bifoldl'
22 , bifoldl1
23 , bifoldlM
24 , bitraverse_
25 , bifor_
26 , bimapM_
27 , biforM_
28 , bimsum
29 , bisequenceA_
30 , bisequence_
31 , biasum
32 , biList
33 , binull
34 , bilength
35 , bielem
36 , bimaximum
37 , biminimum
38 , bisum
39 , biproduct
40 , biconcat
41 , biconcatMap
42 , biand
43 , bior
44 , biany
45 , biall
46 , bimaximumBy
47 , biminimumBy
48 , binotElem
49 , bifind
50 ) where
51
52 import Control.Applicative
53 import Data.Functor.Utils (Max(..), Min(..), (#.))
54 import Data.Maybe (fromMaybe)
55 import Data.Monoid
56 import GHC.Generics (K1(..))
57
58 -- | 'Bifoldable' identifies foldable structures with two different varieties
59 -- of elements (as opposed to 'Foldable', which has one variety of element).
60 -- Common examples are 'Either' and '(,)':
61 --
62 -- > instance Bifoldable Either where
63 -- > bifoldMap f _ (Left a) = f a
64 -- > bifoldMap _ g (Right b) = g b
65 -- >
66 -- > instance Bifoldable (,) where
67 -- > bifoldr f g z (a, b) = f a (g b z)
68 --
69 -- A minimal 'Bifoldable' definition consists of either 'bifoldMap' or
70 -- 'bifoldr'. When defining more than this minimal set, one should ensure
71 -- that the following identities hold:
72 --
73 -- @
74 -- 'bifold' ≡ 'bifoldMap' 'id' 'id'
75 -- 'bifoldMap' f g ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'
76 -- 'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' (Endo . f) (Endo . g) t) z
77 -- @
78 --
79 -- If the type is also a 'Bifunctor' instance, it should satisfy:
80 --
81 -- > 'bifoldMap' f g ≡ 'bifold' . 'bimap' f g
82 --
83 -- which implies that
84 --
85 -- > 'bifoldMap' f g . 'bimap' h i ≡ 'bifoldMap' (f . h) (g . i)
86 --
87 -- @since 4.10.0.0
88 class Bifoldable p where
89 {-# MINIMAL bifoldr | bifoldMap #-}
90
91 -- | Combines the elements of a structure using a monoid.
92 --
93 -- @'bifold' ≡ 'bifoldMap' 'id' 'id'@
94 --
95 -- @since 4.10.0.0
96 bifold :: Monoid m => p m m -> m
97 bifold = bifoldMap id id
98
99 -- | Combines the elements of a structure, given ways of mapping them to a
100 -- common monoid.
101 --
102 -- @'bifoldMap' f g
103 -- ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@
104 --
105 -- @since 4.10.0.0
106 bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m
107 bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty
108
109 -- | Combines the elements of a structure in a right associative manner.
110 -- Given a hypothetical function @toEitherList :: p a b -> [Either a b]@
111 -- yielding a list of all elements of a structure in order, the following
112 -- would hold:
113 --
114 -- @'bifoldr' f g z ≡ 'foldr' ('either' f g) z . toEitherList@
115 --
116 -- @since 4.10.0.0
117 bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
118 bifoldr f g z t = appEndo (bifoldMap (Endo #. f) (Endo #. g) t) z
119
120 -- | Combines the elements of a structure in a left associative manner. Given
121 -- a hypothetical function @toEitherList :: p a b -> [Either a b]@ yielding a
122 -- list of all elements of a structure in order, the following would hold:
123 --
124 -- @'bifoldl' f g z
125 -- ≡ 'foldl' (\acc -> 'either' (f acc) (g acc)) z . toEitherList@
126 --
127 -- Note that if you want an efficient left-fold, you probably want to use
128 -- 'bifoldl'' instead of 'bifoldl'. The reason is that the latter does not
129 -- force the "inner" results, resulting in a thunk chain which then must be
130 -- evaluated from the outside-in.
131 --
132 -- @since 4.10.0.0
133 bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c
134 bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f)
135 (Dual . Endo . flip g) t)) z
136
137 -- | @since 4.10.0.0
138 instance Bifoldable (,) where
139 bifoldMap f g ~(a, b) = f a `mappend` g b
140
141 -- | @since 4.10.0.0
142 instance Bifoldable Const where
143 bifoldMap f _ (Const a) = f a
144
145 -- | @since 4.10.0.0
146 instance Bifoldable (K1 i) where
147 bifoldMap f _ (K1 c) = f c
148
149 -- | @since 4.10.0.0
150 instance Bifoldable ((,,) x) where
151 bifoldMap f g ~(_,a,b) = f a `mappend` g b
152
153 -- | @since 4.10.0.0
154 instance Bifoldable ((,,,) x y) where
155 bifoldMap f g ~(_,_,a,b) = f a `mappend` g b
156
157 -- | @since 4.10.0.0
158 instance Bifoldable ((,,,,) x y z) where
159 bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b
160
161 -- | @since 4.10.0.0
162 instance Bifoldable ((,,,,,) x y z w) where
163 bifoldMap f g ~(_,_,_,_,a,b) = f a `mappend` g b
164
165 -- | @since 4.10.0.0
166 instance Bifoldable ((,,,,,,) x y z w v) where
167 bifoldMap f g ~(_,_,_,_,_,a,b) = f a `mappend` g b
168
169 -- | @since 4.10.0.0
170 instance Bifoldable Either where
171 bifoldMap f _ (Left a) = f a
172 bifoldMap _ g (Right b) = g b
173
174 -- | As 'bifoldr', but strict in the result of the reduction functions at each
175 -- step.
176 --
177 -- @since 4.10.0.0
178 bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c
179 bifoldr' f g z0 xs = bifoldl f' g' id xs z0 where
180 f' k x z = k $! f x z
181 g' k x z = k $! g x z
182
183 -- | A variant of 'bifoldr' that has no base case,
184 -- and thus may only be applied to non-empty structures.
185 --
186 -- @since 4.10.0.0
187 bifoldr1 :: Bifoldable t => (a -> a -> a) -> t a a -> a
188 bifoldr1 f xs = fromMaybe (error "bifoldr1: empty structure")
189 (bifoldr mbf mbf Nothing xs)
190 where
191 mbf x m = Just (case m of
192 Nothing -> x
193 Just y -> f x y)
194
195 -- | Right associative monadic bifold over a structure.
196 --
197 -- @since 4.10.0.0
198 bifoldrM :: (Bifoldable t, Monad m)
199 => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c
200 bifoldrM f g z0 xs = bifoldl f' g' return xs z0 where
201 f' k x z = f x z >>= k
202 g' k x z = g x z >>= k
203
204 -- | As 'bifoldl', but strict in the result of the reduction functions at each
205 -- step.
206 --
207 -- This ensures that each step of the bifold is forced to weak head normal form
208 -- before being applied, avoiding the collection of thunks that would otherwise
209 -- occur. This is often what you want to strictly reduce a finite structure to
210 -- a single, monolithic result (e.g., 'bilength').
211 --
212 -- @since 4.10.0.0
213 bifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a
214 bifoldl' f g z0 xs = bifoldr f' g' id xs z0 where
215 f' x k z = k $! f z x
216 g' x k z = k $! g z x
217
218 -- | A variant of 'bifoldl' that has no base case,
219 -- and thus may only be applied to non-empty structures.
220 --
221 -- @since 4.10.0.0
222 bifoldl1 :: Bifoldable t => (a -> a -> a) -> t a a -> a
223 bifoldl1 f xs = fromMaybe (error "bifoldl1: empty structure")
224 (bifoldl mbf mbf Nothing xs)
225 where
226 mbf m y = Just (case m of
227 Nothing -> y
228 Just x -> f x y)
229
230 -- | Left associative monadic bifold over a structure.
231 --
232 -- @since 4.10.0.0
233 bifoldlM :: (Bifoldable t, Monad m)
234 => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a
235 bifoldlM f g z0 xs = bifoldr f' g' return xs z0 where
236 f' x k z = f z x >>= k
237 g' x k z = g z x >>= k
238
239 -- | Map each element of a structure using one of two actions, evaluate these
240 -- actions from left to right, and ignore the results. For a version that
241 -- doesn't ignore the results, see 'Data.Bitraversable.bitraverse'.
242 --
243 -- @since 4.10.0.0
244 bitraverse_ :: (Bifoldable t, Applicative f)
245 => (a -> f c) -> (b -> f d) -> t a b -> f ()
246 bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())
247
248 -- | As 'bitraverse_', but with the structure as the primary argument. For a
249 -- version that doesn't ignore the results, see 'Data.Bitraversable.bifor'.
250 --
251 -- >>> > bifor_ ('a', "bc") print (print . reverse)
252 -- 'a'
253 -- "cb"
254 --
255 -- @since 4.10.0.0
256 bifor_ :: (Bifoldable t, Applicative f)
257 => t a b -> (a -> f c) -> (b -> f d) -> f ()
258 bifor_ t f g = bitraverse_ f g t
259
260 -- | Alias for 'bitraverse_'.
261 --
262 -- @since 4.10.0.0
263 bimapM_ :: (Bifoldable t, Applicative f)
264 => (a -> f c) -> (b -> f d) -> t a b -> f ()
265 bimapM_ = bitraverse_
266
267 -- | Alias for 'bifor_'.
268 --
269 -- @since 4.10.0.0
270 biforM_ :: (Bifoldable t, Applicative f)
271 => t a b -> (a -> f c) -> (b -> f d) -> f ()
272 biforM_ = bifor_
273
274 -- | Alias for 'bisequence_'.
275 --
276 -- @since 4.10.0.0
277 bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()
278 bisequenceA_ = bisequence_
279
280 -- | Evaluate each action in the structure from left to right, and ignore the
281 -- results. For a version that doesn't ignore the results, see
282 -- 'Data.Bitraversable.bisequence'.
283 --
284 -- @since 4.10.0.0
285 bisequence_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()
286 bisequence_ = bifoldr (*>) (*>) (pure ())
287
288 -- | The sum of a collection of actions, generalizing 'biconcat'.
289 --
290 -- @since 4.10.0.0
291 biasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a
292 biasum = bifoldr (<|>) (<|>) empty
293
294 -- | Alias for 'biasum'.
295 --
296 -- @since 4.10.0.0
297 bimsum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a
298 bimsum = biasum
299
300 -- | Collects the list of elements of a structure, from left to right.
301 --
302 -- @since 4.10.0.0
303 biList :: Bifoldable t => t a a -> [a]
304 biList = bifoldr (:) (:) []
305
306 -- | Test whether the structure is empty.
307 --
308 -- @since 4.10.0.0
309 binull :: Bifoldable t => t a b -> Bool
310 binull = bifoldr (\_ _ -> False) (\_ _ -> False) True
311
312 -- | Returns the size/length of a finite structure as an 'Int'.
313 --
314 -- @since 4.10.0.0
315 bilength :: Bifoldable t => t a b -> Int
316 bilength = bifoldl' (\c _ -> c+1) (\c _ -> c+1) 0
317
318 -- | Does the element occur in the structure?
319 --
320 -- @since 4.10.0.0
321 bielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool
322 bielem x = biany (== x) (== x)
323
324 -- | Reduces a structure of lists to the concatenation of those lists.
325 --
326 -- @since 4.10.0.0
327 biconcat :: Bifoldable t => t [a] [a] -> [a]
328 biconcat = bifold
329
330 -- | The largest element of a non-empty structure.
331 --
332 -- @since 4.10.0.0
333 bimaximum :: forall t a. (Bifoldable t, Ord a) => t a a -> a
334 bimaximum = fromMaybe (error "bimaximum: empty structure") .
335 getMax . bifoldMap mj mj
336 where mj = Max #. (Just :: a -> Maybe a)
337
338 -- | The least element of a non-empty structure.
339 --
340 -- @since 4.10.0.0
341 biminimum :: forall t a. (Bifoldable t, Ord a) => t a a -> a
342 biminimum = fromMaybe (error "biminimum: empty structure") .
343 getMin . bifoldMap mj mj
344 where mj = Min #. (Just :: a -> Maybe a)
345
346 -- | The 'bisum' function computes the sum of the numbers of a structure.
347 --
348 -- @since 4.10.0.0
349 bisum :: (Bifoldable t, Num a) => t a a -> a
350 bisum = getSum #. bifoldMap Sum Sum
351
352 -- | The 'biproduct' function computes the product of the numbers of a
353 -- structure.
354 --
355 -- @since 4.10.0.0
356 biproduct :: (Bifoldable t, Num a) => t a a -> a
357 biproduct = getProduct #. bifoldMap Product Product
358
359 -- | Given a means of mapping the elements of a structure to lists, computes the
360 -- concatenation of all such lists in order.
361 --
362 -- @since 4.10.0.0
363 biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]
364 biconcatMap = bifoldMap
365
366 -- | 'biand' returns the conjunction of a container of Bools. For the
367 -- result to be 'True', the container must be finite; 'False', however,
368 -- results from a 'False' value finitely far from the left end.
369 --
370 -- @since 4.10.0.0
371 biand :: Bifoldable t => t Bool Bool -> Bool
372 biand = getAll #. bifoldMap All All
373
374 -- | 'bior' returns the disjunction of a container of Bools. For the
375 -- result to be 'False', the container must be finite; 'True', however,
376 -- results from a 'True' value finitely far from the left end.
377 --
378 -- @since 4.10.0.0
379 bior :: Bifoldable t => t Bool Bool -> Bool
380 bior = getAny #. bifoldMap Any Any
381
382 -- | Determines whether any element of the structure satisfies its appropriate
383 -- predicate argument.
384 --
385 -- @since 4.10.0.0
386 biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool
387 biany p q = getAny #. bifoldMap (Any . p) (Any . q)
388
389 -- | Determines whether all elements of the structure satisfy their appropriate
390 -- predicate argument.
391 --
392 -- @since 4.10.0.0
393 biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool
394 biall p q = getAll #. bifoldMap (All . p) (All . q)
395
396 -- | The largest element of a non-empty structure with respect to the
397 -- given comparison function.
398 --
399 -- @since 4.10.0.0
400 bimaximumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a
401 bimaximumBy cmp = bifoldr1 max'
402 where max' x y = case cmp x y of
403 GT -> x
404 _ -> y
405
406 -- | The least element of a non-empty structure with respect to the
407 -- given comparison function.
408 --
409 -- @since 4.10.0.0
410 biminimumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a
411 biminimumBy cmp = bifoldr1 min'
412 where min' x y = case cmp x y of
413 GT -> y
414 _ -> x
415
416 -- | 'binotElem' is the negation of 'bielem'.
417 --
418 -- @since 4.10.0.0
419 binotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool
420 binotElem x = not . bielem x
421
422 -- | The 'bifind' function takes a predicate and a structure and returns
423 -- the leftmost element of the structure matching the predicate, or
424 -- 'Nothing' if there is no such element.
425 --
426 -- @since 4.10.0.0
427 bifind :: Bifoldable t => (a -> Bool) -> t a a -> Maybe a
428 bifind p = getFirst . bifoldMap finder finder
429 where finder x = First (if p x then Just x else Nothing)