diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,14 @@
+4.1
+---
+* Flipped the order of 'Procompose'
+* Added the notion of Monads and Comonads on the category of profunctors.
+* Added 'Cayley' which takes normal Haskell Monads and Comonads to a 'ProfunctorMonad' and 'ProfunctorComonad' respectively. Cayley is also known as the 'static arrow' construction
+* Added 'Closed' which is adjoint to 'Strong'.
+* Added 'Closure' which freely adjoins 'Closed' to any 'Profunctor'.
+* Added 'Tambara' which freely adjoins 'Strong' to any 'Profunctor'.
+* Added 'Cotambara' which freely adjoins 'Choice' to any 'Profunctor'.
+* Under the new 'Procompose' the old 'Rift' is now 'Ran', and the old 'Lift' was misnamed. It is now 'Rift'
+
 4.0.3
 -----
 * Added `Data.Profunctor.Lift` containing the left Kan lift of a profunctor.
diff --git a/profunctors.cabal b/profunctors.cabal
--- a/profunctors.cabal
+++ b/profunctors.cabal
@@ -1,6 +1,6 @@
 name:          profunctors
 category:      Control, Categories
-version:       4.0.4
+version:       4.1
 license:       BSD3
 cabal-version: >= 1.10
 license-file:  LICENSE
@@ -29,17 +29,23 @@
   build-depends:
     base                >= 4     && < 5,
     comonad             >= 4     && < 5,
+    distributive        >= 0.4.4 && < 1,
     semigroupoids       >= 4     && < 5,
     tagged              >= 0.4.4 && < 1,
     transformers        >= 0.2   && < 0.5
 
   exposed-modules:
     Data.Profunctor
+    Data.Profunctor.Adjunction
+    Data.Profunctor.Cayley
+    Data.Profunctor.Closed
+    Data.Profunctor.Codensity
     Data.Profunctor.Composition
     Data.Profunctor.Collage
-    Data.Profunctor.Lift
+    Data.Profunctor.Monad
+    Data.Profunctor.Ran
     Data.Profunctor.Rep
-    Data.Profunctor.Rift
+    Data.Profunctor.Tambara
     Data.Profunctor.Trace
     Data.Profunctor.Unsafe
 
diff --git a/src/Data/Profunctor.hs b/src/Data/Profunctor.hs
--- a/src/Data/Profunctor.hs
+++ b/src/Data/Profunctor.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE RankNTypes #-}
 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
@@ -31,6 +33,9 @@
   , DownStar(..)
   , WrappedArrow(..)
   , Forget(..)
+#ifndef HLINT
+  , type (-/->)
+#endif
   ) where
 
 import Control.Applicative hiding (WrappedArrow(..))
@@ -45,6 +50,8 @@
 import Data.Profunctor.Unsafe
 import Prelude hiding (id,(.),sequence)
 import Unsafe.Coerce
+
+type p -/-> q = forall a b. p a b -> q a b
 
 ------------------------------------------------------------------------------
 -- UpStar
