{-# LANGUAGE ConstraintKinds #-}
module Data.Profunctor.Arrow where

import qualified Control.Category as C
import qualified Control.Arrow as Arr
import Data.Profunctor
import Data.Profunctor.Cayley
import Data.Profunctor.Strong
import Data.Profunctor.Closed
import Data.Profunctor.Choice
import Data.Profunctor.Traversing
import Data.Profunctor.Mapping
import Data.Profunctor.Yoneda
import Data.Profunctor.Ran
import Data.Profunctor.Composition

import Data.Bifunctor.Biff
import Data.Bifunctor.Tannen
import Data.Bifunctor.Joker
import Data.Bifunctor.Product
import Control.Applicative hiding (WrappedArrow(..))


arr :: (Profunctor p, C.Category p) => (a -> b) -> p a b
arr :: (a -> b) -> p a b
arr f :: a -> b
f = (a -> b) -> p a a -> p a b
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap a -> b
f p a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id

-- | Split the input between the two argument profunctors and combine their output.
(***) :: (C.Category p, Strong p) => p b c -> p b' c' -> p (b, b') (c, c')
l :: p b c
l *** :: p b c -> p b' c' -> p (b, b') (c, c')
*** r :: p b' c'
r = p b c -> p (b, c') (c, c')
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' p b c
l p (b, c') (c, c') -> p (b, b') (b, c') -> p (b, b') (c, c')
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. p b' c' -> p (b, b') (b, c')
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second' p b' c'
r

-- | Fanout: send the input to both argument arrows and combine their output.
(&&&) :: (C.Category p, Strong p) => p b c -> p b c' -> p b (c, c')
l :: p b c
l &&& :: p b c -> p b c' -> p b (c, c')
&&& r :: p b c'
r =  (b -> (b, b)) -> p (b, b) (c, c') -> p b (c, c')
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\x :: b
x -> (b
x, b
x)) (p b c
l p b c -> p b c' -> p (b, b) (c, c')
forall (p :: * -> * -> *) b c b' c'.
(Category p, Strong p) =>
p b c -> p b' c' -> p (b, b') (c, c')
*** p b c'
r)

-- | Precomposition with a pure function.
(^>>) :: (Profunctor p, C.Category p) => (b -> c) -> p c d -> p b d
f :: b -> c
f ^>> :: (b -> c) -> p c d -> p b d
^>> p :: p c d
p = (b -> c) -> p c d -> p b d
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap b -> c
f p c d
p

-- | Postcomposition with a pure function.
(>>^) :: (Profunctor p, C.Category p) => p b c -> (c -> d) -> p b d
p :: p b c
p >>^ :: p b c -> (c -> d) -> p b d
>>^ f :: c -> d
f = (c -> d) -> p b c -> p b d
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap c -> d
f p b c
p

-- | Precomposition with a pure function (right-to-left variant).
(<<^) :: (Profunctor p, C.Category p) => p c d -> (b -> c) -> p b d
p :: p c d
p <<^ :: p c d -> (b -> c) -> p b d
<<^ f :: b -> c
f = (b -> c) -> p c d -> p b d
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap b -> c
f p c d
p

-- | Postcomposition with a pure function (right-to-left variant).
(^<<) :: (Profunctor p, C.Category p) => (c -> d) -> p b c -> p b d
f :: c -> d
f ^<< :: (c -> d) -> p b c -> p b d
^<< p :: p b c
p = (c -> d) -> p b c -> p b d
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap c -> d
f p b c
p

(+++) :: (Choice p, C.Category p) => p b c -> p b' c' -> p (Either b b') (Either c c')
l :: p b c
l +++ :: p b c -> p b' c' -> p (Either b b') (Either c c')
+++ r :: p b' c'
r = p b c -> p (Either b c') (Either c c')
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left' p b c
l p (Either b c') (Either c c')
-> p (Either b b') (Either b c') -> p (Either b b') (Either c c')
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.<<< p b' c' -> p (Either b b') (Either b c')
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' p b' c'
r

