1{-# LANGUAGE CPP #-}
2-----------------------------------------------------------------------------
3-- |
4-- Copyright   :  (C) 2011-2015 Edward Kmett
5-- License     :  BSD-style (see the file LICENSE)
6--
7-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
8-- Stability   :  provisional
9-- Portability :  portable
10--
11----------------------------------------------------------------------------
12module Data.Semigroup.Bifoldable
13  ( Bifoldable1(..)
14  , bitraverse1_
15  , bifor1_
16  , bisequenceA1_
17  , bifoldMapDefault1
18  ) where
19
20import Control.Applicative
21import Data.Bifoldable
22import Data.Functor.Apply
23import Data.Semigroup
24import Data.Semigroup.Foldable.Class
25import Prelude hiding (foldr)
26
27newtype Act f a = Act { getAct :: f a }
28
29instance Apply f => Semigroup (Act f a) where
30  Act a <> Act b = Act (a .> b)
31  {-# INLINE (<>) #-}
32
33instance Functor f => Functor (Act f) where
34  fmap f (Act a) = Act (f <$> a)
35  {-# INLINE fmap #-}
36  b <$ Act a = Act (b <$ a)
37  {-# INLINE (<$) #-}
38
39bitraverse1_ :: (Bifoldable1 t, Apply f) => (a -> f b) -> (c -> f d) -> t a c -> f ()
40bitraverse1_ f g t = getAct (bifoldMap1 (Act . ignore . f) (Act . ignore . g) t)
41{-# INLINE bitraverse1_ #-}
42
43bifor1_ :: (Bifoldable1 t, Apply f) => t a c -> (a -> f b) -> (c -> f d) -> f ()
44bifor1_ t f g = bitraverse1_ f g t
45{-# INLINE bifor1_ #-}
46
47ignore :: Functor f => f a -> f ()
48ignore = (() <$)
49{-# INLINE ignore #-}
50
51bisequenceA1_ :: (Bifoldable1 t, Apply f) => t (f a) (f b) -> f ()
52bisequenceA1_ t = getAct (bifoldMap1 (Act . ignore) (Act . ignore) t)
53{-# INLINE bisequenceA1_ #-}
54
55-- | Usable default for foldMap, but only if you define bifoldMap1 yourself
56bifoldMapDefault1 :: (Bifoldable1 t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m
57bifoldMapDefault1 f g = unwrapMonoid . bifoldMap (WrapMonoid . f) (WrapMonoid . g)
58{-# INLINE bifoldMapDefault1 #-}
59