{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
module PlutusTx.Foldable (
  Foldable(..),
  -- * Special biased folds
  foldrM,
  foldlM,
  -- * Folding actions
  -- ** Applicative actions
  traverse_,
  for_,
  sequenceA_,
  sequence_,
  asum,
  -- ** Monadic actions
  mapM_,
  -- * Specialized folds
  concat,
  concatMap,
  and,
  or,
  any,
  all,
  -- * Searches
  notElem,
  find,
  -- * Other
  fold,
  foldr,
  foldl,
  toList,
  null,
  length,
  elem,
  sum,
  product
  ) where

import Control.Applicative (Alternative (..), Const (..))
import Data.Coerce (Coercible, coerce)
import Data.Functor.Identity (Identity (..))
import Data.Monoid (First (..))
import Data.Semigroup (Dual (..), Endo (..), Product (..), Sum (..))
import GHC.Exts (build)
import PlutusTx.Applicative (Applicative (pure), (*>))
import PlutusTx.Base
import PlutusTx.Bool (Bool (..), not)
import PlutusTx.Builtins (Integer)
import PlutusTx.Either (Either (..))
import PlutusTx.Eq (Eq (..))
import PlutusTx.Maybe (Maybe (..))
import PlutusTx.Monoid (Monoid (..))
import PlutusTx.Numeric (AdditiveMonoid, AdditiveSemigroup ((+)), MultiplicativeMonoid)
import PlutusTx.Semigroup ((<>))

import Prelude qualified as Haskell (Monad, return, (>>), (>>=))

-- | Plutus Tx version of 'Data.Foldable.Foldable'.
class Foldable t where
    -- | Plutus Tx version of 'Data.Foldable.foldMap'.
    foldMap :: Monoid m => (a -> m) -> t a -> m

    -- All the other methods are deliberately omitted,
    -- to make this a one-method class which has a simpler representation

instance Foldable [] where
    {-# INLINABLE foldMap #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> [a] -> m
foldMap a -> m
_ []     = forall a. Monoid a => a
mempty
    foldMap a -> m
f (a
x:[a]
xs) = a -> m
f a
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
xs

instance Foldable Maybe where
    {-# INLINABLE foldMap #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> Maybe a -> m
foldMap a -> m
_ Maybe a
Nothing  = forall a. Monoid a => a
mempty
    foldMap a -> m
f (Just a
a) = a -> m
f a
a

instance Foldable (Either c) where
    {-# INLINABLE foldMap #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> Either c a -> m
foldMap a -> m
_ (Left c
_)  = forall a. Monoid a => a
mempty
    foldMap a -> m
f (Right a
a) = a -> m
f a
a

instance Foldable ((,) c) where
    {-# INLINABLE foldMap #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> (c, a) -> m
foldMap a -> m
f (c
_, a
a) = a -> m
f a
a

instance Foldable Identity where
    {-# INLINABLE foldMap #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> Identity a -> m
foldMap a -> m
f (Identity a
a) = a -> m
f a
a

instance Foldable (Const c) where
    {-# INLINABLE foldMap #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> Const c a -> m
foldMap a -> m
_ Const c a
_ = forall a. Monoid a => a
mempty

-- | Plutus Tx version of 'Data.Foldable.fold'.
{-# INLINABLE fold #-}
fold :: (Foldable t, Monoid m) => t m -> m
fold :: forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. a -> a
id

-- | Plutus Tx version of 'Data.Foldable.foldr'.
{-# INLINABLE foldr #-}
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
-- See Note [newtype field accessors in `base`]
foldr :: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z t a
t = coerce :: forall a b. Coercible a b => a -> b
coerce (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. (a -> a) -> Endo a
Endo forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b -> b
f) t a
t) b
z

-- | Plutus Tx version of 'Data.Foldable.foldl'.
{-# INLINABLE foldl #-}
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
-- See Note [newtype field accessors in `base`]
foldl :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z t a
t = coerce :: forall a b. Coercible a b => a -> b
coerce (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f) t a
t) b
z

-- | Plutus Tx version of 'Data.Foldable.toList'.
toList :: Foldable t => t a -> [a]
{-# INLINE toList #-}
toList :: forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
t = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ a -> b -> b
c b
n -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
c b
n t a
t)

-- | Plutus Tx version of 'Data.Foldable.null'.
{-# INLINABLE null #-}
null :: Foldable t => t a -> Bool
null :: forall (t :: * -> *) a. Foldable t => t a -> Bool
null = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
_ Bool
_ -> Bool
False) Bool
True

-- | Plutus Tx version of 'Data.Foldable.length'.
{-# INLINABLE length #-}
length :: Foldable t => t a -> Integer
length :: forall (t :: * -> *) a. Foldable t => t a -> Integer
length = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
c a
_ -> Integer
c forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
1) Integer
0

-- | Plutus Tx version of 'Data.Foldable.elem'.
{-# INLINABLE elem #-}
elem :: (Foldable t, Eq a) => a -> t a -> Bool
elem :: forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)

-- | Plutus Tx version of 'Data.Foldable.sum'.
{-# INLINEABLE sum #-}
sum :: (Foldable t, AdditiveMonoid a) => t a -> a
sum :: forall (t :: * -> *) a. (Foldable t, AdditiveMonoid a) => t a -> a
sum = forall a. Sum a -> a
getSum forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. a -> Sum a
Sum

-- | Plutus Tx version of 'Data.Foldable.product'.
{-# INLINABLE product #-}
product :: (Foldable t, MultiplicativeMonoid a) => t a -> a
product :: forall (t :: * -> *) a.
(Foldable t, MultiplicativeMonoid a) =>
t a -> a
product = forall a. Product a -> a
getProduct forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. a -> Product a
Product

-- | Plutus Tx version of 'Data.Foldable.foldrM'.
foldrM :: (Foldable t, Haskell.Monad m) => (a -> b -> m b) -> b -> t a -> m b
foldrM :: forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM a -> b -> m b
f b
z0 t a
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {b}. (b -> m b) -> a -> b -> m b
c forall (m :: * -> *) a. Monad m => a -> m a
Haskell.return t a
xs b
z0
  where c :: (b -> m b) -> a -> b -> m b
c b -> m b
k a
x b
z = a -> b -> m b
f a
x b
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Haskell.>>= b -> m b
k
        {-# INLINE c #-}

-- | Plutus Tx version of 'Data.Foldable.foldlM'.
foldlM :: (Foldable t, Haskell.Monad m) => (b -> a -> m b) -> b -> t a -> m b
foldlM :: forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM b -> a -> m b
f b
z0 t a
xs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}. a -> (b -> m b) -> b -> m b
c forall (m :: * -> *) a. Monad m => a -> m a
Haskell.return t a
xs b
z0
  where c :: a -> (b -> m b) -> b -> m b
c a
x b -> m b
k b
z = b -> a -> m b
f b
z a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Haskell.>>= b -> m b
k
        {-# INLINE c #-}

-- | Plutus Tx version of 'Data.Foldable.traverse_'.
traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()
traverse_ :: forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ a -> f b
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}. a -> f b -> f b
c (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  where c :: a -> f b -> f b
c a
x f b
k = a -> f b
f a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b
k
        {-# INLINE c #-}

-- | Plutus Tx version of 'Data.Foldable.sequence_'.
sequence_ :: (Foldable t, Haskell.Monad m) => t (m a) -> m ()
sequence_ :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
c (forall (m :: * -> *) a. Monad m => a -> m a
Haskell.return ())
  where c :: m a -> m b -> m b
c m a
m m b
k = m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Haskell.>> m b
k
        {-# INLINE c #-}

-- | Plutus Tx version of 'Data.Foldable.for_'.
for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
{-# INLINE for_ #-}
for_ :: forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_

-- | Plutus Tx version of 'Data.Foldable.sequenceA_'.
sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()
sequenceA_ :: forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
c (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  where c :: f a -> f b -> f b
c f a
m f b
k = f a
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b
k
        {-# INLINE c #-}

-- | Plutus Tx version of 'Data.Foldable.asum'.
asum :: (Foldable t, Alternative f) => t (f a) -> f a
{-# INLINE asum #-}
asum :: forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a. Alternative f => f a
empty

-- | Plutus Tx version of 'Data.Foldable.concat'.
concat :: Foldable t => t [a] -> [a]
concat :: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [a]
xs = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
c b
n -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[a]
x b
y -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
c b
y [a]
x) b
n t [a]
xs)
{-# INLINE concat #-}

-- | Plutus Tx version of 'Data.Foldable.concatMap'.
concatMap :: Foldable t => (a -> [b]) -> t a -> [b]
concatMap :: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [b]
f t a
xs = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\b -> b -> b
c b
n -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x b
b -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> b -> b
c b
b (a -> [b]
f a
x)) b
n t a
xs)
{-# INLINE concatMap #-}

-- | Plutus Tx version of 'Data.Foldable.and'.
{-# INLINABLE and #-}
and :: Foldable t => t Bool -> Bool
and :: forall (t :: * -> *). Foldable t => t Bool -> Bool
and = forall (t :: * -> *) a.
(Foldable t, MultiplicativeMonoid a) =>
t a -> a
product

-- | Plutus Tx version of 'Data.Foldable.or'.
{-# INLINABLE or #-}
or :: Foldable t => t Bool -> Bool
or :: forall (t :: * -> *). Foldable t => t Bool -> Bool
or = forall (t :: * -> *) a. (Foldable t, AdditiveMonoid a) => t a -> a
sum

-- | Plutus Tx version of 'Data.Foldable.any'.
{-# INLINABLE any #-}
any :: Foldable t => (a -> Bool) -> t a -> Bool
any :: forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
p = forall a. Sum a -> a
getSum forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> Sum a
Sum forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> Bool
p)

-- | Plutus Tx version of 'Data.Foldable.all'.
{-# INLINABLE all #-}
all :: Foldable t => (a -> Bool) -> t a -> Bool
all :: forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
p = forall a. Product a -> a
getProduct forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> Product a
Product forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> Bool
p)

-- | Plutus Tx version of 'Data.Foldable.notElem'.
{-# INLINABLE notElem #-}
notElem :: (Foldable t, Eq a) => a -> t a -> Bool
notElem :: forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem a
x = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x

-- | Plutus Tx version of 'Data.Foldable.find'.
{-# INLINABLE find #-}
find :: Foldable t => (a -> Bool) -> t a -> Maybe a
-- See Note [newtype field accessors in `base`]
find :: forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find a -> Bool
p = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ a
x -> forall a. Maybe a -> First a
First (if a -> Bool
p a
x then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing))

(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
#. :: forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_f = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE (#.) #-}

-- | Plutus Tx version of 'Data.Foldable.mapM_'.
{-# INLINABLE mapM_ #-}
mapM_ :: (Foldable t, Haskell.Monad m) => (a -> m b) -> t a -> m ()
mapM_ :: forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m b
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}. a -> m b -> m b
c (forall (m :: * -> *) a. Monad m => a -> m a
Haskell.return ())
  where c :: a -> m b -> m b
c a
x m b
k = a -> m b
f a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Haskell.>> m b
k
        {-# INLINE c #-}