{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#ifndef MIN_VERSION_semigroups
#define MIN_VERSION_semigroups(x,y,z) 0
#endif
module Data.Biapplicative (
Biapplicative(..)
, (<<$>>)
, (<<**>>)
, biliftA3
, traverseBia
, sequenceBia
, traverseBiaWith
, module Data.Bifunctor
) where
import Control.Applicative
import Data.Bifunctor
import Data.Functor.Identity
import GHC.Exts (inline)
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid
import Data.Traversable (Traversable (traverse))
#endif
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)
import Data.Semigroup (Arg(..))
#endif
#ifdef MIN_VERSION_tagged
import Data.Tagged
#endif
infixl 4 <<$>>, <<*>>, <<*, *>>, <<**>>
(<<$>>) :: (a -> b) -> a -> b
<<$>> :: (a -> b) -> a -> b
(<<$>>) = (a -> b) -> a -> b
forall a. a -> a
id
{-# INLINE (<<$>>) #-}
class Bifunctor p => Biapplicative p where
#if __GLASGOW_HASKELL__ >= 708
{-# MINIMAL bipure, ((<<*>>) | biliftA2 ) #-}
#endif
bipure :: a -> b -> p a b
(<<*>>) :: p (a -> b) (c -> d) -> p a c -> p b d
(<<*>>) = ((a -> b) -> a -> b)
-> ((c -> d) -> c -> d) -> p (a -> b) (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
biliftA2 (a -> b) -> a -> b
forall a. a -> a
id (c -> d) -> c -> d
forall a. a -> a
id
{-# INLINE (<<*>>) #-}
biliftA2 :: (a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
biliftA2 f :: a -> b -> c
f g :: d -> e -> f
g a :: p a d
a b :: p b e
b = (a -> b -> c) -> (d -> e -> f) -> p a d -> p (b -> c) (e -> f)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b -> c
f d -> e -> f
g (p a d -> p (b -> c) (e -> f)) -> p a d -> p (b -> c) (e -> f)
forall a b. (a -> b) -> a -> b
<<$>> p a d
a p (b -> c) (e -> f) -> p b e -> p c f
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> p b e
b
{-# INLINE biliftA2 #-}
(*>>) :: p a b -> p c d -> p c d
a :: p a b
a *>> b :: p c d
b = (a -> c -> c) -> (b -> d -> d) -> p a b -> p c d -> p c d
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
biliftA2 ((c -> c) -> a -> c -> c
forall a b. a -> b -> a
const c -> c
forall a. a -> a
id) ((d -> d) -> b -> d -> d
forall a b. a -> b -> a
const d -> d
forall a. a -> a
id) p a b
a p c d
b
{-# INLINE (*>>) #-}
(<<*) :: p a b -> p c d -> p a b
a :: p a b
a <<* b :: p c d
b = (a -> c -> a) -> (b -> d -> b) -> p a b -> p c d -> p a b
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
biliftA2 a -> c -> a
forall a b. a -> b -> a
const b -> d -> b
forall a b. a -> b -> a
const p a b
a p c d
b
{-# INLINE (<<*) #-}
(<<**>>) :: Biapplicative p => p a c -> p (a -> b) (c -> d) -> p b d
<<**>> :: p a c -> p (a -> b) (c -> d) -> p b d
(<<**>>) = (a -> (a -> b) -> b)
-> (c -> (c -> d) -> d) -> p a c -> p (a -> b) (c -> d) -> p b d
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
biliftA2 (((a -> b) -> a -> b) -> a -> (a -> b) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> a -> b
forall a. a -> a
id) (((c -> d) -> c -> d) -> c -> (c -> d) -> d
forall a b c. (a -> b -> c) -> b -> a -> c
flip (c -> d) -> c -> d
forall a. a -> a
id)
{-# INLINE (<<**>>) #-}
biliftA3 :: Biapplicative w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h
biliftA3 :: (a -> b -> c -> d)
-> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h
biliftA3 f :: a -> b -> c -> d
f g :: e -> f -> g -> h
g a :: w a e
a b :: w b f
b c :: w c g
c = (a -> b -> c -> d)
-> (e -> f -> g -> h) -> w a e -> w b f -> w (c -> d) (g -> h)
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
biliftA2 a -> b -> c -> d
f e -> f -> g -> h
g w a e
a w b f
b w (c -> d) (g -> h) -> w c g -> w d h
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> w c g
c
{-# INLINE biliftA3 #-}
traverseBia :: (Traversable t, Biapplicative p)
=> (a -> p b c) -> t a -> p (t b) (t c)
traverseBia :: (a -> p b c) -> t a -> p (t b) (t c)
traverseBia = ((a -> p b c) -> t a -> p (t b) (t c))
-> (a -> p b c) -> t a -> p (t b) (t c)
forall a. a -> a
inline ((forall (f :: * -> *) x.
Applicative f =>
(a -> f x) -> t a -> f (t x))
-> (a -> p b c) -> t a -> p (t b) (t c)
forall (p :: * -> * -> *) a b c s (t :: * -> *).
Biapplicative p =>
(forall (f :: * -> *) x.
Applicative f =>
(a -> f x) -> s -> f (t x))
-> (a -> p b c) -> s -> p (t b) (t c)
traverseBiaWith forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) x.
Applicative f =>
(a -> f x) -> t a -> f (t x)
traverse)
{-# INLINABLE [1] traverseBia #-}
sequenceBia :: (Traversable t, Biapplicative p)
=> t (p b c) -> p (t b) (t c)
sequenceBia :: t (p b c) -> p (t b) (t c)
sequenceBia = (t (p b c) -> p (t b) (t c)) -> t (p b c) -> p (t b) (t c)
forall a. a -> a
inline ((p b c -> p b c) -> t (p b c) -> p (t b) (t c)
forall (t :: * -> *) (p :: * -> * -> *) a b c.
(Traversable t, Biapplicative p) =>
(a -> p b c) -> t a -> p (t b) (t c)
traverseBia p b c -> p b c
forall a. a -> a
id)
{-# INLINABLE sequenceBia #-}
traverseBiaWith :: forall p a b c s t. Biapplicative p
=> (forall f x. Applicative f => (a -> f x) -> s -> f (t x))
-> (a -> p b c) -> s -> p (t b) (t c)
traverseBiaWith :: (forall (f :: * -> *) x.
Applicative f =>
(a -> f x) -> s -> f (t x))
-> (a -> p b c) -> s -> p (t b) (t c)
traverseBiaWith trav :: forall (f :: * -> *) x. Applicative f => (a -> f x) -> s -> f (t x)
trav p :: a -> p b c
p s :: s
s = (a -> p b c) -> (forall x. Mag a x (t x)) -> p (t b) (t c)
forall (p :: * -> * -> *) (t :: * -> *) a b c.
Biapplicative p =>
(a -> p b c) -> (forall x. Mag a x (t x)) -> p (t b) (t c)
smash a -> p b c
p ((a -> Mag a x x) -> s -> Mag a x (t x)
forall (f :: * -> *) x. Applicative f => (a -> f x) -> s -> f (t x)
trav a -> Mag a x x
forall a b. a -> Mag a b b
One s
s)
{-# INLINABLE traverseBiaWith #-}
smash :: forall p t a b c. Biapplicative p
=> (a -> p b c)
-> (forall x. Mag a x (t x))
-> p (t b) (t c)
smash :: (a -> p b c) -> (forall x. Mag a x (t x)) -> p (t b) (t c)
smash p :: a -> p b c
p m :: forall x. Mag a x (t x)
m = Mag a b (t b) -> Mag a c (t c) -> p (t b) (t c)
forall x y. Mag a b x -> Mag a c y -> p x y
go Mag a b (t b)
forall x. Mag a x (t x)
m Mag a c (t c)
forall x. Mag a x (t x)
m
where
go :: forall x y. Mag a b x -> Mag a c y -> p x y
go :: Mag a b x -> Mag a c y -> p x y
go (Pure t :: x
t) (Pure u :: y
u) = x -> y -> p x y
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure x
t y
u
go (Map f :: x -> x
f x :: Mag a b x
x) (Map g :: x -> y
g y :: Mag a c x
y) = (x -> x) -> (x -> y) -> p x x -> p x y
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap x -> x
f x -> y
g (Mag a b x -> Mag a c x -> p x x
forall x y. Mag a b x -> Mag a c y -> p x y
go Mag a b x
x Mag a c x
y)
go (Ap fs :: Mag a b (t -> x)
fs xs :: Mag a b t
xs) (Ap gs :: Mag a c (t -> y)
gs ys :: Mag a c t
ys) = Mag a b (t -> x) -> Mag a c (t -> y) -> p (t -> x) (t -> y)
forall x y. Mag a b x -> Mag a c y -> p x y
go Mag a b (t -> x)
fs Mag a c (t -> y)
gs p (t -> x) (t -> y) -> p t t -> p x y
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> Mag a b t -> Mag a c t -> p t t
forall x y. Mag a b x -> Mag a c y -> p x y
go Mag a b t
xs Mag a c t
ys
#if MIN_VERSION_base(4,10,0)
go (LiftA2 f :: t -> u -> x
f xs :: Mag a b t
xs ys :: Mag a b u
ys) (LiftA2 g :: t -> u -> y
g zs :: Mag a c t
zs ws :: Mag a c u
ws) = (t -> u -> x) -> (t -> u -> y) -> p t t -> p (u -> x) (u -> y)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap t -> u -> x
f t -> u -> y
g (Mag a b t -> Mag a c t -> p t t
forall x y. Mag a b x -> Mag a c y -> p x y
go Mag a b t
xs Mag a c t
zs) p (u -> x) (u -> y) -> p u u -> p x y
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> Mag a b u -> Mag a c u -> p u u
forall x y. Mag a b x -> Mag a c y -> p x y
go Mag a b u
ys Mag a c u
ws
#endif
go (One x :: a
x) (One _) = a -> p b c
p a
x
go _ _ = p x y
forall a. a
impossibleError
{-# INLINABLE smash #-}
impossibleError :: a
impossibleError :: a
impossibleError = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "Impossible: the arguments are always the same."
data Mag a b t where
Pure :: t -> Mag a b t
Map :: (x -> t) -> Mag a b x -> Mag a b t
Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
#if MIN_VERSION_base(4,10,0)
LiftA2 :: (t -> u -> v) -> Mag a b t -> Mag a b u -> Mag a b v
#endif
One :: a -> Mag a b b
instance Functor (Mag a b) where
fmap :: (a -> b) -> Mag a b a -> Mag a b b
fmap = (a -> b) -> Mag a b a -> Mag a b b
forall x t a b. (x -> t) -> Mag a b x -> Mag a b t
Map
instance Applicative (Mag a b) where
pure :: a -> Mag a b a
pure = a -> Mag a b a
forall t a b. t -> Mag a b t
Pure
<*> :: Mag a b (a -> b) -> Mag a b a -> Mag a b b
(<*>) = Mag a b (a -> b) -> Mag a b a -> Mag a b b
forall a b a b. Mag a b (a -> b) -> Mag a b a -> Mag a b b
Ap
#if MIN_VERSION_base(4,10,0)
liftA2 :: (a -> b -> c) -> Mag a b a -> Mag a b b -> Mag a b c
liftA2 = (a -> b -> c) -> Mag a b a -> Mag a b b -> Mag a b c
forall t u v a b.
(t -> u -> v) -> Mag a b t -> Mag a b u -> Mag a b v
LiftA2
#endif
{-# RULES
"traverseBia/list" forall f t. traverseBia f t = traverseBiaList f t
"traverseBia/Maybe" forall f t. traverseBia f t = traverseBiaMaybe f t
"traverseBia/Either" forall f t. traverseBia f t = traverseBiaEither f t
"traverseBia/Identity" forall f t. traverseBia f t = traverseBiaIdentity f t
"traverseBia/Const" forall f t. traverseBia f t = traverseBiaConst f t
"traverseBia/Pair" forall f t. traverseBia f t = traverseBiaPair f t
#-}
traverseBiaList :: Biapplicative p => (a -> p b c) -> [a] -> p [b] [c]
traverseBiaList :: (a -> p b c) -> [a] -> p [b] [c]
traverseBiaList f :: a -> p b c
f = (a -> p [b] [c] -> p [b] [c]) -> p [b] [c] -> [a] -> p [b] [c]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> p [b] [c] -> p [b] [c]
go ([b] -> [c] -> p [b] [c]
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure [] [])
where
go :: a -> p [b] [c] -> p [b] [c]
go x :: a
x r :: p [b] [c]
r = (b -> [b] -> [b])
-> (c -> [c] -> [c]) -> p b c -> p [b] [c] -> p [b] [c]
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
biliftA2 (:) (:) (a -> p b c
f a
x) p [b] [c]
r
traverseBiaMaybe :: Biapplicative p => (a -> p b c) -> Maybe a -> p (Maybe b) (Maybe c)
traverseBiaMaybe :: (a -> p b c) -> Maybe a -> p (Maybe b) (Maybe c)
traverseBiaMaybe _f :: a -> p b c
_f Nothing = Maybe b -> Maybe c -> p (Maybe b) (Maybe c)
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure Maybe b
forall a. Maybe a
Nothing Maybe c
forall a. Maybe a
Nothing
traverseBiaMaybe f :: a -> p b c
f (Just x :: a
x) = (b -> Maybe b) -> (c -> Maybe c) -> p b c -> p (Maybe b) (Maybe c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> Maybe b
forall a. a -> Maybe a
Just c -> Maybe c
forall a. a -> Maybe a
Just (a -> p b c
f a
x)
traverseBiaEither :: Biapplicative p => (a -> p b c) -> Either e a -> p (Either e b) (Either e c)
traverseBiaEither :: (a -> p b c) -> Either e a -> p (Either e b) (Either e c)
traverseBiaEither f :: a -> p b c
f (Right x :: a
x) = (b -> Either e b)
-> (c -> Either e c) -> p b c -> p (Either e b) (Either e c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> Either e b
forall a b. b -> Either a b
Right c -> Either e c
forall a b. b -> Either a b
Right (a -> p b c
f a
x)
traverseBiaEither _f :: a -> p b c
_f (Left (e
e :: e)) = Either e b -> Either e c -> p (Either e b) (Either e c)
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure Either e b
forall x. Either e x
m Either e c
forall x. Either e x
m
where
m :: Either e x
m :: Either e x
m = e -> Either e x
forall a b. a -> Either a b
Left e
e
traverseBiaIdentity :: Biapplicative p => (a -> p b c) -> Identity a -> p (Identity b) (Identity c)
traverseBiaIdentity :: (a -> p b c) -> Identity a -> p (Identity b) (Identity c)
traverseBiaIdentity f :: a -> p b c
f (Identity x :: a
x) = (b -> Identity b)
-> (c -> Identity c) -> p b c -> p (Identity b) (Identity c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> Identity b
forall a. a -> Identity a
Identity c -> Identity c
forall a. a -> Identity a
Identity (a -> p b c
f a
x)
traverseBiaConst :: Biapplicative p => (a -> p b c) -> Const x a -> p (Const x b) (Const x c)
traverseBiaConst :: (a -> p b c) -> Const x a -> p (Const x b) (Const x c)
traverseBiaConst _f :: a -> p b c
_f (Const x :: x
x) = Const x b -> Const x c -> p (Const x b) (Const x c)
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure (x -> Const x b
forall k a (b :: k). a -> Const a b
Const x
x) (x -> Const x c
forall k a (b :: k). a -> Const a b
Const x
x)
traverseBiaPair :: Biapplicative p => (a -> p b c) -> (e, a) -> p (e, b) (e, c)
traverseBiaPair :: (a -> p b c) -> (e, a) -> p (e, b) (e, c)
traverseBiaPair f :: a -> p b c
f (x :: e
x,y :: a
y) = (b -> (e, b)) -> (c -> (e, c)) -> p b c -> p (e, b) (e, c)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((,) e
x) ((,) e
x) (a -> p b c
f a
y)
instance Biapplicative (,) where
bipure :: a -> b -> (a, b)
bipure = (,)
{-# INLINE bipure #-}
(f :: a -> b
f, g :: c -> d
g) <<*>> :: (a -> b, c -> d) -> (a, c) -> (b, d)
<<*>> (a :: a
a, b :: c
b) = (a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<*>>) #-}
biliftA2 :: (a -> b -> c) -> (d -> e -> f) -> (a, d) -> (b, e) -> (c, f)
biliftA2 f :: a -> b -> c
f g :: d -> e -> f
g (x :: a
x, y :: d
y) (a :: b
a, b :: e
b) = (a -> b -> c
f a
x b
a, d -> e -> f
g d
y e
b)
{-# INLINE biliftA2 #-}
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)
instance Biapplicative Arg where
bipure :: a -> b -> Arg a b
bipure = a -> b -> Arg a b
forall a b. a -> b -> Arg a b
Arg
{-# INLINE bipure #-}
Arg f :: a -> b
f g :: c -> d
g <<*>> :: Arg (a -> b) (c -> d) -> Arg a c -> Arg b d
<<*>> Arg a :: a
a b :: c
b = b -> d -> Arg b d
forall a b. a -> b -> Arg a b
Arg (a -> b
f a
a) (c -> d
g c
b)
{-# INLINE (<<*>>) #-}
biliftA2 :: (a -> b -> c) -> (d -> e -> f) -> Arg a d -> Arg b e -> Arg c f
biliftA2 f :: a -> b -> c
f g :: d -> e -> f
g (Arg x :: a
x y :: d
y) (Arg a :: b
a b :: e
b) = c -> f -> Arg c f
forall a b. a -> b -> Arg a b
Arg (a -> b -> c
f a
x b
a) (d -> e -> f
g d
y e
b)
{-# INLINE biliftA2 #-}
#endif
instance Monoid x => Biapplicative ((,,) x) where
bipure :: a -> b -> (x, a, b)
bipure = (,,) x
forall a. Monoid a => a
mempty
{-# INLINE bipure #-}
(x :: x
x, f :: a -> b
f, g :: c -> d
g) <<*>> :: (x, a -> b, c -> d) -> (x, a, c) -> (x, b, d)
<<*>> (x' :: x
x', a :: a
a, b :: c
b) = (x -> x -> x
forall a. Monoid a => a -> a -> a
mappend x
x x
x', a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<*>>) #-}
instance (Monoid x, Monoid y) => Biapplicative ((,,,) x y) where
bipure :: a -> b -> (x, y, a, b)
bipure = (,,,) x
forall a. Monoid a => a
mempty y
forall a. Monoid a => a
mempty
{-# INLINE bipure #-}
(x :: x
x, y :: y
y, f :: a -> b
f, g :: c -> d
g) <<*>> :: (x, y, a -> b, c -> d) -> (x, y, a, c) -> (x, y, b, d)
<<*>> (x' :: x
x', y' :: y
y', a :: a
a, b :: c
b) = (x -> x -> x
forall a. Monoid a => a -> a -> a
mappend x
x x
x', y -> y -> y
forall a. Monoid a => a -> a -> a
mappend y
y y
y', a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<*>>) #-}
instance (Monoid x, Monoid y, Monoid z) => Biapplicative ((,,,,) x y z) where
bipure :: a -> b -> (x, y, z, a, b)
bipure = (,,,,) x
forall a. Monoid a => a
mempty y
forall a. Monoid a => a
mempty z
forall a. Monoid a => a
mempty
{-# INLINE bipure #-}
(x :: x
x, y :: y
y, z :: z
z, f :: a -> b
f, g :: c -> d
g) <<*>> :: (x, y, z, a -> b, c -> d) -> (x, y, z, a, c) -> (x, y, z, b, d)
<<*>> (x' :: x
x', y' :: y
y', z' :: z
z', a :: a
a, b :: c
b) = (x -> x -> x
forall a. Monoid a => a -> a -> a
mappend x
x x
x', y -> y -> y
forall a. Monoid a => a -> a -> a
mappend y
y y
y', z -> z -> z
forall a. Monoid a => a -> a -> a
mappend z
z z
z', a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<*>>) #-}
instance (Monoid x, Monoid y, Monoid z, Monoid w) => Biapplicative ((,,,,,) x y z w) where
bipure :: a -> b -> (x, y, z, w, a, b)
bipure = (,,,,,) x
forall a. Monoid a => a
mempty y
forall a. Monoid a => a
mempty z
forall a. Monoid a => a
mempty w
forall a. Monoid a => a
mempty
{-# INLINE bipure #-}
(x :: x
x, y :: y
y, z :: z
z, w :: w
w, f :: a -> b
f, g :: c -> d
g) <<*>> :: (x, y, z, w, a -> b, c -> d)
-> (x, y, z, w, a, c) -> (x, y, z, w, b, d)
<<*>> (x' :: x
x', y' :: y
y', z' :: z
z', w' :: w
w', a :: a
a, b :: c
b) = (x -> x -> x
forall a. Monoid a => a -> a -> a
mappend x
x x
x', y -> y -> y
forall a. Monoid a => a -> a -> a
mappend y
y y
y', z -> z -> z
forall a. Monoid a => a -> a -> a
mappend z
z z
z', w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
w w
w', a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<*>>) #-}
instance (Monoid x, Monoid y, Monoid z, Monoid w, Monoid v) => Biapplicative ((,,,,,,) x y z w v) where
bipure :: a -> b -> (x, y, z, w, v, a, b)
bipure = (,,,,,,) x
forall a. Monoid a => a
mempty y
forall a. Monoid a => a
mempty z
forall a. Monoid a => a
mempty w
forall a. Monoid a => a
mempty v
forall a. Monoid a => a
mempty
{-# INLINE bipure #-}
(x :: x
x, y :: y
y, z :: z
z, w :: w
w, v :: v
v, f :: a -> b
f, g :: c -> d
g) <<*>> :: (x, y, z, w, v, a -> b, c -> d)
-> (x, y, z, w, v, a, c) -> (x, y, z, w, v, b, d)
<<*>> (x' :: x
x', y' :: y
y', z' :: z
z', w' :: w
w', v' :: v
v', a :: a
a, b :: c
b) = (x -> x -> x
forall a. Monoid a => a -> a -> a
mappend x
x x
x', y -> y -> y
forall a. Monoid a => a -> a -> a
mappend y
y y
y', z -> z -> z
forall a. Monoid a => a -> a -> a
mappend z
z z
z', w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
w w
w', v -> v -> v
forall a. Monoid a => a -> a -> a
mappend v
v v
v', a -> b
f a
a, c -> d
g c
b)
{-# INLINE (<<*>>) #-}
#ifdef MIN_VERSION_tagged
instance Biapplicative Tagged where
bipure :: a -> b -> Tagged a b
bipure _ b :: b
b = b -> Tagged a b
forall k (s :: k) b. b -> Tagged s b
Tagged b
b
{-# INLINE bipure #-}
Tagged f :: c -> d
f <<*>> :: Tagged (a -> b) (c -> d) -> Tagged a c -> Tagged b d
<<*>> Tagged x :: c
x = d -> Tagged b d
forall k (s :: k) b. b -> Tagged s b
Tagged (c -> d
f c
x)
{-# INLINE (<<*>>) #-}
#endif
instance Biapplicative Const where
bipure :: a -> b -> Const a b
bipure a :: a
a _ = a -> Const a b
forall k a (b :: k). a -> Const a b
Const a
a
{-# INLINE bipure #-}
Const f :: a -> b
f <<*>> :: Const (a -> b) (c -> d) -> Const a c -> Const b d
<<*>> Const x :: a
x = b -> Const b d
forall k a (b :: k). a -> Const a b
Const (a -> b
f a
x)
{-# INLINE (<<*>>) #-}