{-# 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 { Cayley f p a b -> f (p a b)
runCayley :: f (p a b) }

instance Functor f => ProfunctorFunctor (Cayley f) where
  promap :: (p :-> q) -> Cayley f p :-> Cayley f q
promap p :-> q
f (Cayley f (p a b)
p) = f (q a b) -> Cayley f q a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Cayley f p a b
Cayley ((p a b -> q a b) -> f (p a b) -> f (q a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> q a b
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 :: p :-> Cayley f p
proreturn = f (p a b) -> Cayley f p a b
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) -> Cayley f p a b)
-> (p a b -> f (p a b)) -> p a b -> Cayley f p a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p a b -> f (p a b)
forall (m :: * -> *) a. Monad m => a -> m a
return
  projoin :: Cayley f (Cayley f p) :-> Cayley f p
projoin (Cayley f (Cayley f p a b)
m) = f (p a b) -> Cayley f p a b
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) -> Cayley f p a b) -> f (p a b) -> Cayley f p a b
forall a b. (a -> b) -> a -> b
$ f (Cayley f p a b)
m f (Cayley f p a b) -> (Cayley f p a b -> f (p a b)) -> f (p a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k 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 :: Cayley f p :-> p
proextract = f (p a b) -> p a b
forall (w :: * -> *) a. Comonad w => w a -> a
extract (f (p a b) -> p a b)
-> (Cayley f p a b -> f (p a b)) -> Cayley f p a b -> p a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  produplicate :: Cayley f p :-> Cayley f (Cayley f p)
produplicate (Cayley f (p a b)
w) = f (Cayley f p a b) -> Cayley f (Cayley f p) a b
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 (Cayley f p a b) -> Cayley f (Cayley f p) a b)
-> f (Cayley f p a b) -> Cayley f (Cayley f p) a b
forall a b. (a -> b) -> a -> b
$ (f (p a b) -> Cayley f p a b) -> f (p a b) -> f (Cayley f p a b)
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend f (p a b) -> Cayley f p a b
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 :: (a -> b) -> (c -> d) -> Cayley f p b c -> Cayley f p a d
dimap a -> b
f c -> d
g = f (p a d) -> Cayley f p a d
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 d) -> Cayley f p a d)
-> (Cayley f p b c -> f (p a d))
-> Cayley f p b c
-> Cayley f p a d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p b c -> p a d) -> f (p b c) -> f (p a d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (c -> d) -> p b c -> p a d
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) (f (p b c) -> f (p a d))
-> (Cayley f p b c -> f (p b c)) -> Cayley f p b c -> f (p a d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p b c -> f (p b c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  lmap :: (a -> b) -> Cayley f p b c -> Cayley f p a c
lmap a -> b
f = f (p a c) -> Cayley f p a c
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 c) -> Cayley f p a c)
-> (Cayley f p b c -> f (p a c))
-> Cayley f p b c
-> Cayley f p a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p b c -> p a c) -> f (p b c) -> f (p a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f) (f (p b c) -> f (p a c))
-> (Cayley f p b c -> f (p b c)) -> Cayley f p b c -> f (p a c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p b c -> f (p b c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  rmap :: (b -> c) -> Cayley f p a b -> Cayley f p a c
rmap b -> c
g = f (p a c) -> Cayley f p a c
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 c) -> Cayley f p a c)
-> (Cayley f p a b -> f (p a c))
-> Cayley f p a b
-> Cayley f p a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p a c) -> f (p a b) -> f (p a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap b -> c
g) (f (p a b) -> f (p a c))
-> (Cayley f p a b -> f (p a b)) -> Cayley f p a b -> f (p a c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  q b c
w #. :: q b c -> Cayley f p a b -> Cayley f p a c
#. Cayley f (p a b)
fp = f (p a c) -> Cayley f p a c
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 c) -> Cayley f p a c) -> f (p a c) -> Cayley f p a c
forall a b. (a -> b) -> a -> b
$ (p a b -> p a c) -> f (p a b) -> f (p a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (q b c
w q b c -> p a b -> p a c
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 .# :: Cayley f p b c -> q a b -> Cayley f p a c
.# q a b
w = f (p a c) -> Cayley f p a c
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 c) -> Cayley f p a c) -> f (p a c) -> Cayley f p a c
forall a b. (a -> b) -> a -> b
$ (p b c -> p a c) -> f (p b c) -> f (p a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (p b c -> q a b -> p a c
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' :: Cayley f p a b -> Cayley f p (a, c) (b, c)
first'  = f (p (a, c) (b, c)) -> Cayley f p (a, c) (b, c)
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, c) (b, c)) -> Cayley f p (a, c) (b, c))
-> (Cayley f p a b -> f (p (a, c) (b, c)))
-> Cayley f p a b
-> Cayley f p (a, c) (b, c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p (a, c) (b, c)) -> f (p a b) -> f (p (a, c) (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (a, c) (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' (f (p a b) -> f (p (a, c) (b, c)))
-> (Cayley f p a b -> f (p a b))
-> Cayley f p a b
-> f (p (a, c) (b, c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  second' :: Cayley f p a b -> Cayley f p (c, a) (c, b)
second' = f (p (c, a) (c, b)) -> Cayley f p (c, a) (c, b)
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 (c, a) (c, b)) -> Cayley f p (c, a) (c, b))
-> (Cayley f p a b -> f (p (c, a) (c, b)))
-> Cayley f p a b
-> Cayley f p (c, a) (c, b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p (c, a) (c, b)) -> f (p a b) -> f (p (c, a) (c, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (c, a) (c, b)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second' (f (p a b) -> f (p (c, a) (c, b)))
-> (Cayley f p a b -> f (p a b))
-> Cayley f p a b
-> f (p (c, a) (c, b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k 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 :: Cayley f p (a, d) (b, d) -> Cayley f p a b
unfirst (Cayley f (p (a, d) (b, d))
fp) = f (p a b) -> Cayley f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Cayley f p a b
Cayley ((p (a, d) (b, d) -> p a b) -> f (p (a, d) (b, d)) -> f (p a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p (a, d) (b, d) -> p a b
forall (p :: * -> * -> *) a d b.
Costrong p =>
p (a, d) (b, d) -> p a b
unfirst f (p (a, d) (b, d))
fp)
  unsecond :: Cayley f p (d, a) (d, b) -> Cayley f p a b
unsecond (Cayley f (p (d, a) (d, b))
fp) = f (p a b) -> Cayley f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Cayley f p a b
Cayley ((p (d, a) (d, b) -> p a b) -> f (p (d, a) (d, b)) -> f (p a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p (d, a) (d, b) -> p a b
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' :: Cayley f p a b -> Cayley f p (Either a c) (Either b c)
left'   = f (p (Either a c) (Either b c))
-> Cayley f p (Either a c) (Either b c)
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 (Either a c) (Either b c))
 -> Cayley f p (Either a c) (Either b c))
-> (Cayley f p a b -> f (p (Either a c) (Either b c)))
-> Cayley f p a b
-> Cayley f p (Either a c) (Either b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p (Either a c) (Either b c))
-> f (p a b) -> f (p (Either a c) (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (Either a c) (Either b c)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left' (f (p a b) -> f (p (Either a c) (Either b c)))
-> (Cayley f p a b -> f (p a b))
-> Cayley f p a b
-> f (p (Either a c) (Either b c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  right' :: Cayley f p a b -> Cayley f p (Either c a) (Either c b)
right'  = f (p (Either c a) (Either c b))
-> Cayley f p (Either c a) (Either c b)
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 (Either c a) (Either c b))
 -> Cayley f p (Either c a) (Either c b))
-> (Cayley f p a b -> f (p (Either c a) (Either c b)))
-> Cayley f p a b
-> Cayley f p (Either c a) (Either c b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p (Either c a) (Either c b))
-> f (p a b) -> f (p (Either c a) (Either c b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (Either c a) (Either c b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' (f (p a b) -> f (p (Either c a) (Either c b)))
-> (Cayley f p a b -> f (p a b))
-> Cayley f p a b
-> f (p (Either c a) (Either c b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k 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 :: 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) = f (p a b) -> Cayley f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Cayley f p a b
Cayley ((p (Either a d) (Either b d) -> p a b)
-> f (p (Either a d) (Either b d)) -> f (p a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p (Either a d) (Either b d) -> p a b
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 :: 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) = f (p a b) -> Cayley f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Cayley f p a b
Cayley ((p (Either d a) (Either d b) -> p a b)
-> f (p (Either d a) (Either d b)) -> f (p a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p (Either d a) (Either d b) -> p a b
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 :: Cayley f p a b -> Cayley f p (x -> a) (x -> b)
closed = f (p (x -> a) (x -> b)) -> Cayley f p (x -> a) (x -> b)
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 (x -> a) (x -> b)) -> Cayley f p (x -> a) (x -> b))
-> (Cayley f p a b -> f (p (x -> a) (x -> b)))
-> Cayley f p a b
-> Cayley f p (x -> a) (x -> b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p (x -> a) (x -> b))
-> f (p a b) -> f (p (x -> a) (x -> b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (x -> a) (x -> b)
forall (p :: * -> * -> *) a b x.
Closed p =>
p a b -> p (x -> a) (x -> b)
closed (f (p a b) -> f (p (x -> a) (x -> b)))
-> (Cayley f p a b -> f (p a b))
-> Cayley f p a b
-> f (p (x -> a) (x -> b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k 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' :: Cayley f p a b -> Cayley f p (f a) (f b)
traverse' = f (p (f a) (f b)) -> Cayley f p (f a) (f b)
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 (f a) (f b)) -> Cayley f p (f a) (f b))
-> (Cayley f p a b -> f (p (f a) (f b)))
-> Cayley f p a b
-> Cayley f p (f a) (f b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p (f a) (f b)) -> f (p a b) -> f (p (f a) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (f a) (f b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse' (f (p a b) -> f (p (f a) (f b)))
-> (Cayley f p a b -> f (p a b))
-> Cayley f p a b
-> f (p (f a) (f b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k 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' :: Cayley f p a b -> Cayley f p (f a) (f b)
map' = f (p (f a) (f b)) -> Cayley f p (f a) (f b)
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 (f a) (f b)) -> Cayley f p (f a) (f b))
-> (Cayley f p a b -> f (p (f a) (f b)))
-> Cayley f p a b
-> Cayley f p (f a) (f b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p (f a) (f b)) -> f (p a b) -> f (p (f a) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (f a) (f b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map' (f (p a b) -> f (p (f a) (f b)))
-> (Cayley f p a b -> f (p a b))
-> Cayley f p a b
-> f (p (f a) (f b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p a b -> f (p a b)
forall k (f :: k -> *) k 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 :: Cayley f p a a
id = f (p a a) -> Cayley f p a a
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 a) -> Cayley f p a a) -> f (p a a) -> Cayley f p a a
forall a b. (a -> b) -> a -> b
$ p a a -> f (p a a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure p a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Cayley f (p b c)
fpbc . :: Cayley f p b c -> Cayley f p a b -> Cayley f p a c
. Cayley f (p a b)
fpab = f (p a c) -> Cayley f p a c
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 c) -> Cayley f p a c) -> f (p a c) -> Cayley f p a c
forall a b. (a -> b) -> a -> b
$ (p b c -> p a b -> p a c) -> f (p b c) -> f (p a b) -> f (p a c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p a b -> p a c
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 :: (b -> c) -> Cayley f p b c
arr b -> c
f = f (p b c) -> Cayley f p b c
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 b c) -> Cayley f p b c) -> f (p b c) -> Cayley f p b c
forall a b. (a -> b) -> a -> b
$ p b c -> f (p b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (p b c -> f (p b c)) -> p b c -> f (p b c)
forall a b. (a -> b) -> a -> b
$ (b -> c) -> p b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f
  first :: Cayley f p b c -> Cayley f p (b, d) (c, d)
first = f (p (b, d) (c, d)) -> Cayley f p (b, d) (c, d)
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 (b, d) (c, d)) -> Cayley f p (b, d) (c, d))
-> (Cayley f p b c -> f (p (b, d) (c, d)))
-> Cayley f p b c
-> Cayley f p (b, d) (c, d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p b c -> p (b, d) (c, d)) -> f (p b c) -> f (p (b, d) (c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p b c -> p (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (f (p b c) -> f (p (b, d) (c, d)))
-> (Cayley f p b c -> f (p b c))
-> Cayley f p b c
-> f (p (b, d) (c, d))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p b c -> f (p b c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  second :: Cayley f p b c -> Cayley f p (d, b) (d, c)
second = f (p (d, b) (d, c)) -> Cayley f p (d, b) (d, c)
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 (d, b) (d, c)) -> Cayley f p (d, b) (d, c))
-> (Cayley f p b c -> f (p (d, b) (d, c)))
-> Cayley f p b c
-> Cayley f p (d, b) (d, c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p b c -> p (d, b) (d, c)) -> f (p b c) -> f (p (d, b) (d, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p b c -> p (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (f (p b c) -> f (p (d, b) (d, c)))
-> (Cayley f p b c -> f (p b c))
-> Cayley f p b c
-> f (p (d, b) (d, c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p b c -> f (p b c)
forall k (f :: k -> *) k 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 *** :: Cayley f p b c -> Cayley f p b' c' -> Cayley f p (b, b') (c, c')
*** Cayley f (p b' c')
cd = f (p (b, b') (c, c')) -> Cayley f p (b, b') (c, c')
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 (b, b') (c, c')) -> Cayley f p (b, b') (c, c'))
-> f (p (b, b') (c, c')) -> Cayley f p (b, b') (c, c')
forall a b. (a -> b) -> a -> b
$ (p b c -> p b' c' -> p (b, b') (c, c'))
-> f (p b c) -> f (p b' c') -> f (p (b, b') (c, c'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p b' c' -> p (b, b') (c, c')
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 &&& :: Cayley f p b c -> Cayley f p b c' -> Cayley f p b (c, c')
&&& Cayley f (p b c')
ac = f (p b (c, c')) -> Cayley f p b (c, c')
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 b (c, c')) -> Cayley f p b (c, c'))
-> f (p b (c, c')) -> Cayley f p b (c, c')
forall a b. (a -> b) -> a -> b
$ (p b c -> p b c' -> p b (c, c'))
-> f (p b c) -> f (p b c') -> f (p b (c, c'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p b c' -> p b (c, c')
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 :: Cayley f p b c -> Cayley f p (Either b d) (Either c d)
left  = f (p (Either b d) (Either c d))
-> Cayley f p (Either b d) (Either c d)
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 (Either b d) (Either c d))
 -> Cayley f p (Either b d) (Either c d))
-> (Cayley f p b c -> f (p (Either b d) (Either c d)))
-> Cayley f p b c
-> Cayley f p (Either b d) (Either c d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p b c -> p (Either b d) (Either c d))
-> f (p b c) -> f (p (Either b d) (Either c d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p b c -> p (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (f (p b c) -> f (p (Either b d) (Either c d)))
-> (Cayley f p b c -> f (p b c))
-> Cayley f p b c
-> f (p (Either b d) (Either c d))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p b c -> f (p b c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Cayley f p a b -> f (p a b)
runCayley
  right :: Cayley f p b c -> Cayley f p (Either d b) (Either d c)
right = f (p (Either d b) (Either d c))
-> Cayley f p (Either d b) (Either d c)
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 (Either d b) (Either d c))
 -> Cayley f p (Either d b) (Either d c))
-> (Cayley f p b c -> f (p (Either d b) (Either d c)))
-> Cayley f p b c
-> Cayley f p (Either d b) (Either d c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p b c -> p (Either d b) (Either d c))
-> f (p b c) -> f (p (Either d b) (Either d c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p b c -> p (Either d b) (Either d c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right (f (p b c) -> f (p (Either d b) (Either d c)))
-> (Cayley f p b c -> f (p b c))
-> Cayley f p b c
-> f (p (Either d b) (Either d c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p b c -> f (p b c)
forall k (f :: k -> *) k 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 +++ :: 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 = f (p (Either b b') (Either c c'))
-> Cayley f p (Either b b') (Either c c')
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 (Either b b') (Either c c'))
 -> Cayley f p (Either b b') (Either c c'))
-> f (p (Either b b') (Either c c'))
-> Cayley f p (Either b b') (Either c c')
forall a b. (a -> b) -> a -> b
$ (p b c -> p b' c' -> p (Either b b') (Either c c'))
-> f (p b c) -> f (p b' c') -> f (p (Either b b') (Either c c'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p b' c' -> p (Either b b') (Either c c')
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 ||| :: Cayley f p b d -> Cayley f p c d -> Cayley f p (Either b c) d
||| Cayley f (p c d)
bc = f (p (Either b c) d) -> Cayley f p (Either b c) d
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 (Either b c) d) -> Cayley f p (Either b c) d)
-> f (p (Either b c) d) -> Cayley f p (Either b c) d
forall a b. (a -> b) -> a -> b
$ (p b d -> p c d -> p (Either b c) d)
-> f (p b d) -> f (p c d) -> f (p (Either b c) d)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b d -> p c d -> p (Either b c) d
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 :: Cayley f p (b, d) (c, d) -> Cayley f p b c
loop = f (p b c) -> Cayley f p b c
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 b c) -> Cayley f p b c)
-> (Cayley f p (b, d) (c, d) -> f (p b c))
-> Cayley f p (b, d) (c, d)
-> Cayley f p b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p (b, d) (c, d) -> p b c) -> f (p (b, d) (c, d)) -> f (p b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p (b, d) (c, d) -> p b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (f (p (b, d) (c, d)) -> f (p b c))
-> (Cayley f p (b, d) (c, d) -> f (p (b, d) (c, d)))
-> Cayley f p (b, d) (c, d)
-> f (p b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cayley f p (b, d) (c, d) -> f (p (b, d) (c, d))
forall k (f :: k -> *) k 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 :: Cayley f p b c
zeroArrow = f (p b c) -> Cayley f p b c
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 b c) -> Cayley f p b c) -> f (p b c) -> Cayley f p b c
forall a b. (a -> b) -> a -> b
$ p b c -> f (p b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure p b c
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 <+> :: Cayley f p b c -> Cayley f p b c -> Cayley f p b c
<+> Cayley f (p b c)
g = f (p b c) -> Cayley f p b c
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Cayley f p a b
Cayley ((p b c -> p b c -> p b c) -> f (p b c) -> f (p b c) -> f (p b c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p b c -> p b c
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 (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) = g (p x y) -> Cayley g p x y
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 x y) -> g (p x y)
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
-}