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