-- 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
  {-# INLINEABLE traverse #-}
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> f b
f = [a] -> f [b]
go
   where
    go :: [a] -> f [b]
go []       = [b] -> f [b]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go (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]
go [a]
xs)

instance Traversable Maybe where
  {-# INLINEABLE traverse #-}
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> f b
_ Maybe a
Nothing  = Maybe b -> f (Maybe b)
forall a. a -> f a
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
  {-# INLINEABLE 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)  = Either c b -> f (Either c b)
forall a. a -> f a
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
  {-# INLINEABLE 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,) (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
  {-# INLINEABLE traverse #-}
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(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
  {-# INLINEABLE 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) = Const c b -> f (Const c b)
forall a. a -> f a
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)
sequenceA :: forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse f a -> f a
forall a. a -> a
id
{-# INLINE sequenceA #-}

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

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

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

-- | Plutus Tx version of 'Data.Traversable.fmapDefault'.
fmapDefault
  :: forall t a b
   . (Traversable t)
  => (a -> b) -> t a -> t b
fmapDefault :: forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault = ((a -> Identity b) -> t a -> Identity (t b))
-> (a -> b) -> t a -> t b
forall a b. Coercible a b => a -> 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse :: (a -> Identity b) -> t a -> Identity (t b))
{-# INLINE fmapDefault #-}

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