{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
module PlutusTx.Foldable (
  Foldable(..),
  -- * Applicative actions
  traverse_,
  for_,
  sequenceA_,
  asum,
  -- * Specialized folds
  concat,
  concatMap,
  -- * Other
  foldMap,
  fold,
  foldl,
  toList,
  length,
  sum,
  product
  ) where

import Control.Applicative (Alternative (..), Const (..))
import Data.Functor.Identity (Identity (..))
import GHC.Exts (build)
import PlutusTx.Applicative (Applicative (pure), (*>))
import PlutusTx.Base
import PlutusTx.Builtins (Integer)
import PlutusTx.Either (Either (..))
import PlutusTx.Maybe (Maybe (..))
import PlutusTx.Monoid (Monoid (..))
import PlutusTx.Numeric
import PlutusTx.Semigroup ((<>))

-- | Plutus Tx version of 'Data.Foldable.Foldable'.
class Foldable t where
    -- | Plutus Tx version of 'Data.Foldable.foldr'.
    foldr :: (a -> b -> b) -> b -> t a -> b

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

instance Foldable [] where
    {-# INLINABLE foldr #-}
    foldr :: forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> b -> b
f b
z = [a] -> b
go
      where
        go :: [a] -> b
go = \case
          []     -> b
z
          a
x : [a]
xs -> a -> b -> b
f a
x ([a] -> b
go [a]
xs)

instance Foldable Maybe where
    {-# INLINABLE foldr #-}
    foldr :: forall a b. (a -> b -> b) -> b -> Maybe a -> b
foldr a -> b -> b
f b
z = \case
      Maybe a
Nothing -> b
z
      Just a
a  -> a -> b -> b
f a
a b
z

instance Foldable (Either c) where
    {-# INLINABLE foldr #-}
    foldr :: forall a b. (a -> b -> b) -> b -> Either c a -> b
foldr a -> b -> b
f b
z = \case
      Left c
_  -> b
z
      Right a
a -> a -> b -> b
f a
a b
z

instance Foldable ((,) c) where
    {-# INLINABLE foldr #-}
    foldr :: forall a b. (a -> b -> b) -> b -> (c, a) -> b
foldr a -> b -> b
f b
z (c
_, a
a) = a -> b -> b
f a
a b
z

instance Foldable Identity where
    {-# INLINABLE foldr #-}
    foldr :: forall a b. (a -> b -> b) -> b -> Identity a -> b
foldr a -> b -> b
f b
z (Identity a
a) = a -> b -> b
f a
a b
z

instance Foldable (Const c) where
    {-# INLINABLE foldr #-}
    foldr :: forall a b. (a -> b -> b) -> b -> Const c a -> b
foldr a -> b -> b
_ b
z Const c a
_ = b
z

-- | Plutus Tx version of 'Data.Foldable.fold'.
fold :: (Foldable t, Monoid m) => t m -> m
fold :: forall (t :: * -> *) m. (Foldable t, Monoid m) => 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
{-# INLINABLE fold #-}

-- | Plutus Tx version of 'Data.Foldable.foldMap'.
foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
foldMap :: forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f = (a -> m -> m) -> m -> t a -> m
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) (m -> m -> m) -> (a -> m) -> a -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) m
forall a. Monoid a => a
mempty

-- | Plutus Tx version of 'Data.Foldable.foldl'.
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
foldl :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z t a
t = (a -> (b -> b) -> b -> b) -> (b -> b) -> t a -> b -> b
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
a b -> b
g b
b -> b -> b
g (b -> a -> b
f b
b a
a)) b -> b
forall a. a -> a
id t a
t b
z
{-# INLINABLE foldl #-}

-- | Plutus Tx version of 'Data.Foldable.toList'.
toList :: Foldable t => t a -> [a]
toList :: forall (t :: * -> *) a. Foldable t => 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 a b. (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)
{-# INLINE toList #-}

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

-- | Plutus Tx version of 'Data.Foldable.sum'.
sum :: (Foldable t, AdditiveMonoid a) => t a -> a
sum :: forall (t :: * -> *) a. (Foldable t, AdditiveMonoid a) => t a -> a
sum = (a -> a -> a) -> a -> t a -> a
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. AdditiveSemigroup a => a -> a -> a
(+) a
forall a. AdditiveMonoid a => a
zero
{-# INLINEABLE sum #-}

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

-- | 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 = (a -> f () -> f ()) -> f () -> t a -> f ()
forall a b. (a -> b -> b) -> b -> t a -> b
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 a. a -> f a
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.for_'.
for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
for_ :: forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
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_
{-# INLINE for_ #-}

-- | 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_ = (f a -> f () -> f ()) -> f () -> t (f a) -> f ()
forall a b. (a -> b -> b) -> b -> t a -> b
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 a. a -> f a
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
asum :: forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum = (f a -> f a -> f a) -> f a -> t (f a) -> f a
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE asum #-}

-- | 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 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 a b. (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 a b. (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 :: forall (t :: * -> *) a b. Foldable t => (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 a b. (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 a b. (a -> b -> b) -> b -> [a] -> 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 #-}