{-# 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
{-# 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)
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 #-}