{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2014-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
----------------------------------------------------------------------------

module Data.Profunctor.Cayley where

import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Comonad
import Data.Profunctor
import Data.Profunctor.Monad
import Data.Profunctor.Traversing
import Data.Profunctor.Unsafe
import Prelude hiding ((.), id)

-- | Static arrows. Lifted by 'Applicative'.
--
-- 'Cayley' has a polymorphic kind since @5.6@.

-- Cayley :: (k3 -> Type) -> (k1 -> k2 -> k3) -> (k1 -> k2 -> Type)
newtype Cayley f p a b = Cayley { forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley :: f (p a b) }

instance Functor f => ProfunctorFunctor (Cayley f) where
  promap :: forall (p :: * -> * -> *) (q :: * -> * -> *).
Profunctor p =>
(p :-> q) -> Cayley f p :-> Cayley f q
promap p :-> q
f (Cayley f (p a b)
p) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p :-> q
f f (p a b)
p)

-- | Cayley transforms Monads in @Hask@ into monads on @Prof@
instance (Functor f, Monad f) => ProfunctorMonad (Cayley f) where
  proreturn :: forall (p :: * -> * -> *). Profunctor p => p :-> Cayley f p
proreturn = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return
  projoin :: forall (p :: * -> * -> *).
Profunctor p =>
Cayley f (Cayley f p) :-> Cayley f p
projoin (Cayley f (Cayley f p a b)
m) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ f (Cayley f p a b)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley

-- | Cayley transforms Comonads in @Hask@ into comonads on @Prof@
instance Comonad f => ProfunctorComonad (Cayley f) where
  proextract :: forall (p :: * -> * -> *). Profunctor p => Cayley f p :-> p
proextract = forall (w :: * -> *) a. Comonad w => w a -> a
extract forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  produplicate :: forall (p :: * -> * -> *).
Profunctor p =>
Cayley f p :-> Cayley f (Cayley f p)
produplicate (Cayley f (p a b)
w) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley f (p a b)
w

instance (Functor f, Profunctor p) => Profunctor (Cayley f p) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Cayley f p b c -> Cayley f p a d
dimap a -> b
f c -> d
g = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  lmap :: forall a b c. (a -> b) -> Cayley f p b c -> Cayley f p a c
lmap a -> b
f = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  rmap :: forall b c a. (b -> c) -> Cayley f p a b -> Cayley f p a c
rmap b -> c
g = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap b -> c
g) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  q b c
w #. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Cayley f p a b -> Cayley f p a c
#. Cayley f (p a b)
fp = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (q b c
w forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#.) f (p a b)
fp
  Cayley f (p b c)
fp .# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Cayley f p b c -> q a b -> Cayley f p a c
.# q a b
w = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# q a b
w) f (p b c)
fp

instance (Functor f, Strong p) => Strong (Cayley f p) where
  first' :: forall a b c. Cayley f p a b -> Cayley f p (a, c) (b, c)
first'  = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  second' :: forall a b c. Cayley f p a b -> Cayley f p (c, a) (c, b)
second' = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley

instance (Functor f, Costrong p) => Costrong (Cayley f p) where
  unfirst :: forall a d b. Cayley f p (a, d) (b, d) -> Cayley f p a b
unfirst (Cayley f (p (a, d) (b, d))
fp) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a d b.
Costrong p =>
p (a, d) (b, d) -> p a b
unfirst f (p (a, d) (b, d))
fp)
  unsecond :: forall d a b. Cayley f p (d, a) (d, b) -> Cayley f p a b
unsecond (Cayley f (p (d, a) (d, b))
fp) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) d a b.
Costrong p =>
p (d, a) (d, b) -> p a b
unsecond f (p (d, a) (d, b))
fp)

instance (Functor f, Choice p) => Choice (Cayley f p) where
  left' :: forall a b c.
Cayley f p a b -> Cayley f p (Either a c) (Either b c)
left'   = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  right' :: forall a b c.
Cayley f p a b -> Cayley f p (Either c a) (Either c b)
right'  = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley

instance (Functor f, Cochoice p) => Cochoice (Cayley f p) where
  unleft :: forall a d b.
Cayley f p (Either a d) (Either b d) -> Cayley f p a b
unleft (Cayley f (p (Either a d) (Either b d))
fp) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a d b.
Cochoice p =>
p (Either a d) (Either b d) -> p a b
unleft f (p (Either a d) (Either b d))
fp)
  {-# INLINE unleft #-}
  unright :: forall d a b.
Cayley f p (Either d a) (Either d b) -> Cayley f p a b
unright (Cayley f (p (Either d a) (Either d b))
fp) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) d a b.
Cochoice p =>
p (Either d a) (Either d b) -> p a b
unright f (p (Either d a) (Either d b))
fp)
  {-# INLINE unright #-}

instance (Functor f, Closed p) => Closed (Cayley f p) where
  closed :: forall a b x. Cayley f p a b -> Cayley f p (x -> a) (x -> b)
closed = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley

instance (Functor f, Traversing p) => Traversing (Cayley f p) where
  traverse' :: forall (f :: * -> *) a b.
Traversable f =>
Cayley f p a b -> Cayley f p (f a) (f b)
traverse' = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley

instance (Functor f, Mapping p) => Mapping (Cayley f p) where
  map' :: forall (f :: * -> *) a b.
Functor f =>
Cayley f p a b -> Cayley f p (f a) (f b)
map' = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley

instance (Applicative f, Category p) => Category (Cayley f p) where
  id :: forall (a :: k). Cayley f p a a
id = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Cayley f (p b c)
fpbc . :: forall (b :: k) (c :: k) (a :: k).
Cayley f p b c -> Cayley f p a b -> Cayley f p a c
. Cayley f (p a b)
fpab = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) f (p b c)
fpbc f (p a b)
fpab

