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