diff --git a/src/Data/Profunctor/Adjunction.hs b/src/Data/Profunctor/Adjunction.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Adjunction.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE RankNTypes #-}
+module Data.Profunctor.Adjunction where
+
+import Data.Profunctor
+
+class f -| u | f -> u, u -> f where
+  unit   :: Profunctor p => p -/-> u (f p)
+  counit :: Profunctor p => f (u p) -/-> p
diff --git a/src/Data/Profunctor/Cayley.hs b/src/Data/Profunctor/Cayley.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Cayley.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE CPP #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) 2014 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.Unsafe
+import Prelude hiding ((.), id)
+
+-- static arrows
+newtype Cayley f p a b = Cayley { runCayley :: f (p a b) }
+
+-- | Cayley transforms Monads in @Hask@ into monads on @Prof@
+instance Monad f => ProfunctorMonad (Cayley f) where
+  proreturn = Cayley . return
+  projoin (Cayley m) = Cayley $ m >>= runCayley
+
+-- | Cayley transforms Comonads in @Hask@ into comonads on @Prof@
+instance Comonad f => ProfunctorComonad (Cayley f) where
+  proextract = extract . runCayley
+  produplicate (Cayley w) = Cayley $ extend Cayley w
+
+instance (Functor f, Profunctor p) => Profunctor (Cayley f p) where
+  dimap f g = Cayley . fmap (dimap f g) . runCayley
+  lmap f = Cayley . fmap (lmap f) . runCayley
+  rmap g = Cayley . fmap (rmap g) . runCayley
+  w #. Cayley fp = Cayley $ fmap (w #.) fp
+  Cayley fp .# w = Cayley $ fmap (.# w) fp
+
+instance (Functor f, Strong p) => Strong (Cayley f p) where
+  first'  = Cayley . fmap first' . runCayley
+  second' = Cayley . fmap second' . runCayley
+
+instance (Functor f, Choice p) => Choice (Cayley f p) where
+  left'   = Cayley . fmap left' . runCayley
+  right'  = Cayley . fmap right' . runCayley
+
+instance (Applicative f, Category p) => Category (Cayley f p) where
+  id = Cayley $ pure id
+  Cayley fpbc . Cayley fpab = Cayley $ liftA2 (.) fpbc fpab
+
+instance (Applicative f, Arrow p) => Arrow (Cayley f p) where
+  arr f = Cayley $ pure $ arr f
+  first = Cayley . fmap first . runCayley
+  second = Cayley . fmap second . runCayley
+  Cayley ab *** Cayley cd = Cayley $ liftA2 (***) ab cd
+  Cayley ab &&& Cayley ac = Cayley $ liftA2 (&&&) ab ac
+
+instance (Applicative f, ArrowChoice p) => ArrowChoice (Cayley f p) where
+  left  = Cayley . fmap left . runCayley
+  right = Cayley . fmap right . runCayley
+  Cayley ab +++ Cayley cd = Cayley $ liftA2 (+++) ab cd
+  Cayley ac ||| Cayley bc = Cayley $ liftA2 (|||) ac bc
+  
+instance (Applicative f, ArrowLoop p) => ArrowLoop (Cayley f p) where
+  loop = Cayley . fmap loop . runCayley
+
+instance (Applicative f, ArrowZero p) => ArrowZero (Cayley f p) where
+  zeroArrow = Cayley $ pure zeroArrow
+
+instance (Applicative f, ArrowPlus p) => ArrowPlus (Cayley f p) where
+  Cayley f <+> Cayley g = Cayley (liftA2 (<+>) f g)
diff --git a/src/Data/Profunctor/Closed.hs b/src/Data/Profunctor/Closed.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Closed.hs
@@ -0,0 +1,165 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+module Data.Profunctor.Closed
+  ( Closed(..)
+  , Closure(..)
+  , close
+  , unclose
+  , Environment(..)
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Category
+import Control.Comonad
+import Data.Distributive
+import Data.Monoid
+import Data.Profunctor
+import Data.Profunctor.Adjunction
+import Data.Profunctor.Monad
+import Data.Profunctor.Unsafe
+import Data.Tagged
+import Prelude hiding ((.),id)
+
+--------------------------------------------------------------------------------
+-- * Closed
+--------------------------------------------------------------------------------
+
+-- | A strong profunctor allows the monoidal structure to pass through.
+--
+-- A closed profunctor allows the closed structure to pass through.
+class Profunctor p => Closed p where
+  closed :: p a b -> p (x -> a) (x -> b)
+
+instance Closed Tagged where
+  closed (Tagged b) = Tagged (const b)
+
+instance Closed (->) where
+  closed = (.)
+
+instance Functor f => Closed (DownStar f) where
+  closed (DownStar fab) = DownStar $ \fxa x -> fab (fmap ($x) fxa)
+
+instance Functor f => Closed (Cokleisli f) where
+  closed (Cokleisli fab) = Cokleisli $ \fxa x -> fab (fmap ($x) fxa)
+
+instance Distributive f => Closed (UpStar f) where
+  closed (UpStar afb) = UpStar $ \xa -> distribute $ \x -> afb (xa x)
+
+instance (Distributive f, Monad f) => Closed (Kleisli f) where
+  closed (Kleisli afb) = Kleisli $ \xa -> distribute $ \x -> afb (xa x)
+
+instance Monoid r => Closed (Forget r) where
+  closed _ = Forget $ \_ -> mempty
+
+--------------------------------------------------------------------------------
+-- * Closure
+--------------------------------------------------------------------------------
+
+-- | 'Closure' adjoins a 'Closed' structure to any 'Profunctor'.
+--
+-- Analogous to 'Data.Profunctor.Tambara.Tambara' for 'Closed'.
+
+newtype Closure p a b = Closure { runClosure :: forall x. p (x -> a) (x -> b) }
+
+instance Profunctor p => Profunctor (Closure p) where
+  dimap f g (Closure p) = Closure $ dimap (fmap f) (fmap g) p
+  lmap f (Closure p) = Closure $ lmap (fmap f) p
+  rmap f (Closure p) = Closure $ rmap (fmap f) p
+  w #. Closure p = Closure $ fmap w #. p
+  Closure p .# w = Closure $ p .# fmap w
+
+instance ProfunctorComonad Closure where
+  proextract = dimap const ($ ()) . runClosure
+  produplicate (Closure p) = Closure $ Closure $ dimap uncurry curry p
+
+instance Profunctor p => Closed (Closure p) where
+  closed = runClosure . produplicate
+
+instance Strong p => Strong (Closure p) where
+  first' (Closure p) = Closure $ dimap hither yon $ first' p
+
+instance Category p => Category (Closure p) where
+  id = Closure id
+  Closure p . Closure q = Closure (p . q)
+
+hither :: (s -> (a,b)) -> (s -> a, s -> b)
+hither h = (fst . h, snd . h)
+
+yon :: (s -> a, s -> b) -> s -> (a,b)
+yon h s = (fst h s, snd h s)
+
+instance Arrow p => Arrow (Closure p) where
+  arr f = Closure (arr (f .))
+  first (Closure f) = Closure $ arr yon . first f . arr hither
+
+instance ArrowLoop p => ArrowLoop (Closure p) where
+  loop (Closure f) = Closure $ loop (arr hither . f . arr yon)
+
+instance ArrowZero p => ArrowZero (Closure p) where
+  zeroArrow = Closure zeroArrow
+
+instance ArrowPlus p => ArrowPlus (Closure p) where
+  Closure f <+> Closure g = Closure (f <+> g)
+
+instance Profunctor p => Functor (Closure p a) where
+  fmap = rmap
+
+instance (Profunctor p, Arrow p) => Applicative (Closure p a) where
+  pure x = arr (const x)
+  f <*> g = arr (uncurry id) . (f &&& g)
+
+instance (Profunctor p, ArrowPlus p) => Alternative (Closure p a) where
+  empty = zeroArrow
+  f <|> g = f <+> g
+
+instance (Profunctor p, Arrow p, Monoid b) => Monoid (Closure p a b) where
+  mempty = pure mempty
+  mappend = liftA2 mappend
+
+-- |
+-- @
+-- 'close' '.' 'unclose' ≡ 'id'
+-- 'unclose' '.' 'close' ≡ 'id'
+-- @
+close :: Closed p => (p -/-> q) -> p -/-> Closure q
+close f p = Closure $ f $ closed p
+
+-- |
+-- @
+-- 'close' '.' 'unclose' ≡ 'id'
+-- 'unclose' '.' 'close' ≡ 'id'
+-- @
+unclose :: Profunctor q => (p -/-> Closure q) -> p -/-> q
+unclose f p = dimap const ($ ()) $ runClosure $ f p
+
+--------------------------------------------------------------------------------
+-- * Environment
+--------------------------------------------------------------------------------
+
+data Environment p a b where
+  Environment :: ((z -> y) -> b) -> p x y -> (a -> z -> x) -> Environment p a b
+
+instance Profunctor p => Profunctor (Environment p) where
+  dimap f g (Environment l m r) = Environment (g . l) m (r . f)
+  lmap f (Environment l m r) = Environment l m (r . f)
+  rmap g (Environment l m r) = Environment (g . l) m r
+  w #. Environment l m r = Environment (w #. l) m r
+  Environment l m r .# w = Environment l m (r .# w)
+
+instance ProfunctorMonad Environment where
+  proreturn p = Environment ($ ()) p const
+  projoin (Environment l (Environment m n o) p) = Environment (lm . curry) n op where
+    op a (b, c) = o (p a b) c
+    lm zr = l (m.zr)
+
+instance Environment -| Closure where
+  counit (Environment g (Closure p) f) = dimap f g p
+  unit p = Closure (Environment id p id)
diff --git a/src/Data/Profunctor/Codensity.hs b/src/Data/Profunctor/Codensity.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Codensity.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) 2014 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  Rank2Types, TFs
+--
+----------------------------------------------------------------------------
+module Data.Profunctor.Codensity
+  ( Codensity(..)
+  , decomposeCodensity
+  ) where
+
+import Control.Category
+import Data.Profunctor.Unsafe
+import Data.Profunctor.Composition
+import Prelude hiding (id,(.))
+
+-- | This represents the right Kan extension of a 'Profunctor' @p@ along itself. This provides a generalization of the \"difference list\" trick to profunctors.
+newtype Codensity p a b = Codensity { runCodensity :: forall x. p x a -> p x b }
+
+instance Profunctor p => Profunctor (Codensity p) where
+  dimap ca bd f = Codensity (rmap bd . runCodensity f . rmap ca)
+  {-# INLINE dimap #-}
+  lmap ca f = Codensity (runCodensity f . rmap ca)
+  {-# INLINE lmap #-}
+  rmap bd f = Codensity (rmap bd . runCodensity f)
+  {-# INLINE rmap #-}
+  bd #. f = Codensity (\p -> bd #. runCodensity f p)
+  {-# INLINE ( #. ) #-}
+  f .# ca = Codensity (\p -> runCodensity f (ca #. p))
+  {-# INLINE (.#) #-}
+
+instance Profunctor p => Functor (Codensity p a) where
+  fmap bd f = Codensity (rmap bd . runCodensity f)
+  {-# INLINE fmap #-}
+
+instance Category (Codensity p) where
+  id = Codensity id
+  {-# INLINE id #-}
+  Codensity f . Codensity g = Codensity (f . g)
+  {-# INLINE (.) #-}
+
+decomposeCodensity :: Procompose (Codensity p) p a b -> p a b
+decomposeCodensity (Procompose (Codensity pp) p) = pp p
+{-# INLINE decomposeCodensity #-}
diff --git a/src/Data/Profunctor/Composition.hs b/src/Data/Profunctor/Composition.hs
--- a/src/Data/Profunctor/Composition.hs
+++ b/src/Data/Profunctor/Composition.hs
@@ -2,18 +2,20 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Profunctor.Composition
--- Copyright   :  (C) 2011-2012 Edward Kmett
+-- Copyright   :  (C) 2014 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  GADTs
+-- Stability   :  experimental
+-- Portability :  GADTs, TFs, MPTCs, RankN
 --
 ----------------------------------------------------------------------------
 module Data.Profunctor.Composition
@@ -21,13 +23,16 @@
   -- * Profunctor Composition
     Procompose(..)
   , procomposed
-  -- * Bicategorical Associators
+  -- * Unitors and Associator
   , idl
   , idr
   , assoc
   -- * Generalized Composition
   , upstars, kleislis
   , downstars, cokleislis
+  -- * Right Kan Lift
+  , Rift(..)
+  , decomposeRift
   ) where
 
 import Control.Arrow
@@ -36,6 +41,9 @@
 import Control.Monad (liftM)
 import Data.Functor.Compose
 import Data.Profunctor
+import Data.Profunctor.Adjunction
+import Data.Profunctor.Closed
+import Data.Profunctor.Monad
 import Data.Profunctor.Rep
 import Data.Profunctor.Unsafe
 import Prelude hiding ((.),id)
@@ -52,43 +60,46 @@
 --
 -- <http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html>
 data Procompose p q d c where
-  Procompose :: p d a -> q a c -> Procompose p q d c
+  Procompose :: p x c -> q d x -> Procompose p q d c
 
+instance Category p => ProfunctorMonad (Procompose p) where
+  proreturn = Procompose id
+  projoin (Procompose p (Procompose q r)) = Procompose (p . q) r
+
 procomposed :: Category p => Procompose p p a b -> p a b
-procomposed (Procompose pda pac) = pac . pda
+procomposed (Procompose pxc pdx) = pxc . pdx
 {-# INLINE procomposed #-}
 
-
 instance (Profunctor p, Profunctor q) => Profunctor (Procompose p q) where
-  dimap l r (Procompose f g) = Procompose (lmap l f) (rmap r g)
+  dimap l r (Procompose f g) = Procompose (rmap r f) (lmap l g)
   {-# INLINE dimap #-}
-  lmap k (Procompose f g) = Procompose (lmap k f) g
+  lmap k (Procompose f g) = Procompose f (lmap k g)
   {-# INLINE rmap #-}
-  rmap k (Procompose f g) = Procompose f (rmap k g)
+  rmap k (Procompose f g) = Procompose (rmap k f) g
   {-# INLINE lmap #-}
-  k #. Procompose f g     = Procompose f (k #. g)
+  k #. Procompose f g     = Procompose (k #. f) g
   {-# INLINE ( #. ) #-}
-  Procompose f g .# k     = Procompose (f .# k) g
+  Procompose f g .# k     = Procompose f (g .# k)
   {-# INLINE ( .# ) #-}
 
-instance Profunctor q => Functor (Procompose p q a) where
-  fmap k (Procompose f g) = Procompose f (rmap k g)
+instance Profunctor p => Functor (Procompose p q a) where
+  fmap k (Procompose f g) = Procompose (rmap k f) g
   {-# INLINE fmap #-}
 
 -- | The composition of two 'Representable' 'Profunctor's is 'Representable' by
 -- the composition of their representations.
 instance (Representable p, Representable q) => Representable (Procompose p q) where
-  type Rep (Procompose p q) = Compose (Rep p) (Rep q)
-  tabulate f = Procompose (tabulate (getCompose . f)) (tabulate id)
+  type Rep (Procompose p q) = Compose (Rep q) (Rep p)
+  tabulate f = Procompose (tabulate id) (tabulate (getCompose . f))
   {-# INLINE tabulate #-}
-  rep (Procompose f g) d = Compose $ rep g <$> rep f d
+  rep (Procompose g f) d = Compose $ rep g <$> rep f d
   {-# INLINE rep #-}
 
 instance (Corepresentable p, Corepresentable q) => Corepresentable (Procompose p q) where
-  type Corep (Procompose p q) = Compose (Corep q) (Corep p)
-  cotabulate f = Procompose (cotabulate id) (cotabulate (f . Compose))
+  type Corep (Procompose p q) = Compose (Corep p) (Corep q)
+  cotabulate f = Procompose (cotabulate (f . Compose)) (cotabulate id)
   {-# INLINE cotabulate #-}
-  corep (Procompose f g) (Compose d) = corep g $ corep f <$> d
+  corep (Procompose g f) (Compose d) = corep g $ corep f <$> d
   {-# INLINE corep #-}
 
 instance (Strong p, Strong q) => Strong (Procompose p q) where
@@ -103,6 +114,9 @@
   right' (Procompose x y) = Procompose (right' x) (right' y)
   {-# INLINE right' #-}
 
+instance (Closed p, Closed q) => Closed (Procompose p q) where
+  closed (Procompose x y) = Procompose (closed x) (closed y)
+  {-# INLINE closed #-}
 
 -- * Lax identity
 
@@ -116,7 +130,7 @@
 -- 'idl' :: 'Profunctor' q => Iso' ('Procompose' (->) q d c) (q d c)
 -- @
 idl :: Profunctor q => Iso (Procompose (->) q d c) (Procompose (->) r d' c') (q d c) (r d' c')
-idl = dimap (\(Procompose f g) -> lmap f g) (fmap (Procompose id))
+idl = dimap (\(Procompose g f) -> rmap g f) (fmap (Procompose id))
 
 -- | @(->)@ functions as a lax identity for 'Profunctor' composition.
 --
@@ -128,7 +142,7 @@
 -- 'idr' :: 'Profunctor' q => Iso' ('Procompose' q (->) d c) (q d c)
 -- @
 idr :: Profunctor q => Iso (Procompose q (->) d c) (Procompose r (->) d' c') (q d c) (r d' c')
-idr = dimap (\(Procompose f g) -> rmap g f) (fmap (`Procompose` id))
+idr = dimap (\(Procompose g f) -> lmap f g) (fmap (`Procompose` id))
 
 
 -- | The associator for 'Profunctor' composition.
@@ -148,14 +162,14 @@
 -- isomorphic to @a -> f (g c)@.
 --
 -- @'upstars' :: 'Functor' f => Iso' ('Procompose' ('UpStar' f) ('UpStar' g) d c) ('UpStar' ('Compose' f g) d c)@
-upstars :: Functor f
+upstars :: Functor g
         => Iso (Procompose (UpStar f ) (UpStar g ) d  c )
                (Procompose (UpStar f') (UpStar g') d' c')
-               (UpStar (Compose f  g ) d  c )
-               (UpStar (Compose f' g') d' c')
+               (UpStar (Compose g  f ) d  c )
+               (UpStar (Compose g' f') d' c')
 upstars = dimap hither (fmap yon) where
-  hither (Procompose (UpStar dfx) (UpStar xgc)) = UpStar (Compose . fmap xgc . dfx)
-  yon (UpStar dfgc) = Procompose (UpStar (getCompose . dfgc)) (UpStar id)
+  hither (Procompose (UpStar xgc) (UpStar dfx)) = UpStar (Compose . fmap xgc . dfx)
+  yon (UpStar dfgc) = Procompose (UpStar id) (UpStar (getCompose . dfgc))
 
 -- | 'Profunctor' composition generalizes 'Functor' composition in two ways.
 --
@@ -163,36 +177,80 @@
 -- isomorphic to @g (f a) -> c@.
 --
 -- @'downstars' :: 'Functor' f => Iso' ('Procompose' ('DownStar' f) ('DownStar' g) d c) ('DownStar' ('Compose' g f) d c)@
-downstars :: Functor g
+downstars :: Functor f
           => Iso (Procompose (DownStar f ) (DownStar g ) d  c )
                  (Procompose (DownStar f') (DownStar g') d' c')
-                 (DownStar (Compose g  f ) d  c )
-                 (DownStar (Compose g' f') d' c')
+                 (DownStar (Compose f  g ) d  c )
+                 (DownStar (Compose f' g') d' c')
 downstars = dimap hither (fmap yon) where
-  hither (Procompose (DownStar fdx) (DownStar gxc)) = DownStar (gxc . fmap fdx . getCompose)
-  yon (DownStar dgfc) = Procompose (DownStar id) (DownStar (dgfc . Compose))
+  hither (Procompose (DownStar gxc) (DownStar fdx)) = DownStar (gxc . fmap fdx . getCompose)
+  yon (DownStar dgfc) = Procompose (DownStar (dgfc . Compose)) (DownStar id)
 
 -- | This is a variant on 'upstars' that uses 'Kleisli' instead of 'UpStar'.
 --
 -- @'kleislis' :: 'Monad' f => Iso' ('Procompose' ('Kleisli' f) ('Kleisli' g) d c) ('Kleisli' ('Compose' f g) d c)@
-kleislis :: Monad f
+kleislis :: Monad g
         => Iso (Procompose (Kleisli f ) (Kleisli g ) d  c )
                (Procompose (Kleisli f') (Kleisli g') d' c')
-               (Kleisli (Compose f  g ) d  c )
-               (Kleisli (Compose f' g') d' c')
+               (Kleisli (Compose g  f ) d  c )
+               (Kleisli (Compose g' f') d' c')
 kleislis = dimap hither (fmap yon) where
-  hither (Procompose (Kleisli dfx) (Kleisli xgc)) = Kleisli (Compose . liftM xgc . dfx)
-  yon (Kleisli dfgc) = Procompose (Kleisli (getCompose . dfgc)) (Kleisli id)
+  hither (Procompose (Kleisli xgc) (Kleisli dfx)) = Kleisli (Compose . liftM xgc . dfx)
+  yon (Kleisli dfgc) = Procompose (Kleisli id) (Kleisli (getCompose . dfgc))
 
 -- | This is a variant on 'downstars' that uses 'Cokleisli' instead
 -- of 'DownStar'.
 --
 -- @'cokleislis' :: 'Functor' f => Iso' ('Procompose' ('Cokleisli' f) ('Cokleisli' g) d c) ('Cokleisli' ('Compose' g f) d c)@
-cokleislis :: Functor g
+cokleislis :: Functor f
           => Iso (Procompose (Cokleisli f ) (Cokleisli g ) d  c )
                  (Procompose (Cokleisli f') (Cokleisli g') d' c')
-                 (Cokleisli (Compose g  f ) d  c )
-                 (Cokleisli (Compose g' f') d' c')
+                 (Cokleisli (Compose f  g ) d  c )
+                 (Cokleisli (Compose f' g') d' c')
 cokleislis = dimap hither (fmap yon) where
-  hither (Procompose (Cokleisli fdx) (Cokleisli gxc)) = Cokleisli (gxc . fmap fdx . getCompose)
-  yon (Cokleisli dgfc) = Procompose (Cokleisli id) (Cokleisli (dgfc . Compose))
+  hither (Procompose (Cokleisli gxc) (Cokleisli fdx)) = Cokleisli (gxc . fmap fdx . getCompose)
+  yon (Cokleisli dgfc) = Procompose (Cokleisli (dgfc . Compose)) (Cokleisli id)
+
+----------------------------------------------------------------------------
+-- * Rift
+----------------------------------------------------------------------------
+-- | This represents the right Kan lift of a 'Profunctor' @q@ along a 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where the only object is the category Hask, 1-morphisms are profunctors composed and compose with Profunctor composition, and 2-morphisms are just natural transformations.
+newtype Rift p q a b = Rift { runRift :: forall x. p b x -> q a x }
+
+instance Category p => ProfunctorComonad (Rift p) where
+  proextract (Rift f) = f id
+  produplicate (Rift f) = Rift $ \p -> Rift $ \q -> f (q . p)
+
+instance (Profunctor p, Profunctor q) => Profunctor (Rift p q) where
+  dimap ca bd f = Rift (lmap ca . runRift f . lmap bd)
+  {-# INLINE dimap #-}
+  lmap ca f = Rift (lmap ca . runRift f)
+  {-# INLINE lmap #-}
+  rmap bd f = Rift (runRift f . lmap bd)
+  {-# INLINE rmap #-}
+  bd #. f = Rift (\p -> runRift f (p .# bd))
+  {-# INLINE ( #. ) #-}
+  f .# ca = Rift (\p -> runRift f p .# ca)
+  {-# INLINE (.#) #-}
+
+instance Profunctor p => Functor (Rift p q a) where
+  fmap bd f = Rift (runRift f . lmap bd)
+  {-# INLINE fmap #-}
+
+-- | @'Rift' p p@ forms a 'Monad' in the 'Profunctor' 2-category, which is isomorphic to a Haskell 'Category' instance.
+instance p ~ q => Category (Rift p q) where
+  id = Rift id
+  {-# INLINE id #-}
+  Rift f . Rift g = Rift (g . f)
+  {-# INLINE (.) #-}
+
+-- | The 2-morphism that defines a left Kan lift.
+--
+-- Note: When @p@ is right adjoint to @'Rift' p (->)@ then 'decomposeRift' is the 'counit' of the adjunction.
+decomposeRift :: Procompose p (Rift p q) -/-> q
+decomposeRift (Procompose p (Rift pq)) = pq p
+{-# INLINE decomposeRift #-}
+
+instance Procompose p -| Rift p where
+  counit (Procompose p (Rift pq)) = pq p
+  unit q = Rift $ \p -> Procompose p q
diff --git a/src/Data/Profunctor/Lift.hs b/src/Data/Profunctor/Lift.hs
deleted file mode 100644
--- a/src/Data/Profunctor/Lift.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE TypeFamilies #-}
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Copyright   :  (C) 2014 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  Rank2Types, TFs
---
-----------------------------------------------------------------------------
-module Data.Profunctor.Lift
-  ( Lift(..)
-  , decomposeLift
-  ) where
-
-import Control.Category
-import Data.Profunctor.Unsafe
-import Data.Profunctor.Composition
-import Prelude hiding (id,(.))
-
--- | This represents the left Kan lift of a 'Profunctor' @q@ along a 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where the only object is the category Hask, 1-morphisms are profunctors composed and compose with Profunctor composition, and 2-morphisms are just natural transformations.
-newtype Lift p q a b = Lift { runLift :: forall x. p b x -> q a x }
-
-
-instance (Profunctor p, Profunctor q) => Profunctor (Lift p q) where
-  dimap ca bd f = Lift (lmap ca . runLift f . lmap bd)
-  {-# INLINE dimap #-}
-  lmap ca f = Lift (lmap ca . runLift f)
-  {-# INLINE lmap #-}
-  rmap bd f = Lift (runLift f . lmap bd)
-  {-# INLINE rmap #-}
-  bd #. f = Lift (\p -> runLift f (p .# bd))
-  {-# INLINE ( #. ) #-}
-  f .# ca = Lift (\p -> runLift f p .# ca)
-  {-# INLINE (.#) #-}
-
-instance Profunctor p => Functor (Lift p q a) where
-  fmap bd f = Lift (runLift f . lmap bd)
-  {-# INLINE fmap #-}
-
--- | @'Lift' p p@ forms a 'Monad' in the 'Profunctor' 2-category, which is isomorphic to a Haskell 'Category' instance.
-instance p ~ q => Category (Lift p q) where
-  id = Lift id
-  {-# INLINE id #-}
-  Lift f . Lift g = Lift (g . f)
-  {-# INLINE (.) #-}
-
--- | The 2-morphism that defines a left Kan lift.
---
--- Note: When @p@ is right adjoint to @'Lift' p (->)@ then 'decomposeLift' is the 'counit' of the adjunction.
-decomposeLift :: Procompose (Lift p q) p a b -> q a b
-decomposeLift (Procompose (Lift pq) p) = pq p
-{-# INLINE decomposeLift #-}
diff --git a/src/Data/Profunctor/Monad.hs b/src/Data/Profunctor/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Monad.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+module Data.Profunctor.Monad where
+
+import Data.Profunctor
+
+class ProfunctorMonad t where
+  proreturn :: Profunctor p => p -/-> t p
+  projoin   :: Profunctor p => t (t p) -/-> t p
+
+class ProfunctorComonad t where
+  proextract :: Profunctor p => t p -/-> p
+  produplicate :: Profunctor p => t p -/-> t (t p)
diff --git a/src/Data/Profunctor/Ran.hs b/src/Data/Profunctor/Ran.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Ran.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) 2013-2014 Edward Kmett and Dan Doel
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  Rank2Types, TFs
+--
+----------------------------------------------------------------------------
+module Data.Profunctor.Ran
+  ( Ran(..)
+  , decomposeRan
+  , precomposeRan
+  , curryRan
+  , uncurryRan
+  ) where
+
+import Control.Category
+import Data.Profunctor
+import Data.Profunctor.Composition
+import Data.Profunctor.Monad
+import Data.Profunctor.Unsafe
+import Prelude hiding (id,(.))
+
+-- | This represents the right Kan extension of a 'Profunctor' @q@ along a 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where the only object is the category Hask, 1-morphisms are profunctors composed and compose with Profunctor composition, and 2-morphisms are just natural transformations.
+newtype Ran p q a b = Ran { runRan :: forall x. p x a -> q x b }
+
+instance Category p => ProfunctorComonad (Ran p) where
+  proextract (Ran f) = f id
+  produplicate (Ran f) = Ran $ \ p -> Ran $ \q -> f (p . q)
+
+instance (Profunctor p, Profunctor q) => Profunctor (Ran p q) where
+  dimap ca bd f = Ran (rmap bd . runRan f . rmap ca)
+  {-# INLINE dimap #-}
+  lmap ca f = Ran (runRan f . rmap ca)
+  {-# INLINE lmap #-}
+  rmap bd f = Ran (rmap bd . runRan f)
+  {-# INLINE rmap #-}
+  bd #. f = Ran (\p -> bd #. runRan f p)
+  {-# INLINE ( #. ) #-}
+  f .# ca = Ran (\p -> runRan f (ca #. p))
+  {-# INLINE (.#) #-}
+
+instance Profunctor q => Functor (Ran p q a) where
+  fmap bd f = Ran (rmap bd . runRan f)
+  {-# INLINE fmap #-}
+
+-- | @'Ran' p p@ forms a 'Monad' in the 'Profunctor' 2-category, which is isomorphic to a Haskell 'Category' instance.
+instance p ~ q => Category (Ran p q) where
+  id = Ran id
+  {-# INLINE id #-}
+  Ran f . Ran g = Ran (f . g)
+  {-# INLINE (.) #-}
+
+-- | The 2-morphism that defines a right Kan extension.
+--
+-- Note: When @q@ is left adjoint to @'Ran' q (->)@ then 'decomposeRan' is the 'counit' of the adjunction.
+decomposeRan :: Procompose (Ran q p) q -/-> p
+decomposeRan (Procompose (Ran qp) q) = qp q
+{-# INLINE decomposeRan #-}
+
+precomposeRan :: Profunctor q => Procompose q (Ran p (->)) -/-> Ran p q
+precomposeRan (Procompose p pf) = Ran (\pxa -> runRan pf pxa `lmap` p)
+{-# INLINE precomposeRan #-}
+
+curryRan :: (Procompose p q -/-> r) -> p -/-> Ran q r
+curryRan f p = Ran $ \q -> f (Procompose p q)
+{-# INLINE curryRan #-}
+
+uncurryRan :: (p -/-> Ran q r) -> Procompose p q -/-> r
+uncurryRan f (Procompose p q) = runRan (f p) q
+{-# INLINE uncurryRan #-}
diff --git a/src/Data/Profunctor/Rep.hs b/src/Data/Profunctor/Rep.hs
--- a/src/Data/Profunctor/Rep.hs
+++ b/src/Data/Profunctor/Rep.hs
@@ -115,7 +115,7 @@
 --
 -- This can be used with the combinators from the @lens@ package.
 --
--- @'tabulated' :: 'Corep' f p => 'Iso'' (f d -> c) (p d c)@
+-- @'cotabulated' :: 'Corep' f p => 'Iso'' (f d -> c) (p d c)@
 cotabulated :: (Corepresentable p, Corepresentable q) => Iso (Corep p d -> c) (Corep q d' -> c') (p d c) (q d' c')
 cotabulated = dimap cotabulate (fmap corep)
 {-# INLINE cotabulated #-}
diff --git a/src/Data/Profunctor/Rift.hs b/src/Data/Profunctor/Rift.hs
deleted file mode 100644
--- a/src/Data/Profunctor/Rift.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE TypeFamilies #-}
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Copyright   :  (C) 2013 Edward Kmett and Dan Doel
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  Rank2Types, TFs
---
-----------------------------------------------------------------------------
-module Data.Profunctor.Rift
-  ( Rift(..)
-  , decomposeRift
-  , precomposeRift
-  ) where
-
-import Control.Category
-import Data.Profunctor.Unsafe
-import Data.Profunctor.Composition
-import Prelude hiding (id,(.))
-
--- | This represents the right Kan lift of a 'Profunctor' @q@ along a 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where the only object is the category Hask, 1-morphisms are profunctors composed and compose with Profunctor composition, and 2-morphisms are just natural transformations.
-newtype Rift p q a b = Rift { runRift :: forall x. p x a -> q x b }
-
---  Ran f g a = forall b. (a -> f b) -> g b
-
-instance (Profunctor p, Profunctor q) => Profunctor (Rift p q) where
-  dimap ca bd f = Rift (rmap bd . runRift f . rmap ca)
-  {-# INLINE dimap #-}
-  lmap ca f = Rift (runRift f . rmap ca)
-  {-# INLINE lmap #-}
-  rmap bd f = Rift (rmap bd . runRift f)
-  {-# INLINE rmap #-}
-  bd #. f = Rift (\p -> bd #. runRift f p)
-  {-# INLINE ( #. ) #-}
-  f .# ca = Rift (\p -> runRift f (ca #. p))
-  {-# INLINE (.#) #-}
-
-instance Profunctor q => Functor (Rift p q a) where
-  fmap bd f = Rift (rmap bd . runRift f)
-  {-# INLINE fmap #-}
-
--- | @'Rift' p p@ forms a 'Monad' in the 'Profunctor' 2-category, which is isomorphic to a Haskell 'Category' instance.
-instance p ~ q => Category (Rift p q) where
-  id = Rift id
-  {-# INLINE id #-}
-  Rift f . Rift g = Rift (f . g)
-  {-# INLINE (.) #-}
-
--- | The 2-morphism that defines a right Kan lift.
---
--- Note: When @q@ is left adjoint to @'Rift' q (->)@ then 'decomposeRift' is the 'counit' of the adjunction.
-decomposeRift :: Procompose q (Rift q p) a b -> p a b
-decomposeRift (Procompose q (Rift qp)) = qp q
-{-# INLINE decomposeRift #-}
-
-precomposeRift :: Profunctor q => Procompose (Rift p (->)) q a b -> Rift p q a b
-precomposeRift (Procompose pf p) = Rift (\pxa -> runRift pf pxa `lmap` p)
-{-# INLINE precomposeRift #-}
diff --git a/src/Data/Profunctor/Tambara.hs b/src/Data/Profunctor/Tambara.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Tambara.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) 2014 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  Rank2Types
+--
+----------------------------------------------------------------------------
+module Data.Profunctor.Tambara
+  ( Tambara(..)
+  , tambara, untambara
+  , Pastro(..)
+  , Cotambara(..)
+  , cotambara, uncotambara
+  , Copastro(..)
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Category
+import Data.Monoid
+import Data.Profunctor
+import Data.Profunctor.Adjunction
+import Data.Profunctor.Monad
+import Data.Profunctor.Unsafe
+import Prelude hiding (id,(.))
+
+----------------------------------------------------------------------------
+-- * Tambara
+----------------------------------------------------------------------------
+
+newtype Tambara p a b = Tambara { runTambara :: forall c. p (a, c) (b, c) }
+
+instance Profunctor p => Profunctor (Tambara p) where
+  dimap f g (Tambara p) = Tambara $ dimap (first f) (first g) p
+  {-# INLINE dimap #-}
+
+instance ProfunctorComonad Tambara where
+  proextract (Tambara p) = dimap (\a -> (a,())) fst p
+  produplicate (Tambara p) = Tambara (Tambara $ dimap hither yon p) where
+    hither ~(~(x,y),z) = (x,(y,z))
+    yon    ~(x,~(y,z)) = ((x,y),z)
+
+instance Profunctor p => Strong (Tambara p) where
+  first' = runTambara . produplicate
+  {-# INLINE first' #-}
+
+instance Choice p => Choice (Tambara p) where
+  left' (Tambara f) = Tambara $ dimap hither yon $ left' f where
+    hither (Left y, s) = Left (y, s)
+    hither (Right z, s) = Right (z, s)
+    yon (Left (y, s)) = (Left y, s)
+    yon (Right (z, s)) = (Right z, s)
+
+instance Category p => Category (Tambara p) where
+  id = Tambara id
+  Tambara p . Tambara q = Tambara (p . q)
+
+instance Arrow p => Arrow (Tambara p) where
+  arr f = Tambara $ arr $ first f
+  first (Tambara f) = Tambara (arr go . first f . arr go) where
+    go ~(~(x,y),z) = ((x,z),y)
+
+instance ArrowChoice p => ArrowChoice (Tambara p) where
+  left (Tambara f) = Tambara (arr yon . left f . arr hither) where
+    hither (Left y, s) = Left (y, s)
+    hither (Right z, s) = Right (z, s)
+    yon (Left (y, s)) = (Left y, s)
+    yon (Right (z, s)) = (Right z, s)
+
+instance ArrowApply p => ArrowApply (Tambara p) where
+  app = Tambara $ app . arr (\((Tambara f, x), s) -> (f, (x, s)))
+
+instance ArrowLoop p => ArrowLoop (Tambara p) where
+  loop (Tambara f) = Tambara (loop (arr go . f . arr go)) where
+    go ~(~(x,y),z) = ((x,z),y)
+
+instance ArrowZero p => ArrowZero (Tambara p) where
+  zeroArrow = Tambara zeroArrow
+
+instance ArrowPlus p => ArrowPlus (Tambara p) where
+  Tambara f <+> Tambara g = Tambara (f <+> g)
+
+instance Profunctor p => Functor (Tambara p a) where
+  fmap = rmap
+
+instance (Profunctor p, Arrow p) => Applicative (Tambara p a) where
+  pure x = arr (const x)
+  f <*> g = arr (uncurry id) . (f &&& g)
+
+instance (Profunctor p, ArrowPlus p) => Alternative (Tambara p a) where
+  empty = zeroArrow
+  f <|> g = f <+> g
+
+instance (Profunctor p, ArrowPlus p) => Monoid (Tambara p a b) where
+  mempty = zeroArrow
+  mappend f g = f <+> g
+
+-- |
+-- @
+-- 'tambara' '.' 'untambara' ≡ 'id'
+-- 'untambara' '.' 'tambara' ≡ 'id'
+-- @
+tambara :: Strong p => (p -/-> q) -> p -/-> Tambara q
+tambara f p = Tambara $ f $ first' p
+
+-- |
+-- @
+-- 'tambara' '.' 'untambara' ≡ 'id'
+-- 'untambara' '.' 'tambara' ≡ 'id'
+-- @
+untambara :: Profunctor q => (p -/-> Tambara q) -> p -/-> q
+untambara f p = dimap (\a -> (a,())) fst $ runTambara $ f p
+
+----------------------------------------------------------------------------
+-- * Pastro
+----------------------------------------------------------------------------
+
+-- | Pastro -| Tambara
+data Pastro p a b where
+  Pastro :: ((y, z) -> b) -> p x y -> (a -> (x, z)) -> Pastro p a b
+
+instance Profunctor p => Profunctor (Pastro p) where
+  dimap f g (Pastro l m r) = Pastro (g . l) m (r . f)
+  lmap f (Pastro l m r) = Pastro l m (r . f)
+  rmap g (Pastro l m r) = Pastro (g . l) m r
+  w #. Pastro l m r = Pastro (w #. l) m r
+  Pastro l m r .# w = Pastro l m (r .# w)
+
+instance ProfunctorMonad Pastro where
+  proreturn p = Pastro fst p $ \a -> (a,())
+  projoin (Pastro l (Pastro m n o) p) = Pastro lm n op where
+    op a = case p a of
+      (b, f) -> case o b of
+         (c, g) -> (c, (f, g)) 
+    lm (d, (f, g)) = l (m (d, g), f)
+    
+instance Pastro -| Tambara where
+  counit (Pastro g (Tambara p) f) = dimap f g p
+  unit p = Tambara (Pastro id p id)
+
+----------------------------------------------------------------------------
+-- * Cotambara
+----------------------------------------------------------------------------
+
+-- | Cotambara is freely adjoins respect for cocartesian structure to a profunctor
+newtype Cotambara p a b = Cotambara { runCotambara :: forall c. p (Either a c) (Either b c) }
+
+instance ProfunctorComonad Cotambara where
+  proextract (Cotambara p)   = dimap Left (\(Left a) -> a) p
+  produplicate (Cotambara p) = Cotambara (Cotambara $ dimap hither yon p) where
+    hither (Left (Left x))   = Left x
+    hither (Left (Right y))  = Right (Left y)
+    hither (Right z)         = Right (Right z)
+    yon    (Left x)          = Left (Left x)
+    yon    (Right (Left y))  = Left (Right y)
+    yon    (Right (Right z)) = Right z
+
+instance Profunctor p => Profunctor (Cotambara p) where
+  dimap f g (Cotambara p) = Cotambara $ dimap (left f) (left g) p
+  {-# INLINE dimap #-}
+
+instance Profunctor p => Choice (Cotambara p) where
+  left' = runCotambara . produplicate
+  {-# INLINE left' #-}
+
+instance Category p => Category (Cotambara p) where
+  id = Cotambara id
+  Cotambara p . Cotambara q = Cotambara (p . q)
+
+instance Profunctor p => Functor (Cotambara p a) where
+  fmap = rmap
+
+-- |
+-- @
+-- 'cotambara' '.' 'uncotambara' ≡ 'id'
+-- 'uncotambara' '.' 'cotambara' ≡ 'id'
+-- @
+cotambara :: Choice p => (p -/-> q) -> p -/-> Cotambara q
+cotambara f p = Cotambara $ f $ left' p
+
+-- |
+-- @
+-- 'cotambara' '.' 'uncotambara' ≡ 'id'
+-- 'uncotambara' '.' 'cotambara' ≡ 'id'
+-- @
+uncotambara :: Profunctor q => (p -/-> Cotambara q) -> p -/-> q
+uncotambara f p = dimap Left (\(Left a) -> a) $ runCotambara $ f p
+
+----------------------------------------------------------------------------
+-- * Copastro
+----------------------------------------------------------------------------
+
+-- | Copastro -| Cotambara
+data Copastro p a b where
+  Copastro :: (Either y z -> b) -> p x y -> (a -> Either x z) -> Copastro p a b
+
+instance Profunctor p => Profunctor (Copastro p) where
+  dimap f g (Copastro l m r) = Copastro (g . l) m (r . f)
+  lmap f (Copastro l m r) = Copastro l m (r . f)
+  rmap g (Copastro l m r) = Copastro (g . l) m r
+  w #. Copastro l m r = Copastro (w #. l) m r
+  Copastro l m r .# w = Copastro l m (r .# w)
+
+instance Copastro -| Cotambara where
+  counit (Copastro f (Cotambara g) h) = dimap h f g
+  unit p = Cotambara $ Copastro id p id
+
+instance ProfunctorMonad Copastro where
+  proreturn p = Copastro (\(Left a)-> a) p Left
+  projoin (Copastro l (Copastro m n o) q) = Copastro lm n oq where
+    oq a = case q a of
+      Left b -> case o b of
+        Left c -> Left c
+        Right z -> Right (Left z)
+      Right z -> Right (Right z)
+    lm (Left x) = l $ Left $ m $ Left x
+    lm (Right (Left y)) = l $ Left $ m $ Right y
+    lm (Right (Right z)) = l $ Right z