-- editorconfig-checker-disable-file
{-# 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> f b
_ []     = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    traverse a -> f b
f (a
x:[a]
xs) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (a -> f b
f a
x) (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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> f b
_ Maybe a
Nothing  = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    traverse a -> f b
f (Just a
a) = forall a. a -> Maybe a
Just 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either c a -> f (Either c b)
traverse a -> f b
_ (Left c
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left c
a)
    traverse a -> f b
f (Right a
a) = forall a b. b -> Either a b
Right 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (c, a) -> f (c, b)
traverse a -> f b
f (c
c, a
a) = (c
c,) 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Identity a -> f (Identity b)
traverse a -> f b
f (Identity a
a) = forall a. a -> Identity a
Identity 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Const c a -> f (Const c b)
traverse a -> f b
_ (Const c
c) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 :: forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse 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 :: forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequence = 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 :: forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
mapM = 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 :: forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault = coerce :: forall a b. Coercible a b => a -> b
coerce (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 :: forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault = coerce :: forall a b. Coercible a b => a -> b
coerce (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 ()))