{-# 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 :: (a -> m) -> [a] -> m
foldMap a -> m
_ []     = m
forall a. Monoid a => a
mempty
    foldMap a -> m
f (a
x:[a]
xs) = a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> [a] -> m
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 :: (a -> m) -> Maybe a -> m
foldMap a -> m
_ Maybe a
Nothing  = m
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 :: (a -> m) -> Either c a -> m
foldMap a -> m
_ (Left c
_)  = m
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 :: (a -> m) -> (c, a) -> m
foldMap a -> m
f (c
_, a
a) = a -> m
f a
a

instance Foldable Identity where
    {-# INLINABLE foldMap #-}
    foldMap :: (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 :: (a -> m) -> Const c a -> m
foldMap a -> m
_ Const c a
_ = m
forall a. Monoid a => a
mempty

-- | Plutus Tx version of 'Data.Foldable.fold'.
{-# INLINABLE fold #-}
fold :: (Foldable t, Monoid m) => t m -> m
fold :: t m -> m
fold = (m -> m) -> t m -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap m -> m
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 :: (a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z t a
t = Endo b -> b -> b
coerce ((a -> Endo b) -> t a -> Endo b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo ((b -> b) -> Endo b) -> (a -> b -> b) -> a -> Endo b
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 :: (b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z t a
t = Dual (Endo b) -> b -> b
coerce ((a -> Dual (Endo b)) -> t a -> Dual (Endo b)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Endo b -> Dual (Endo b)
forall a. a -> Dual a
Dual (Endo b -> Dual (Endo b)) -> (a -> Endo b) -> a -> Dual (Endo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo ((b -> b) -> Endo b) -> (a -> b -> b) -> a -> Endo b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a -> b) -> a -> b -> b
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 :: t a -> [a]
toList t a
t = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ a -> b -> b
c b
n -> (a -> b -> b) -> b -> t a -> b
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 :: t a -> Bool
null = (a -> Bool -> Bool) -> Bool -> t a -> Bool
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 :: t a -> Integer
length = (Integer -> a -> Integer) -> Integer -> t a -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
c a
_ -> Integer
c Integer -> Integer -> Integer
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 :: a -> t a -> Bool
elem = (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((a -> Bool) -> t a -> Bool)
-> (a -> a -> Bool) -> a -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
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 :: t a -> a
sum = Sum a -> a
forall a. Sum a -> a
getSum (Sum a -> a) -> (t a -> Sum a) -> t a -> a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Sum a) -> t a -> Sum a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Sum a
forall a. a -> Sum a
Sum

-- | Plutus Tx version of 'Data.Foldable.product'.
{-# INLINABLE product #-}
product :: (Foldable t, MultiplicativeMonoid a) => t a -> a
product :: t a -> a
product = Product a -> a
forall a. Product a -> a
getProduct (Product a -> a) -> (t a -> Product a) -> t a -> a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Product a) -> t a -> Product a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Product a
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 :: (a -> b -> m b) -> b -> t a -> m b
foldrM a -> b -> m b
f b
z0 t a
xs = ((b -> m b) -> a -> b -> m b) -> (b -> m b) -> t a -> b -> m b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (b -> m b) -> a -> b -> m b
forall b. (b -> m b) -> a -> b -> m b
c b -> m b
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 m b -> (b -> m b) -> m b
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 :: (b -> a -> m b) -> b -> t a -> m b
foldlM b -> a -> m b
f b
z0 t a
xs = (a -> (b -> m b) -> b -> m b) -> (b -> m b) -> t a -> b -> m b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (b -> m b) -> b -> m b
forall b. a -> (b -> m b) -> b -> m b
c b -> m b
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 m b -> (b -> m b) -> m b
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_ :: (a -> f b) -> t a -> f ()
traverse_ a -> f b
f = (a -> f () -> f ()) -> f () -> t a -> f ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> f () -> f ()
forall b. a -> f b -> f b
c (() -> f ()
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 f b -> f b -> f b
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_ :: t (m a) -> m ()
sequence_ = (m a -> m () -> m ()) -> m () -> t (m a) -> m ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
c (() -> m ()
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 m a -> m b -> m b
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_ :: t a -> (a -> f b) -> f ()
for_ = ((a -> f b) -> t a -> f ()) -> t a -> (a -> f b) -> f ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> f b) -> t a -> f ()
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_ :: t (f a) -> f ()
sequenceA_ = (f a -> f () -> f ()) -> f () -> t (f a) -> f ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f a -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
c (() -> f ()
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 f a -> f b -> f b
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 :: t (f a) -> f a
asum = (f a -> f a -> f a) -> f a -> t (f a) -> f a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> 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 :: t [a] -> [a]
concat t [a]
xs = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
c b
n -> ([a] -> b -> b) -> b -> t [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[a]
x b
y -> (a -> b -> b) -> b -> [a] -> b
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 :: (a -> [b]) -> t a -> [b]
concatMap a -> [b]
f t a
xs = (forall b. (b -> b -> b) -> b -> b) -> [b]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\b -> b -> b
c b
n -> (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x b
b -> (b -> b -> b) -> b -> [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 :: t Bool -> Bool
and = t Bool -> Bool
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 :: t Bool -> Bool
or = t Bool -> Bool
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 :: (a -> Bool) -> t a -> Bool
any a -> Bool
p = Sum Bool -> Bool
forall a. Sum a -> a
getSum (Sum Bool -> Bool) -> (t a -> Sum Bool) -> t a -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Sum Bool) -> t a -> Sum Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> Sum Bool
forall a. a -> Sum a
Sum (Bool -> Sum Bool) -> (a -> Bool) -> a -> Sum Bool
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 :: (a -> Bool) -> t a -> Bool
all a -> Bool
p = Product Bool -> Bool
forall a. Product a -> a
getProduct (Product Bool -> Bool) -> (t a -> Product Bool) -> t a -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Product Bool) -> t a -> Product Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> Product Bool
forall a. a -> Product a
Product (Bool -> Product Bool) -> (a -> Bool) -> a -> Product Bool
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 :: a -> t a -> Bool
notElem a
x = Bool -> Bool
not (Bool -> Bool) -> (t a -> Bool) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> t a -> Bool
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 :: (a -> Bool) -> t a -> Maybe a
find a -> Bool
p = First a -> Maybe a
coerce (First a -> Maybe a) -> (t a -> First a) -> t a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> First a) -> t a -> First a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ a
x -> Maybe a -> First a
forall a. Maybe a -> First a
First (if a -> Bool
p a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing))

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

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