{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2011-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- Re-exports a subset of the "Data.Bifoldable1" module along with some
-- additional combinators that require 'Bifoldable1' constraints.
--
----------------------------------------------------------------------------
module Data.Semigroup.Bifoldable
  ( -- @Data.Bifoldable1@ re-exports
    Bifoldable1(bifold1, bifoldMap1)

    -- Additional @Bifoldable1@ functionality
  , bitraverse1_
  , bifor1_
  , bisequenceA1_
  , bifoldMapDefault1
  ) where

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

newtype Act f a = Act { forall (f :: * -> *) a. Act f a -> f a
getAct :: f a }

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

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

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

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

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

bisequenceA1_ :: (Bifoldable1 t, Apply f) => t (f a) (f b) -> f ()
bisequenceA1_ :: forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bifoldable1 t, Apply f) =>
t (f a) (f b) -> f ()
bisequenceA1_ t (f a) (f b)
t = Act f () -> f ()
forall (f :: * -> *) a. Act f a -> f a
getAct ((f a -> Act f ()) -> (f b -> Act f ()) -> t (f a) (f b) -> Act f ()
forall m a b. Semigroup m => (a -> m) -> (b -> m) -> t a b -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 (f () -> Act f ()
forall (f :: * -> *) a. f a -> Act f a
Act (f () -> Act f ()) -> (f a -> f ()) -> f a -> Act f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
ignore) (f () -> Act f ()
forall (f :: * -> *) a. f a -> Act f a
Act (f () -> Act f ()) -> (f b -> f ()) -> f b -> Act f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f b -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
ignore) t (f a) (f b)
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 :: forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault1 a -> m
f b -> m
g = WrappedMonoid m -> m
forall m. WrappedMonoid m -> m
unwrapMonoid (WrappedMonoid m -> m) -> (t a b -> WrappedMonoid m) -> t a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> WrappedMonoid m)
-> (b -> WrappedMonoid m) -> t a b -> WrappedMonoid m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> t a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (m -> WrappedMonoid m
forall m. m -> WrappedMonoid m
WrapMonoid (m -> WrappedMonoid m) -> (a -> m) -> a -> WrappedMonoid m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) (m -> WrappedMonoid m
forall m. m -> WrappedMonoid m
WrapMonoid (m -> WrappedMonoid m) -> (b -> m) -> b -> WrappedMonoid m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m
g)
{-# INLINE bifoldMapDefault1 #-}