instance (Applicative f, Arrow p) => Arrow (Cayley f p) where
  arr :: forall b c. (b -> c) -> Cayley f p b c
arr b -> c
f = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f
  first :: forall b c d. Cayley f p b c -> Cayley f p (b, d) (c, d)
first = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  second :: forall b c d. Cayley f p b c -> Cayley f p (d, b) (d, c)
second = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  Cayley f (p b c)
ab *** :: forall b c b' c'.
Cayley f p b c -> Cayley f p b' c' -> Cayley f p (b, b') (c, c')
*** Cayley f (p b' c')
cd = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) f (p b c)
ab f (p b' c')
cd
  Cayley f (p b c)
ab &&& :: forall b c c'.
Cayley f p b c -> Cayley f p b c' -> Cayley f p b (c, c')
&&& Cayley f (p b c')
ac = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) f (p b c)
ab f (p b c')
ac

instance (Applicative f, ArrowChoice p) => ArrowChoice (Cayley f p) where
  left :: forall b c d.
Cayley f p b c -> Cayley f p (Either b d) (Either c d)
left  = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  right :: forall b c d.
Cayley f p b c -> Cayley f p (Either d b) (Either d c)
right = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  Cayley f (p b c)
ab +++ :: forall b c b' c'.
Cayley f p b c
-> Cayley f p b' c' -> Cayley f p (Either b b') (Either c c')
+++ Cayley f (p b' c')
cd = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
(+++) f (p b c)
ab f (p b' c')
cd
  Cayley f (p b d)
ac ||| :: forall b d c.
Cayley f p b d -> Cayley f p c d -> Cayley f p (Either b c) d
||| Cayley f (p c d)
bc = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
(|||) f (p b d)
ac f (p c d)
bc

instance (Applicative f, ArrowLoop p) => ArrowLoop (Cayley f p) where
  loop :: forall b d c. Cayley f p (b, d) (c, d) -> Cayley f p b c
loop = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Cayley f p a b -> f (p a b)
runCayley

instance (Applicative f, ArrowZero p) => ArrowZero (Cayley f p) where
  zeroArrow :: forall b c. Cayley f p b c
zeroArrow = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow

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

mapCayley :: (forall a. f a -> g a) -> Cayley f p x y -> Cayley g p x y
mapCayley :: forall {k} {k} {k} (f :: k -> *) (g :: k -> *) (p :: k -> k -> k)
       (x :: k) (y :: k).
(forall (a :: k). f a -> g a) -> Cayley f p x y -> Cayley g p x y
mapCayley forall (a :: k). f a -> g a
f (Cayley f (p x y)
g) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Cayley f p a b
Cayley (forall (a :: k). f a -> g a
f f (p x y)
g)

-- instance Adjunction f g => ProfunctorAdjunction (Cayley f) (Cayley g) where

{-
newtype Uncayley p a = Uncayley (p () a)

instance Profunctor p => Functor (Uncayley p) where
  fmap f (Uncayley p) = Uncayley (rmap f p)

smash :: Strong p => Cayley (Uncayley p) (->) a b -> p a b
smash (Cayley (Uncayley pab)) = dimap ((,)()) (uncurry id) (first' pab)

unsmash :: Closed p => p a b -> Cayley (Uncayley p) (->) a b
unsmash = Cayley . Uncayley . curry' . lmap snd

type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)

-- pastro and street's strong tambara module
class (Strong p, Closed p) => Stronger p

-- only a true iso for Stronger p and q, no?
_Smash :: (Strong p, Closed q) => Iso
  (Cayley (Uncayley p) (->) a b)
  (Cayley (Uncayley q) (->) c d)
  (p a b)
  (q c d)
_Smash = dimap hither (fmap yon) where
  hither (Cayley (Uncayley pab)) = dimap ((,)()) (uncurry id) (first' pab)
  yon = Cayley . Uncayley . curry' . lmap snd

fsmash :: (forall x y. p x y -> q x y) -> Cayley (Uncayley p) (->) a b -> Cayley (Uncayley q) (->) a b
fsmash f (Cayley (Uncayley puab)) = Cayley (Uncayley (f puab))

-- | proposition 4.3 from pastro and street is that fsmash and funsmash form an equivalence of categories
funsmash :: (Closed p, Strong q) => (forall x y. Cayley (Uncayley p) (->) x y -> Cayley (Uncayley q) (->) x y) -> p a b -> q a b
funsmash k = smash . k . unsmash
-}