{-# LANGUAGE CPP, TypeOperators #-}

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

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

import Control.Applicative
import Control.Applicative.Backwards
import Control.Applicative.Lift
import Control.Monad.Trans.Identity
import Data.Bifoldable
import Data.Bifunctor.Biff
import Data.Bifunctor.Clown
import Data.Bifunctor.Flip
import Data.Bifunctor.Join
import Data.Bifunctor.Product as Bifunctor
import Data.Bifunctor.Joker
import Data.Bifunctor.Tannen
import Data.Bifunctor.Wrapped
import Data.Foldable

import Data.Functor.Identity
import Data.Functor.Product as Functor
import Data.Functor.Reverse
import Data.Functor.Sum as Functor
import Data.Functor.Compose
import Data.List.NonEmpty (NonEmpty(..))

#if MIN_VERSION_base(4,4,0)
import Data.Complex
#endif

#ifdef MIN_VERSION_tagged
import Data.Tagged
#endif

import Data.Traversable.Instances ()

#ifdef MIN_VERSION_containers
import Data.Tree
#endif

import qualified Data.Monoid as Monoid
import Data.Semigroup as Semigroup hiding (Product, Sum)
import Data.Orphans ()
-- import Data.Ord -- missing Foldable, https://ghc.haskell.org/trac/ghc/ticket/15098#ticket

#ifdef MIN_VERSION_generic_deriving
import Generics.Deriving.Base
#else
import GHC.Generics
#endif

import Prelude hiding (foldr)

class Foldable t => Foldable1 t where
  fold1 :: Semigroup m => t m -> m
  foldMap1 :: Semigroup m => (a -> m) -> t a -> m
  toNonEmpty :: t a -> NonEmpty a

  foldMap1 a -> m
f = m -> (m -> m) -> Maybe m -> m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m
forall a. HasCallStack => [Char] -> a
error [Char]
"foldMap1") m -> m
forall a. a -> a
id (Maybe m -> m) -> (t a -> Maybe m) -> t a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe m -> Maybe m
forall a. OptionCompat a -> OptionCompat a
getOptionCompat (Maybe m -> Maybe m) -> (t a -> Maybe m) -> t a -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe m) -> t a -> Maybe m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe m -> Maybe m
forall a. OptionCompat a -> OptionCompat a
optionCompat (Maybe m -> Maybe m) -> (a -> Maybe m) -> a -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> Maybe m
forall a. a -> Maybe a
Just (m -> Maybe m) -> (a -> m) -> a -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f)
  fold1 = (m -> m) -> t m -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 m -> m
forall a. a -> a
id
  toNonEmpty = (a -> NonEmpty a) -> t a -> NonEmpty a
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[])

instance Foldable1 Monoid.Sum where
  foldMap1 :: (a -> m) -> Sum a -> m
foldMap1 a -> m
f (Monoid.Sum a
a) = a -> m
f a
a

instance Foldable1 Monoid.Product where
  foldMap1 :: (a -> m) -> Product a -> m
foldMap1 a -> m
f (Monoid.Product a
a) = a -> m
f a
a

instance Foldable1 Monoid.Dual where
  foldMap1 :: (a -> m) -> Dual a -> m
foldMap1 a -> m
f (Monoid.Dual a
a) = a -> m
f a
a

#if MIN_VERSION_base(4,8,0)
instance Foldable1 f => Foldable1 (Monoid.Alt f) where
  foldMap1 :: (a -> m) -> Alt f a -> m
foldMap1 a -> m
g (Monoid.Alt f a
m) = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
g f a
m
#endif

instance Foldable1 Semigroup.First where
  foldMap1 :: (a -> m) -> First a -> m
foldMap1 a -> m
f (Semigroup.First a
a) = a -> m
f a
a

instance Foldable1 Semigroup.Last where
  foldMap1 :: (a -> m) -> Last a -> m
foldMap1 a -> m
f (Semigroup.Last a
a) = a -> m
f a
a

instance Foldable1 Semigroup.Min where
  foldMap1 :: (a -> m) -> Min a -> m
foldMap1 a -> m
f (Semigroup.Min a
a) = a -> m
f a
a

instance Foldable1 Semigroup.Max where
  foldMap1 :: (a -> m) -> Max a -> m
foldMap1 a -> m
f (Semigroup.Max a
a) = a -> m
f a
a

instance Foldable1 f => Foldable1 (Rec1 f) where
  foldMap1 :: (a -> m) -> Rec1 f a -> m
foldMap1 a -> m
f (Rec1 f a
as) = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
as

instance Foldable1 f => Foldable1 (M1 i c f) where
  foldMap1 :: (a -> m) -> M1 i c f a -> m
foldMap1 a -> m
f (M1 f a
as) = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
as

