    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Semigroup.Foldable
    -- Copyright   :  (C) 2011 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  portable
    --
    ----------------------------------------------------------------------------
    module Data.Semigroup.Bifoldable
      ( Bifoldable1(..)
      , bitraverse1_
      , bifor1_
      , bisequenceA1_
      , bifoldMapDefault1
      ) where

    import Control.Applicative
    import Data.Bifoldable
    import Data.Functor.Apply
    import Data.Semigroup
    import Data.Tagged
    import Prelude hiding (foldr)

    class Bifoldable t => Bifoldable1 t where
      bifold1 :: Semigroup m => t m m -> m
      bifold1 = bifoldMap1 id id
      {-# INLINE bifold1 #-}

      bifoldMap1 :: Semigroup m => (a -> m) -> (b -> m) -> t a b -> m
      bifoldMap1 f g = maybe (error "bifoldMap1") id . getOption . bifoldMap (Option . Just . f) (Option . Just . g)
      {-# INLINE bifoldMap1 #-}

    instance Bifoldable1 Either where
      bifoldMap1 f _ (Left a) = f a
      bifoldMap1 _ g (Right b) = g b
      {-# INLINE bifoldMap1 #-}

    instance Bifoldable1 (,) where
      bifoldMap1 f g (a, b) = f a <> g b
      {-# INLINE bifoldMap1 #-}

    instance Bifoldable1 ((,,) x) where
      bifoldMap1 f g (_,a,b) = f a <> g b
      {-# INLINE bifoldMap1 #-}

    instance Bifoldable1 ((,,,) x y) where
      bifoldMap1 f g (_,_,a,b) = f a <> g b
      {-# INLINE bifoldMap1 #-}

    instance Bifoldable1 ((,,,,) x y z) where
      bifoldMap1 f g (_,_,_,a,b) = f a <> g b
      {-# INLINE bifoldMap1 #-}

    instance Bifoldable1 Const where
      bifoldMap1 f _ (Const a) = f a
      {-# INLINE bifoldMap1 #-}

    instance Bifoldable1 Tagged where
      bifoldMap1 _ g (Tagged b) = g b
      {-# INLINE bifoldMap1 #-}

    newtype Act f a = Act { getAct :: f a }

    instance Apply f => Semigroup (Act f a) where
      Act a <> Act b = Act (a .> b)
      {-# INLINE (<>) #-}

    instance Functor f => Functor (Act f) where
      fmap f (Act a) = Act (f <$> a)
      {-# INLINE fmap #-}
      b <$ Act a = Act (b <$ a)
      {-# INLINE (<$) #-}

    bitraverse1_ :: (Bifoldable1 t, Apply f) => (a -> f b) -> (c -> f d) -> t a c -> f ()
    bitraverse1_ f g t = getAct (bifoldMap1 (Act . ignore . f) (Act . ignore . g) t)
    {-# INLINE bitraverse1_ #-}

    bifor1_ :: (Bifoldable1 t, Apply f) => t a c -> (a -> f b) -> (c -> f d) -> f ()
    bifor1_ t f g = bitraverse1_ f g t
    {-# INLINE bifor1_ #-}

    ignore :: Functor f => f a -> f ()
    ignore = (() <$)
    {-# INLINE ignore #-}

    bisequenceA1_ :: (Bifoldable1 t, Apply f) => t (f a) (f b) -> f ()
    bisequenceA1_ t = getAct (bifoldMap1 (Act . ignore) (Act . ignore) t)
    {-# INLINE bisequenceA1_ #-}

    -- | Usable default for foldMap, but only if you define bifoldMap1 yourself
    bifoldMapDefault1 :: (Bifoldable1 t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m
    bifoldMapDefault1 f g = unwrapMonoid . bifoldMap (WrapMonoid . f) (WrapMonoid . g)
    {-# INLINE bifoldMapDefault1 #-}