(|||) :: (Choice p, C.Category p) => p b d -> p c d -> p (Either b c) d
l :: p b d
l ||| :: p b d -> p c d -> p (Either b c) d
||| r :: p c d
r = (Either d d -> d)
-> p (Either b c) (Either d d) -> p (Either b c) d
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap ((d -> d) -> (d -> d) -> Either d d -> d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either d -> d
forall a. a -> a
id d -> d
forall a. a -> a
id) (p b d
l p b d -> p c d -> p (Either b c) (Either d d)
forall (p :: * -> * -> *) b c b' c'.
(Choice p, Category p) =>
p b c -> p b' c' -> p (Either b b') (Either c c')
+++ p c d
r)

class Profunctor p => ProfunctorZero p where
  zeroProfunctor :: p a b

instance Alternative f => ProfunctorZero (Star f) where
  zeroProfunctor :: Star f a b
zeroProfunctor = (a -> f b) -> Star f a b
forall (f :: * -> *) d c. (d -> f c) -> Star f d c
Star (f b -> a -> f b
forall a b. a -> b -> a
const f b
forall (f :: * -> *) a. Alternative f => f a
empty)

instance (Monad m, Alternative m) => ProfunctorZero (Arr.Kleisli m) where
  zeroProfunctor :: Kleisli m a b
zeroProfunctor = (a -> m b) -> Kleisli m a b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Arr.Kleisli (m b -> a -> m b
forall a b. a -> b -> a
const m b
forall (f :: * -> *) a. Alternative f => f a
empty)

instance Monoid r => ProfunctorZero (Forget r) where
  zeroProfunctor :: Forget r a b
zeroProfunctor = (a -> r) -> Forget r a b
forall r a b. (a -> r) -> Forget r a b
Forget (r -> a -> r
forall a b. a -> b -> a
const r
forall a. Monoid a => a
mempty)

instance (Applicative f, ProfunctorZero p) => ProfunctorZero (Cayley f p) where
  zeroProfunctor :: Cayley f p a b
