{-# 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)
class (Functor t, Foldable t) => Traversable t where
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
instance Traversable [] where
{-# INLINABLE 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
{-# INLINABLE 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
{-# 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) = 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
{-# 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,) (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 :: 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
{-# 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) = 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)
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}