{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
module PlutusTx.Traversable (Traversable(..), sequenceA, mapM, sequence, for, fmapDefault, foldMapDefault) where

import Control.Applicative (Const (..))
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity (..))
import PlutusTx.Applicative (Applicative (..), liftA2)
import PlutusTx.Base
import PlutusTx.Either (Either (..))
import PlutusTx.Foldable (Foldable)
import PlutusTx.Functor (Functor, (<$>))
import PlutusTx.Maybe (Maybe (..))
import PlutusTx.Monoid (Monoid)

-- | Plutus Tx version of 'Data.Traversable.Traversable'.
class (Functor t, Foldable t) => Traversable t where
    -- | Plutus Tx version of 'Data.Traversable.traverse'.
    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)

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


instance Traversable [] where
    {-# INLINABLE traverse #-}
    traverse :: (a -> f b) -> [a] -> f [b]
traverse a -> f b
_ []     = [b] -> f [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    traverse a -> f b
f (a
x:[a]
xs) = (b -> [b] -> [b]) -> f b -> f [b] -> f [b]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (a -> f b
f a
x) ((a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
xs)

instance Traversable Maybe where
    {-# INLINABLE traverse #-}
    traverse :: (a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> f b
_ Maybe a
Nothing  = Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
    traverse a -> f b
f (Just a
a) = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> f b -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Traversable (Either c) where
    {-# INLINABLE traverse #-}
    traverse :: (a -> f b) -> Either c a -> f (Either c b)
traverse a -> f b
_ (Left c
a)  = Either c b -> f (Either c b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> Either c b
forall a b. a -> Either a b
Left c
a)
    traverse a -> f b
f (Right a
a) = b -> Either c b
forall a b. b -> Either a b
Right (b -> Either c b) -> f b -> f (Either c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Traversable ((,) c) where
    {-# INLINABLE traverse #-}
    traverse :: (a -> f b) -> (c, a) -> f (c, b)
traverse a -> f b
f (c
c, a
a) = (c
c,) (b -> (c, b)) -> f b -> f (c, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Traversable Identity where
    {-# INLINABLE traverse #-}
    traverse :: (a -> f b) -> Identity a -> f (Identity b)
traverse a -> f b
f (Identity a
a) = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> f b -> f (Identity b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Traversable (Const c) where
    {-# INLINABLE traverse #-}
    traverse :: (a -> f b) -> Const c a -> f (Const c b)
traverse a -> f b
_ (Const c
c) = Const c b -> f (Const c b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> Const c b
forall k a (b :: k). a -> Const a b
Const c
c)

-- | Plutus Tx version of 'Data.Traversable.sequenceA'.
sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)
{-# INLINE sequenceA #-}
sequenceA :: t (f a) -> f (t a)
sequenceA = (f a -> f a) -> t (f a) -> f (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse f a -> f a
forall a. a -> a
id

-- | Plutus Tx version of 'Data.Traversable.sequence'.
sequence :: (Traversable t, Applicative f) => t (f a) -> f (t a)
{-# INLINE sequence #-}
sequence :: t (f a) -> f (t a)
sequence = t (f a) -> f (t a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA

-- | Plutus Tx version of 'Data.Traversable.mapM'.
mapM :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)
{-# INLINE mapM #-}
mapM :: (a -> f b) -> t a -> f (t b)
mapM = (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

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

-- | Plutus Tx version of 'Data.Traversable.fmapDefault'.
fmapDefault :: forall t a b . Traversable t
            => (a -> b) -> t a -> t b
{-# INLINE fmapDefault #-}
fmapDefault :: (a -> b) -> t a -> t b
fmapDefault = ((a -> Identity b) -> t a -> Identity (t b))
-> (a -> b) -> t a -> t b
coerce ((a -> Identity b) -> t a -> Identity (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse :: (a -> Identity b) -> t a -> Identity (t b))

-- | Plutus Tx version of 'Data.Traversable.foldMapDefault'.
foldMapDefault :: forall t m a . (Traversable t, Monoid m)
               => (a -> m) -> t a -> m
{-# INLINE foldMapDefault #-}
foldMapDefault :: (a -> m) -> t a -> m
foldMapDefault = ((a -> Const m ()) -> t a -> Const m (t ()))
-> (a -> m) -> t a -> m
coerce ((a -> Const m ()) -> t a -> Const m (t ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse :: (a -> Const m ()) -> t a -> Const m (t ()))