content: {-# 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 (errorWithoutStackTrace "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 (errorWithoutStackTrace "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 (errorWithoutStackTrace "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 (errorWithoutStackTrace "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)
  