zeroProfunctor = f (p a b) -> Cayley f p a b
forall (f :: * -> *) (p :: * -> * -> *) a b.
f (p a b) -> Cayley f p a b
Cayley (p a b -> f (p a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure p a b
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor)

instance (Applicative f, ProfunctorZero p) => ProfunctorZero (Tannen f p) where
  zeroProfunctor :: Tannen f p a b
zeroProfunctor = f (p a b) -> Tannen f p a b
forall k k1 k2 (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen (p a b -> f (p a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure p a b
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor)

instance (ProfunctorZero p) => ProfunctorZero (Tambara p) where
  zeroProfunctor :: Tambara p a b
zeroProfunctor = (forall c. p (a, c) (b, c)) -> Tambara p a b
forall (p :: * -> * -> *) a b.
(forall c. p (a, c) (b, c)) -> Tambara p a b
Tambara forall c. p (a, c) (b, c)
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor

instance (ProfunctorZero p) => ProfunctorZero (Closure p) where
  zeroProfunctor :: Closure p a b
zeroProfunctor = (forall x. p (x -> a) (x -> b)) -> Closure p a b
forall (p :: * -> * -> *) a b.
(forall x. p (x -> a) (x -> b)) -> Closure p a b
Closure forall x. p (x -> a) (x -> b)
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor

instance (ProfunctorZero p) => ProfunctorZero (TambaraSum p) where
  zeroProfunctor :: TambaraSum p a b
zeroProfunctor = (forall c. p (Either a c) (Either b c)) -> TambaraSum p a b
forall (p :: * -> * -> *) a b.
(forall c. p (Either a c) (Either b c)) -> TambaraSum p a b
TambaraSum forall c. p (Either a c) (Either b c)
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor

instance (ProfunctorZero p) => ProfunctorZero (CofreeTraversing p) where
  zeroProfunctor :: CofreeTraversing p a b
zeroProfunctor = (forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing forall (f :: * -> *). Traversable f => p (f a) (f b)
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor

instance (ProfunctorZero p) => ProfunctorZero (CofreeMapping p) where
  zeroProfunctor :: CofreeMapping p a b
zeroProfunctor = (forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping forall (f :: * -> *). Functor f => p (f a) (f b)
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor

instance (ProfunctorZero p) => ProfunctorZero (Yoneda p) where
  zeroProfunctor :: Yoneda p a b
zeroProfunctor = (forall x y. (x -> a) -> (b -> y) -> p x y) -> Yoneda p a b
forall (p :: * -> * -> *) a b.
(forall x y. (x -> a) -> (b -> y) -> p x y) -> Yoneda p a b
Yoneda (\_ _ -> p x y
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor)

instance Alternative f => ProfunctorZero (Joker f) where
  zeroProfunctor :: Joker f a b
zeroProfunctor = f b -> Joker f a b
forall k k1 (g :: k -> *) (a :: k1) (b :: k). g b -> Joker g a b
Joker f b
forall (f :: * -> *) a. Alternative f => f a
empty

instance Arr.ArrowZero p => ProfunctorZero (WrappedArrow p) where
  zeroProfunctor :: WrappedArrow p a b
zeroProfunctor = p a b -> WrappedArrow p a b
forall (p :: * -> * -> *) a b. p a b -> WrappedArrow p a b
WrapArrow p a b
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
Arr.zeroArrow

instance ProfunctorZero p => ProfunctorZero (Codensity p) where
  zeroProfunctor :: Codensity p a b
zeroProfunctor = (forall x. p x a -> p x b) -> Codensity p a b
forall (p :: * -> * -> *) a b.
(forall x. p x a -> p x b) -> Codensity p a b
Codensity (p x b -> p x a -> p x b
forall a b. a -> b -> a
const p x b
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor)

instance (ProfunctorZero p, ProfunctorZero q) => ProfunctorZero (Product p q) where
  zeroProfunctor :: Product p q a b
zeroProfunctor = p a b -> q a b -> Product p q a b
forall k k1 (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair p a b
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor q a b
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor

instance  (Profunctor p, ProfunctorZero q) => ProfunctorZero (Rift p q) where
  zeroProfunctor :: Rift p q a b
zeroProfunctor = (forall x. p b x -> q a x) -> Rift p q a b
forall (p :: * -> * -> *) (q :: * -> * -> *) a b.
(forall x. p b x -> q a x) -> Rift p q a b
Rift (q a x -> p b x -> q a x
forall a b. a -> b -> a
const q a x
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor)

instance  (ProfunctorZero p, Functor f, Functor g) => ProfunctorZero (Biff p f g) where
  zeroProfunctor :: Biff p f g a b
zeroProfunctor = p (f a) (g b) -> Biff p f g a b
forall k k1 k2 k3 (p :: k -> k1 -> *) (f :: k2 -> k)
       (g :: k3 -> k1) (a :: k2) (b :: k3).
p (f a) (g b) -> Biff p f g a b
Biff p (f a) (g b)
forall (p :: * -> * -> *) a b. ProfunctorZero p => p a b
zeroProfunctor

class ProfunctorZero p => ProfunctorPlus p where
  (<+>) :: p a b -> p a b -> p a b

instance Alternative f => ProfunctorPlus (Star f) where
  Star f :: a -> f b
f <+> :: Star f a b -> Star f a b -> Star f a b
<+> Star g :: a -> f b
g = (a -> f b) -> Star f a b
forall (f :: * -> *) d c. (d -> f c) -> Star f d c
Star ((f b -> f b -> f b) -> (a -> f b) -> (a -> f b) -> a -> f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f b -> f b -> f b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) a -> f b
f a -> f b
g)

instance (Monad m, Alternative m) => ProfunctorPlus (Arr.Kleisli m) where
  Arr.Kleisli f :: a -> m b
f <+> :: Kleisli m a b -> Kleisli m a b -> Kleisli m a b
<+> Arr.Kleisli g :: a -> m b
g = (a -> m b) -> Kleisli m a b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Arr.Kleisli ((m b -> m b -> m b) -> (a -> m b) -> (a -> m b) -> a -> m b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m b -> m b -> m b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) a -> m b
f a -> m b
g)

instance Monoid r => ProfunctorPlus (Forget r) where
  Forget f :: a -> r
f <+> :: Forget r a b -> Forget r a b -> Forget r a b
<+> Forget g :: a -> r
g = (a -> r) -> Forget r a b
forall r a b. (a -> r) -> Forget r a b
Forget ((r -> r -> r) -> (a -> r) -> (a -> r) -> a -> r
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 r -> r -> r
forall a. Semigroup a => a -> a -> a
(<>) a -> r
f a -> r
g)

instance (Applicative f, ProfunctorPlus p) => ProfunctorPlus (Cayley f p) where
  Cayley f :: f (p a b)
f <+> :: Cayley f p a b -> Cayley f p a b -> Cayley f p a b
<+> Cayley g :: f (p a b)
g = f (p a b) -> Cayley f p a b
forall (f :: * -> *) (p :: * -> * -> *) a b.
f (p a b) -> Cayley f p a b
Cayley ((p a b -> p a b -> p a b) -> f (p a b) -> f (p a b) -> f (p a b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p a b -> p a b -> p a b
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
(<+>) f (p a b)
f f (p a b)
g)

instance (Applicative f, ProfunctorPlus p) => ProfunctorPlus (Tannen f p) where
  Tannen f :: f (p a b)
f <+> :: Tannen f p a b -> Tannen f p a b -> Tannen f p a b
<+> Tannen g :: f (p a b)
g = f (p a b) -> Tannen f p a b
forall k k1 k2 (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen ((p a b -> p a b -> p a b) -> f (p a b) -> f (p a b) -> f (p a b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p a b -> p a b -> p a b
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
(<+>) f (p a b)
f f (p a b)
g)

instance (ProfunctorPlus p) => ProfunctorPlus (Tambara p) where
  Tambara f :: forall c. p (a, c) (b, c)
f <+> :: Tambara p a b -> Tambara p a b -> Tambara p a b
<+> Tambara g :: forall c. p (a, c) (b, c)
g = (forall c. p (a, c) (b, c)) -> Tambara p a b
forall (p :: * -> * -> *) a b.
(forall c. p (a, c) (b, c)) -> Tambara p a b
Tambara (p (a, c) (b, c)
forall c. p (a, c) (b, c)
f p (a, c) (b, c) -> p (a, c) (b, c) -> p (a, c) (b, c)
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
<+> p (a, c) (b, c)
forall c. p (a, c) (b, c)
g)

instance (ProfunctorPlus p) => ProfunctorPlus (Closure p) where
  Closure f :: forall x. p (x -> a) (x -> b)
f <+> :: Closure p a b -> Closure p a b -> Closure p a b
<+> Closure g :: forall x. p (x -> a) (x -> b)
g = (forall x. p (x -> a) (x -> b)) -> Closure p a b
forall (p :: * -> * -> *) a b.
(forall x. p (x -> a) (x -> b)) -> Closure p a b
Closure (p (x -> a) (x -> b)
forall x. p (x -> a) (x -> b)
f p (x -> a) (x -> b) -> p (x -> a) (x -> b) -> p (x -> a) (x -> b)
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
<+> p (x -> a) (x -> b)
forall x. p (x -> a) (x -> b)
g)

instance (ProfunctorPlus p) => ProfunctorPlus (TambaraSum p) where
  TambaraSum f :: forall c. p (Either a c) (Either b c)
f <+> :: TambaraSum p a b -> TambaraSum p a b -> TambaraSum p a b
<+> TambaraSum g :: forall c. p (Either a c) (Either b c)
g = (forall c. p (Either a c) (Either b c)) -> TambaraSum p a b
forall (p :: * -> * -> *) a b.
(forall c. p (Either a c) (Either b c)) -> TambaraSum p a b
TambaraSum (p (Either a c) (Either b c)
forall c. p (Either a c) (Either b c)
f p (Either a c) (Either b c)
-> p (Either a c) (Either b c) -> p (Either a c) (Either b c)
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
<+> p (Either a c) (Either b c)
forall c. p (Either a c) (Either b c)
g)

instance (ProfunctorPlus p) => ProfunctorPlus (CofreeTraversing p) where
  CofreeTraversing f :: forall (f :: * -> *). Traversable f => p (f a) (f b)
f <+> :: CofreeTraversing p a b
-> CofreeTraversing p a b -> CofreeTraversing p a b
<+> CofreeTraversing g :: forall (f :: * -> *). Traversable f => p (f a) (f b)
g = (forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Traversable f => p (f a) (f b))
-> CofreeTraversing p a b
CofreeTraversing (p (f a) (f b)
forall (f :: * -> *). Traversable f => p (f a) (f b)
f p (f a) (f b) -> p (f a) (f b) -> p (f a) (f b)
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
<+> p (f a) (f b)
forall (f :: * -> *). Traversable f => p (f a) (f b)
g)

instance (ProfunctorPlus p) => ProfunctorPlus (CofreeMapping p) where
  CofreeMapping f :: forall (f :: * -> *). Functor f => p (f a) (f b)
f <+> :: CofreeMapping p a b -> CofreeMapping p a b -> CofreeMapping p a b
<+> CofreeMapping g :: forall (f :: * -> *). Functor f => p (f a) (f b)
g = (forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping (p (f a) (f b)
forall (f :: * -> *). Functor f => p (f a) (f b)
f p (f a) (f b) -> p (f a) (f b) -> p (f a) (f b)
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
<+> p (f a) (f b)
forall (f :: * -> *). Functor f => p (f a) (f b)
g)

instance Alternative f => ProfunctorPlus (Joker f) where
  Joker f :: f b
f <+> :: Joker f a b -> Joker f a b -> Joker f a b
<+> Joker g :: f b
g = f b -> Joker f a b
forall k k1 (g :: k -> *) (a :: k1) (b :: k). g b -> Joker g a b
Joker (f b
f f b -> f b -> f b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f b
g)

instance Arr.ArrowPlus p => ProfunctorPlus (WrappedArrow p) where
  WrapArrow f :: p a b
f <+> :: WrappedArrow p a b -> WrappedArrow p a b -> WrappedArrow p a b
<+> WrapArrow g :: p a b
g = p a b -> WrappedArrow p a b
forall (p :: * -> * -> *) a b. p a b -> WrappedArrow p a b
WrapArrow (p a b
f p a b -> p a b -> p a b
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
Arr.<+> p a b
g)

instance ProfunctorPlus p => ProfunctorPlus (Codensity p) where
  Codensity f :: forall x. p x a -> p x b
f <+> :: Codensity p a b -> Codensity p a b -> Codensity p a b
<+> Codensity g :: forall x. p x a -> p x b
g = (forall x. p x a -> p x b) -> Codensity p a b
forall (p :: * -> * -> *) a b.
(forall x. p x a -> p x b) -> Codensity p a b
Codensity ((p x b -> p x b -> p x b)
-> (p x a -> p x b) -> (p x a -> p x b) -> p x a -> p x b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p x b -> p x b -> p x b
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
(<+>) p x a -> p x b
forall x. p x a -> p x b
f p x a -> p x b
forall x. p x a -> p x b
g)

instance (ProfunctorPlus p, ProfunctorPlus q) => ProfunctorPlus (Product p q) where
  Pair fl :: p a b
fl fr :: q a b
fr <+> :: Product p q a b -> Product p q a b -> Product p q a b
<+> Pair gl :: p a b
gl gr :: q a b
gr = p a b -> q a b -> Product p q a b
forall k k1 (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair (p a b
fl p a b -> p a b -> p a b
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
<+> p a b
gl) (q a b
fr q a b -> q a b -> q a b
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
<+> q a b
gr)

instance  (Profunctor p, ProfunctorPlus q) => ProfunctorPlus (Rift p q) where
  Rift f :: forall x. p b x -> q a x
f <+> :: Rift p q a b -> Rift p q a b -> Rift p q a b
<+> Rift g :: forall x. p b x -> q a x
g = (forall x. p b x -> q a x) -> Rift p q a b
forall (p :: * -> * -> *) (q :: * -> * -> *) a b.
(forall x. p b x -> q a x) -> Rift p q a b
Rift ((q a x -> q a x -> q a x)
-> (p b x -> q a x) -> (p b x -> q a x) -> p b x -> q a x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 q a x -> q a x -> q a x
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
(<+>) p b x -> q a x
forall x. p b x -> q a x
f p b x -> q a x
forall x. p b x -> q a x
g)

instance  (ProfunctorPlus p, Functor f, Functor g) => ProfunctorPlus (Biff p f g) where
  Biff f :: p (f a) (g b)
f <+> :: Biff p f g a b -> Biff p f g a b -> Biff p f g a b
<+> Biff g :: p (f a) (g b)
g = p (f a) (g b) -> Biff p f g a b
forall k k1 k2 k3 (p :: k -> k1 -> *) (f :: k2 -> k)
       (g :: k3 -> k1) (a :: k2) (b :: k3).
p (f a) (g b) -> Biff p f g a b
Biff (p (f a) (g b)
f p (f a) (g b) -> p (f a) (g b) -> p (f a) (g b)
forall (p :: * -> * -> *) a b.
ProfunctorPlus p =>
p a b -> p a b -> p a b
<+> p (f a) (g b)
g)

class Profunctor p => ProfunctorApply p where
  app :: p (p a b, a) b

instance Functor f => ProfunctorApply (Star f) where
  app :: Star f (Star f a b, a) b
app = ((Star f a b, a) -> f b) -> Star f (Star f a b, a) b
forall (f :: * -> *) d c. (d -> f c) -> Star f d c
Star (\(Star f :: a -> f b
f, a :: a
a) -> a -> f b
f a
a)

instance ProfunctorApply (->) where
  app :: (a -> b, a) -> b
app = (a -> b, a) -> b
forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
Arr.app

instance Monad m => ProfunctorApply (Arr.Kleisli m) where
  app :: Kleisli m (Kleisli m a b, a) b
app = Kleisli m (Kleisli m a b, a) b
forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
Arr.app

instance ProfunctorApply (Forget r) where
  app :: Forget r (Forget r a b, a) b
app = ((Forget r a b, a) -> r) -> Forget r (Forget r a b, a) b
forall r a b. (a -> r) -> Forget r a b
Forget (\(Forget f :: a -> r
f, a :: a
a) -> a -> r
f a
a)

instance (Arr.Arrow p, Arr.ArrowApply p) => ProfunctorApply (WrappedArrow p) where
  app :: WrappedArrow p (WrappedArrow p a b, a) b
app = WrappedArrow p (WrappedArrow p a b, a) b
forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
Arr.app

instance Alternative g => ProfunctorApply (Joker g) where
  app :: Joker g (Joker g a b, a) b
app = g b -> Joker g (Joker g a b, a) b
forall k k1 (g :: k -> *) (a :: k1) (b :: k). g b -> Joker g a b
Joker g b
forall (f :: * -> *) a. Alternative f => f a
empty