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