{-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Bifoldable -- Copyright : (C) 2011-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- @since 4.10.0.0 ---------------------------------------------------------------------------- module Data.Bifoldable ( Bifoldable(..) , bifoldr' , bifoldr1 , bifoldrM , bifoldl' , bifoldl1 , bifoldlM , bitraverse_ , bifor_ , bimapM_ , biforM_ , bimsum , bisequenceA_ , bisequence_ , biasum , biList , binull , bilength , bielem , bimaximum , biminimum , bisum , biproduct , biconcat , biconcatMap , biand , bior , biany , biall , bimaximumBy , biminimumBy , binotElem , bifind ) where import Control.Applicative import Data.Functor.Utils (Max(..), Min(..), (#.)) import Data.Maybe (fromMaybe) import Data.Monoid import GHC.Generics (K1(..)) -- | 'Bifoldable' identifies foldable structures with two different varieties -- of elements (as opposed to 'Foldable', which has one variety of element). -- Common examples are 'Either' and '(,)': -- -- > instance Bifoldable Either where -- > bifoldMap f _ (Left a) = f a -- > bifoldMap _ g (Right b) = g b -- > -- > instance Bifoldable (,) where -- > bifoldr f g z (a, b) = f a (g b z) -- -- A minimal 'Bifoldable' definition consists of either 'bifoldMap' or -- 'bifoldr'. When defining more than this minimal set, one should ensure -- that the following identities hold: -- -- @ -- 'bifold' ≡ 'bifoldMap' 'id' 'id' -- 'bifoldMap' f g ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty' -- 'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' (Endo . f) (Endo . g) t) z -- @ -- -- If the type is also a 'Bifunctor' instance, it should satisfy: -- -- > 'bifoldMap' f g ≡ 'bifold' . 'bimap' f g -- -- which implies that -- -- > 'bifoldMap' f g . 'bimap' h i ≡ 'bifoldMap' (f . h) (g . i) -- -- @since 4.10.0.0 class Bifoldable p where {-# MINIMAL bifoldr | bifoldMap #-} -- | Combines the elements of a structure using a monoid. -- -- @'bifold' ≡ 'bifoldMap' 'id' 'id'@ -- -- @since 4.10.0.0 bifold :: Monoid m => p m m -> m bifold = bifoldMap id id -- | Combines the elements of a structure, given ways of mapping them to a -- common monoid. -- -- @'bifoldMap' f g -- ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@ -- -- @since 4.10.0.0 bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty -- | Combines the elements of a structure in a right associative manner. -- Given a hypothetical function @toEitherList :: p a b -> [Either a b]@ -- yielding a list of all elements of a structure in order, the following -- would hold: -- -- @'bifoldr' f g z ≡ 'foldr' ('either' f g) z . toEitherList@ -- -- @since 4.10.0.0 bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c bifoldr f g z t = appEndo (bifoldMap (Endo #. f) (Endo #. g) t) z -- | Combines the elements of a structure in a left associative manner. Given -- a hypothetical function @toEitherList :: p a b -> [Either a b]@ yielding a -- list of all elements of a structure in order, the following would hold: -- -- @'bifoldl' f g z -- ≡ 'foldl' (\acc -> 'either' (f acc) (g acc)) z . toEitherList@ -- -- Note that if you want an efficient left-fold, you probably want to use -- 'bifoldl'' instead of 'bifoldl'. The reason is that the latter does not -- force the "inner" results, resulting in a thunk chain which then must be -- evaluated from the outside-in. -- -- @since 4.10.0.0 bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f) (Dual . Endo . flip g) t)) z -- | @since 4.10.0.0 instance Bifoldable (,) where bifoldMap f g ~(a, b) = f a `mappend` g b -- | @since 4.10.0.0 instance Bifoldable Const where bifoldMap f _ (Const a) = f a -- | @since 4.10.0.0 instance Bifoldable (K1 i) where bifoldMap f _ (K1 c) = f c -- | @since 4.10.0.0 instance Bifoldable ((,,) x) where bifoldMap f g ~(_,a,b) = f a `mappend` g b -- | @since 4.10.0.0 instance Bifoldable ((,,,) x y) where bifoldMap f g ~(_,_,a,b) = f a `mappend` g b -- | @since 4.10.0.0 instance Bifoldable ((,,,,) x y z) where bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b -- | @since 4.10.0.0 instance Bifoldable ((,,,,,) x y z w) where bifoldMap f g ~(_,_,_,_,a,b) = f a `mappend` g b -- | @since 4.10.0.0 instance Bifoldable ((,,,,,,) x y z w v) where bifoldMap f g ~(_,_,_,_,_,a,b) = f a `mappend` g b -- | @since 4.10.0.0 instance Bifoldable Either where bifoldMap f _ (Left a) = f a bifoldMap _ g (Right b) = g b -- | As 'bifoldr', but strict in the result of the reduction functions at each -- step. -- -- @since 4.10.0.0 bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c bifoldr' f g z0 xs = bifoldl f' g' id xs z0 where f' k x z = k $! f x z g' k x z = k $! g x z -- | A variant of 'bifoldr' that has no base case, -- and thus may only be applied to non-empty structures. -- -- @since 4.10.0.0 bifoldr1 :: Bifoldable t => (a -> a -> a) -> t a a -> a bifoldr1 f xs = fromMaybe (error "bifoldr1: empty structure") (bifoldr mbf mbf Nothing xs) where mbf x m = Just (case m of Nothing -> x Just y -> f x y) -- | Right associative monadic bifold over a structure. -- -- @since 4.10.0.0 bifoldrM :: (Bifoldable t, Monad m) => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c bifoldrM f g z0 xs = bifoldl f' g' return xs z0 where f' k x z = f x z >>= k g' k x z = g x z >>= k -- | As 'bifoldl', but strict in the result of the reduction functions at each -- step. -- -- This ensures that each step of the bifold is forced to weak head normal form -- before being applied, avoiding the collection of thunks that would otherwise -- occur. This is often what you want to strictly reduce a finite structure to -- a single, monolithic result (e.g., 'bilength'). -- -- @since 4.10.0.0 bifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a bifoldl' f g z0 xs = bifoldr f' g' id xs z0 where f' x k z = k $! f z x g' x k z = k $! g z x -- | A variant of 'bifoldl' that has no base case, -- and thus may only be applied to non-empty structures. -- -- @since 4.10.0.0 bifoldl1 :: Bifoldable t => (a -> a -> a) -> t a a -> a bifoldl1 f xs = fromMaybe (error "bifoldl1: empty structure") (bifoldl mbf mbf Nothing xs) where mbf m y = Just (case m of Nothing -> y Just x -> f x y) -- | Left associative monadic bifold over a structure. -- -- @since 4.10.0.0 bifoldlM :: (Bifoldable t, Monad m) => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a bifoldlM f g z0 xs = bifoldr f' g' return xs z0 where f' x k z = f z x >>= k g' x k z = g z x >>= k -- | Map each element of a structure using one of two actions, evaluate these -- actions from left to right, and ignore the results. For a version that -- doesn't ignore the results, see 'Data.Bitraversable.bitraverse'. -- -- @since 4.10.0.0 bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f () bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ()) -- | As 'bitraverse_', but with the structure as the primary argument. For a -- version that doesn't ignore the results, see 'Data.Bitraversable.bifor'. -- -- >>> > bifor_ ('a', "bc") print (print . reverse) -- 'a' -- "cb" -- -- @since 4.10.0.0 bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f () bifor_ t f g = bitraverse_ f g t -- | Alias for 'bitraverse_'. -- -- @since 4.10.0.0 bimapM_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f () bimapM_ = bitraverse_ -- | Alias for 'bifor_'. -- -- @since 4.10.0.0 biforM_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f () biforM_ = bifor_ -- | Alias for 'bisequence_'. -- -- @since 4.10.0.0 bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f () bisequenceA_ = bisequence_ -- | Evaluate each action in the structure from left to right, and ignore the -- results. For a version that doesn't ignore the results, see -- 'Data.Bitraversable.bisequence'. -- -- @since 4.10.0.0 bisequence_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f () bisequence_ = bifoldr (*>) (*>) (pure ()) -- | The sum of a collection of actions, generalizing 'biconcat'. -- -- @since 4.10.0.0 biasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a biasum = bifoldr (<|>) (<|>) empty -- | Alias for 'biasum'. -- -- @since 4.10.0.0 bimsum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a bimsum = biasum -- | Collects the list of elements of a structure, from left to right. -- -- @since 4.10.0.0 biList :: Bifoldable t => t a a -> [a] biList = bifoldr (:) (:) [] -- | Test whether the structure is empty. -- -- @since 4.10.0.0 binull :: Bifoldable t => t a b -> Bool binull = bifoldr (\_ _ -> False) (\_ _ -> False) True -- | Returns the size/length of a finite structure as an 'Int'. -- -- @since 4.10.0.0 bilength :: Bifoldable t => t a b -> Int bilength = bifoldl' (\c _ -> c+1) (\c _ -> c+1) 0 -- | Does the element occur in the structure? -- -- @since 4.10.0.0 bielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool bielem x = biany (== x) (== x) -- | Reduces a structure of lists to the concatenation of those lists. -- -- @since 4.10.0.0 biconcat :: Bifoldable t => t [a] [a] -> [a] biconcat = bifold -- | The largest element of a non-empty structure. -- -- @since 4.10.0.0 bimaximum :: forall t a. (Bifoldable t, Ord a) => t a a -> a bimaximum = fromMaybe (error "bimaximum: empty structure") . getMax . bifoldMap mj mj where mj = Max #. (Just :: a -> Maybe a) -- | The least element of a non-empty structure. -- -- @since 4.10.0.0 biminimum :: forall t a. (Bifoldable t, Ord a) => t a a -> a biminimum = fromMaybe (error "biminimum: empty structure") . getMin . bifoldMap mj mj where mj = Min #. (Just :: a -> Maybe a) -- | The 'bisum' function computes the sum of the numbers of a structure. -- -- @since 4.10.0.0 bisum :: (Bifoldable t, Num a) => t a a -> a bisum = getSum #. bifoldMap Sum Sum -- | The 'biproduct' function computes the product of the numbers of a -- structure. -- -- @since 4.10.0.0 biproduct :: (Bifoldable t, Num a) => t a a -> a biproduct = getProduct #. bifoldMap Product Product -- | Given a means of mapping the elements of a structure to lists, computes the -- concatenation of all such lists in order. -- -- @since 4.10.0.0 biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c] biconcatMap = bifoldMap -- | 'biand' returns the conjunction of a container of Bools. For the -- result to be 'True', the container must be finite; 'False', however, -- results from a 'False' value finitely far from the left end. -- -- @since 4.10.0.0 biand :: Bifoldable t => t Bool Bool -> Bool biand = getAll #. bifoldMap All All -- | 'bior' returns the disjunction of a container of Bools. For the -- result to be 'False', the container must be finite; 'True', however, -- results from a 'True' value finitely far from the left end. -- -- @since 4.10.0.0 bior :: Bifoldable t => t Bool Bool -> Bool bior = getAny #. bifoldMap Any Any -- | Determines whether any element of the structure satisfies its appropriate -- predicate argument. -- -- @since 4.10.0.0 biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biany p q = getAny #. bifoldMap (Any . p) (Any . q) -- | Determines whether all elements of the structure satisfy their appropriate -- predicate argument. -- -- @since 4.10.0.0 biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biall p q = getAll #. bifoldMap (All . p) (All . q) -- | The largest element of a non-empty structure with respect to the -- given comparison function. -- -- @since 4.10.0.0 bimaximumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a bimaximumBy cmp = bifoldr1 max' where max' x y = case cmp x y of GT -> x _ -> y -- | The least element of a non-empty structure with respect to the -- given comparison function. -- -- @since 4.10.0.0 biminimumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a biminimumBy cmp = bifoldr1 min' where min' x y = case cmp x y of GT -> y _ -> x -- | 'binotElem' is the negation of 'bielem'. -- -- @since 4.10.0.0 binotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool binotElem x = not . bielem x -- | The 'bifind' function takes a predicate and a structure and returns -- the leftmost element of the structure matching the predicate, or -- 'Nothing' if there is no such element. -- -- @since 4.10.0.0 bifind :: Bifoldable t => (a -> Bool) -> t a a -> Maybe a bifind p = getFirst . bifoldMap finder finder where finder x = First (if p x then Just x else Nothing)