instance Foldable1 Par1 where
  foldMap1 :: (a -> m) -> Par1 a -> m
foldMap1 a -> m
f (Par1 a
a) = a -> m
f a
a

instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where
  foldMap1 :: (a -> m) -> (:*:) f g a -> m
foldMap1 a -> m
f (f a
as :*: g a
bs) = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
as m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f g a
bs

instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where
  foldMap1 :: (a -> m) -> (:+:) f g a -> m
foldMap1 a -> m
f (L1 f a
as) = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
as
  foldMap1 a -> m
f (R1 g a
bs) = (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f g a
bs

instance Foldable1 V1 where
  foldMap1 :: (a -> m) -> V1 a -> m
foldMap1 a -> m
_ V1 a
v = V1 a
v V1 a -> m -> m
`seq` m
forall a. HasCallStack => a
undefined

instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where
  foldMap1 :: (a -> m) -> (:.:) f g a -> m
foldMap1 a -> m
f (Comp1 f (g a)
m) = (g a -> m) -> f (g a) -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 ((a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) f (g a)
m

class Bifoldable t => Bifoldable1 t where
  bifold1 :: Semigroup m => t m m -> m
  bifold1 = (m -> m) -> (m -> m) -> t m m -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 m -> m
forall a. a -> a
id m -> m
forall a. a -> a
id
  {-# INLINE bifold1 #-}

  bifoldMap1 :: Semigroup m => (a -> m) -> (b -> m) -> t a b -> m
  bifoldMap1 a -> m
f b -> m
g = m -> (m -> m) -> Maybe m -> m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m
forall a. HasCallStack => [Char] -> a
error [Char]
"bifoldMap1") m -> m
forall a. a -> a
id
                 (Maybe m -> m) -> (t a b -> Maybe m) -> t a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe m -> Maybe m
forall a. OptionCompat a -> OptionCompat a
getOptionCompat
                 (Maybe m -> Maybe m) -> (t a b -> Maybe m) -> t a b -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe m) -> (b -> Maybe m) -> t a b -> Maybe m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (Maybe m -> Maybe m
forall a. OptionCompat a -> OptionCompat a
optionCompat (Maybe m -> Maybe m) -> (a -> Maybe m) -> a -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> Maybe m
forall a. a -> Maybe a
Just (m -> Maybe m) -> (a -> m) -> a -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) (Maybe m -> Maybe m
forall a. OptionCompat a -> OptionCompat a
optionCompat (Maybe m -> Maybe m) -> (b -> Maybe m) -> b -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> Maybe m
forall a. a -> Maybe a
Just (m -> Maybe m) -> (b -> m) -> b -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m
g)
  {-# INLINE bifoldMap1 #-}

instance Bifoldable1 Arg where
  bifoldMap1 :: (a -> m) -> (b -> m) -> Arg a b -> m
bifoldMap1 a -> m
f b -> m
g (Arg a
a b
b) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
b

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

instance Bifoldable1 (,) where
  bifoldMap1 :: (a -> m) -> (b -> m) -> (a, b) -> m
bifoldMap1 a -> m
f b -> m
g (a
a, b
b) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
b
  {-# INLINE bifoldMap1 #-}

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

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

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

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

#ifdef MIN_VERSION_tagged
instance Bifoldable1 Tagged where
  bifoldMap1 :: (a -> m) -> (b -> m) -> Tagged a b -> m
bifoldMap1 a -> m
_ b -> m
g (Tagged b
b) = b -> m
g b
b
  {-# INLINE bifoldMap1 #-}
#endif

instance (Bifoldable1 p, Foldable1 f, Foldable1 g) => Bifoldable1 (Biff p f g) where
  bifoldMap1 :: (a -> m) -> (b -> m) -> Biff p f g a b -> m
bifoldMap1 a -> m
f b -> m
g = (f a -> m) -> (g b -> m) -> p (f a) (g b) -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 ((a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) ((b -> m) -> g b -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 b -> m
g) (p (f a) (g b) -> m)
-> (Biff p f g a b -> p (f a) (g b)) -> Biff p f g a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Biff p f g a b -> p (f a) (g b)
forall k1 k2 (p :: k1 -> k2 -> *) k3 (f :: k3 -> k1) k4
       (g :: k4 -> k2) (a :: k3) (b :: k4).
Biff p f g a b -> p (f a) (g b)
runBiff
  {-# INLINE bifoldMap1 #-}

instance Foldable1 f => Bifoldable1 (Clown f) where
  bifoldMap1 :: (a -> m) -> (b -> m) -> Clown f a b -> m
bifoldMap1 a -> m
f b -> m
_ = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f (f a -> m) -> (Clown f a b -> f a) -> Clown f a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f a b -> f a
forall k1 (f :: k1 -> *) (a :: k1) k2 (b :: k2). Clown f a b -> f a
runClown
  {-# INLINE bifoldMap1 #-}

instance Bifoldable1 p => Bifoldable1 (Flip p) where
  bifoldMap1 :: (a -> m) -> (b -> m) -> Flip p a b -> m
bifoldMap1 a -> m
f b -> m
g = (b -> m) -> (a -> m) -> p b a -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 b -> m
g a -> m
f (p b a -> m) -> (Flip p a b -> p b a) -> Flip p a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip p a b -> p b a
forall k1 k2 (p :: k2 -> k1 -> *) (a :: k1) (b :: k2).
Flip p a b -> p b a
runFlip
  {-# INLINE bifoldMap1 #-}

instance Bifoldable1 p => Foldable1 (Join p) where
  foldMap1 :: (a -> m) -> Join p a -> m
foldMap1 a -> m
f (Join p a a
a) = (a -> m) -> (a -> m) -> p a a -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 a -> m
f a -> m
f p a a
a
  {-# INLINE foldMap1 #-}

instance Foldable1 g => Bifoldable1 (Joker g) where
  bifoldMap1 :: (a -> m) -> (b -> m) -> Joker g a b -> m
bifoldMap1 a -> m
_ b -> m
g = (b -> m) -> g b -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 b -> m
g (g b -> m) -> (Joker g a b -> g b) -> Joker g a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a b -> g b
forall k1 (g :: k1 -> *) k2 (a :: k2) (b :: k1). Joker g a b -> g b
runJoker
  {-# INLINE bifoldMap1 #-}

instance (Bifoldable1 f, Bifoldable1 g) => Bifoldable1 (Bifunctor.Product f g) where
  bifoldMap1 :: (a -> m) -> (b -> m) -> Product f g a b -> m
bifoldMap1 a -> m
f b -> m
g (Bifunctor.Pair f a b
x g a b
y) = (a -> m) -> (b -> m) -> f a b -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 a -> m
f b -> m
g f a b
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> (b -> m) -> g a b -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 a -> m
f b -> m
g g a b
y
  {-# INLINE bifoldMap1 #-}

instance (Foldable1 f, Bifoldable1 p) => Bifoldable1 (Tannen f p) where
  bifoldMap1 :: (a -> m) -> (b -> m) -> Tannen f p a b -> m
bifoldMap1 a -> m
f b -> m
g = (p a b -> m) -> f (p a b) -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 ((a -> m) -> (b -> m) -> p a b -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 a -> m
f b -> m
g) (f (p a b) -> m)
-> (Tannen f p a b -> f (p a b)) -> Tannen f p a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tannen f p a b -> f (p a b)
forall k1 (f :: k1 -> *) k2 k3 (p :: k2 -> k3 -> k1) (a :: k2)
       (b :: k3).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE bifoldMap1 #-}

instance Bifoldable1 p => Bifoldable1 (WrappedBifunctor p) where
  bifoldMap1 :: (a -> m) -> (b -> m) -> WrappedBifunctor p a b -> m
bifoldMap1 a -> m
f b -> m
g = (a -> m) -> (b -> m) -> p a b -> m
forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 a -> m
f b -> m
g (p a b -> m)
-> (WrappedBifunctor p a b -> p a b) -> WrappedBifunctor p a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedBifunctor p a b -> p a b
forall k1 k2 (p :: k1 -> k2 -> *) (a :: k1) (b :: k2).
WrappedBifunctor p a b -> p a b
unwrapBifunctor
  {-# INLINE bifoldMap1 #-}

#if MIN_VERSION_base(4,4,0)
instance Foldable1 Complex where
  foldMap1 :: (a -> m) -> Complex a -> m
foldMap1 a -> m
f (a
a :+ a
b) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
b
  {-# INLINE foldMap1 #-}
#endif

#ifdef MIN_VERSION_containers
instance Foldable1 Tree where
  foldMap1 :: (a -> m) -> Tree a -> m
foldMap1 a -> m
f (Node a
a []) = a -> m
f a
a
  foldMap1 a -> m
f (Node a
a (Tree a
x:[Tree a]
xs)) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Tree a -> m) -> NonEmpty (Tree a) -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 ((a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) (Tree a
x Tree a -> [Tree a] -> NonEmpty (Tree a)
forall a. a -> [a] -> NonEmpty a
:| [Tree a]
xs)
#endif

instance Foldable1 Identity where
  foldMap1 :: (a -> m) -> Identity a -> m
foldMap1 a -> m
f = a -> m
f (a -> m) -> (Identity a -> a) -> Identity a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity

#ifdef MIN_VERSION_tagged
instance Foldable1 (Tagged a) where
  foldMap1 :: (a -> m) -> Tagged a a -> m
foldMap1 a -> m
f (Tagged a
a) = a -> m
f a
a
#endif

instance Foldable1 m => Foldable1 (IdentityT m) where
  foldMap1 :: (a -> m) -> IdentityT m a -> m
foldMap1 a -> m
f = (a -> m) -> m a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f (m a -> m) -> (IdentityT m a -> m a) -> IdentityT m a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT

instance Foldable1 f => Foldable1 (Backwards f) where
  foldMap1 :: (a -> m) -> Backwards f a -> m
foldMap1 a -> m
f = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f (f a -> m) -> (Backwards f a -> f a) -> Backwards f a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backwards f a -> f a
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards

instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where
  foldMap1 :: (a -> m) -> Compose f g a -> m
foldMap1 a -> m
f = (g a -> m) -> f (g a) -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 ((a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) (f (g a) -> m) -> (Compose f g a -> f (g a)) -> Compose f g a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance Foldable1 f => Foldable1 (Lift f) where
  foldMap1 :: (a -> m) -> Lift f a -> m
foldMap1 a -> m
f (Pure a
x)  = a -> m
f a
x
  foldMap1 a -> m
f (Other f a
y) = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
y

instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Product f g) where
  foldMap1 :: (a -> m) -> Product f g a -> m
foldMap1 a -> m
f (Functor.Pair f a
a g a
b) = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f g a
b

instance Foldable1 f => Foldable1 (Reverse f) where
  foldMap1 :: (a -> m) -> Reverse f a -> m
foldMap1 a -> m
f = Dual m -> m
forall a. Dual a -> a
getDual (Dual m -> m) -> (Reverse f a -> Dual m) -> Reverse f a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Dual m) -> f a -> Dual m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (m -> Dual m
forall a. a -> Dual a
Dual (m -> Dual m) -> (a -> m) -> a -> Dual m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) (f a -> Dual m) -> (Reverse f a -> f a) -> Reverse f a -> Dual m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reverse f a -> f a
forall k (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse

instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where
  foldMap1 :: (a -> m) -> Sum f g a -> m
foldMap1 a -> m
f (Functor.InL f a
x) = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
x
  foldMap1 a -> m
f (Functor.InR g a
y) = (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f g a
y

instance Foldable1 NonEmpty where
  foldMap1 :: (a -> m) -> NonEmpty a -> m
foldMap1 a -> m
f (a
a :| [a]
as) = (a -> (a -> m) -> a -> m) -> (a -> m) -> [a] -> a -> m
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
b a -> m
g a
x -> a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
g a
b) a -> m
f [a]
as a
a
  toNonEmpty :: NonEmpty a -> NonEmpty a
toNonEmpty = NonEmpty a -> NonEmpty a
forall a. a -> a
id

instance Foldable1 ((,) a) where
  foldMap1 :: (a -> m) -> (a, a) -> m
foldMap1 a -> m
f (a
_, a
x) = a -> m
f a
x

instance Foldable1 g => Foldable1 (Joker g a) where
  foldMap1 :: (a -> m) -> Joker g a a -> m
foldMap1 a -> m
g = (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
g (g a -> m) -> (Joker g a a -> g a) -> Joker g a a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a a -> g a
forall k1 (g :: k1 -> *) k2 (a :: k2) (b :: k1). Joker g a b -> g b
runJoker
  {-# INLINE foldMap1 #-}

-- The default implementations of foldMap1 and bifoldMap1 above require the use
-- of a Maybe type with the following Monoid instance:
--
--   instance Semigroup a => Monoid (Maybe a) where ...
--
-- Unfortunately, Maybe has only had such an instance since base-4.11. Prior
-- to that, its Monoid instance had an instance context of Monoid a, which is
-- too strong. To compensate, we use CPP to define an OptionCompat type
-- synonym, which is an alias for Maybe on recent versions of base and an alias
-- for Data.Semigroup.Option on older versions of base. We don't want to use
-- Option on recent versions of base, as it has been removed.
#if MIN_VERSION_base(4,11,0)
type OptionCompat = Maybe

optionCompat :: Maybe a -> OptionCompat a
optionCompat :: Maybe a -> Maybe a
optionCompat = Maybe a -> Maybe a
forall a. a -> a
id

getOptionCompat :: OptionCompat a -> Maybe a
getOptionCompat :: OptionCompat a -> OptionCompat a
getOptionCompat = OptionCompat a -> OptionCompat a
forall a. a -> a
id
#else
type OptionCompat = Option

optionCompat :: Maybe a -> OptionCompat a
optionCompat = Option

getOptionCompat :: OptionCompat a -> Maybe a
getOptionCompat = getOption
#endif