diff --git a/.travis.yml b/.travis.yml
--- a/.travis.yml
+++ b/.travis.yml
@@ -2,21 +2,16 @@
 
 # See also https://github.com/hvr/multi-ghc-travis for more information
 env:
- - GHCVER=7.0.1 CABALVER=1.16
- - GHCVER=7.0.4 CABALVER=1.16
- - GHCVER=7.2.2 CABALVER=1.16
  - GHCVER=7.4.2 CABALVER=1.16
  - GHCVER=7.6.3 CABALVER=1.16
  - GHCVER=7.8.4 CABALVER=1.18
  - GHCVER=7.10.1 CABALVER=1.22
- - GHCVER=head CABALVER=1.22
+ - GHCVER=8.0.1 CABALVER=1.24
+ - GHCVER=head CABALVER=1.24
 
 matrix:
   allow_failures:
-   - env: GHCVER=7.0.1 CABALVER=1.16
-   - env: GHCVER=7.0.4 CABALVER=1.16
-   - env: GHCVER=7.2.2 CABALVER=1.16
-   - env: GHCVER=head CABALVER=1.22
+   - env: GHCVER=head CABALVER=1.24
 
 # Note: the distinction between `before_install` and `install` is not
 #       important.
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,9 @@
+5.2
+---
+* Renamed `Cotambara` to `TambaraChoice` and `Pastro` to `PastroChoice`.
+* Added a true `Cotambara` and `Copastro` construction for (co)freely generating costrength, along with `CotambaraSum` and `CopastroSum` variants.
+* Engaged in a fair bit of bikeshedding about the module structure for lesser used modules in this package.
+
 5.1.2
 -----
 * Added `Prep` and `Coprep` along with witnesses to the adjunctions `Prep -| Star : [Hask,Hask] -> Prof` and `Coprep -| Costar : [Hask,Hask]^op -> Prof`.
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright 2011-2013 Edward Kmett
+Copyright 2011-2015 Edward Kmett
 
 All rights reserved.
 
diff --git a/profunctors.cabal b/profunctors.cabal
--- a/profunctors.cabal
+++ b/profunctors.cabal
@@ -1,6 +1,6 @@
 name:          profunctors
 category:      Control, Categories
-version:       5.1.2
+version:       5.2
 license:       BSD3
 cabal-version: >= 1.10
 license-file:  LICENSE
@@ -30,27 +30,29 @@
 library
   build-depends:
     base                >= 4     && < 5,
-    bifunctors          >= 5     && < 6,
-    comonad             >= 4     && < 5,
+    base-orphans        >= 0.4   && < 0.6,
+    bifunctors          >= 5.2   && < 6,
+    comonad             >= 4     && < 6,
     contravariant       >= 1     && < 2,
     distributive        >= 0.4.4 && < 1,
     tagged              >= 0.4.4 && < 1,
-    transformers        >= 0.2   && < 0.5
+    transformers        >= 0.2   && < 0.6
 
   exposed-modules:
     Data.Profunctor
     Data.Profunctor.Adjunction
     Data.Profunctor.Cayley
+    Data.Profunctor.Choice
     Data.Profunctor.Closed
-    Data.Profunctor.Codensity
     Data.Profunctor.Composition
+    Data.Profunctor.Mapping
     Data.Profunctor.Monad
-    Data.Profunctor.Monoid
     Data.Profunctor.Ran
     Data.Profunctor.Rep
     Data.Profunctor.Sieve
-    Data.Profunctor.Tambara
-    Data.Profunctor.Trace
+    Data.Profunctor.Strong
+    Data.Profunctor.Traversing
+    Data.Profunctor.Types
     Data.Profunctor.Unsafe
 
   ghc-options:     -Wall -O2
diff --git a/src/Data/Profunctor.hs b/src/Data/Profunctor.hs
--- a/src/Data/Profunctor.hs
+++ b/src/Data/Profunctor.hs
@@ -7,7 +7,7 @@
 #endif
 -----------------------------------------------------------------------------
 -- |
--- Copyright   :  (C) 2011-2013 Edward Kmett,
+-- Copyright   :  (C) 2011-2015 Edward Kmett,
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
@@ -28,7 +28,12 @@
     Profunctor(dimap,lmap,rmap)
   -- ** Profunctorial Strength
   , Strong(..)
+  , uncurry'
   , Choice(..)
+  -- ** Closed
+  , Closed(..)
+  , curry'
+  , Mapping(..)
   -- ** Profunctorial Costrength
   , Costrong(..)
   , Cochoice(..)
@@ -42,396 +47,8 @@
 #endif
   ) where
 
-import Control.Applicative hiding (WrappedArrow(..))
-import Control.Arrow
-import Control.Category
-import Control.Comonad
-import Control.Monad (liftM, MonadPlus(..))
-import Control.Monad.Fix
-import Data.Distributive
-import Data.Foldable
-import Data.Monoid
-import Data.Tagged
-import Data.Traversable
-import Data.Tuple
-import Data.Profunctor.Unsafe
-import Prelude hiding (id,(.),sequence)
-
-#if __GLASGOW_HASKELL__ >= 708
-import Data.Coerce
-#else
-import Unsafe.Coerce
-#endif
-
-infixr 0 :->
-type p :-> q = forall a b. p a b -> q a b
-
-------------------------------------------------------------------------------
--- Star
-------------------------------------------------------------------------------
-
--- | Lift a 'Functor' into a 'Profunctor' (forwards).
-newtype Star f d c = Star { runStar :: d -> f c }
-
-instance Functor f => Profunctor (Star f) where
-  dimap ab cd (Star bfc) = Star (fmap cd . bfc . ab)
-  {-# INLINE dimap #-}
-  lmap k (Star f) = Star (f . k)
-  {-# INLINE lmap #-}
-  rmap k (Star f) = Star (fmap k . f)
-  {-# INLINE rmap #-}
-  -- We cannot safely overload ( #. ) because we didn't write the 'Functor'.
-#if __GLASGOW_HASKELL__ >= 708
-  p .# _ = coerce p
-#else
-  p .# _ = unsafeCoerce p
-#endif
-  {-# INLINE ( .# ) #-}
-
-instance Functor f => Functor (Star f a) where
-  fmap = rmap
-  {-# INLINE fmap #-}
-
-instance Applicative f => Applicative (Star f a) where
-  pure a = Star $ \_ -> pure a
-  Star ff <*> Star fx = Star $ \a -> ff a <*> fx a
-  Star ff  *> Star fx = Star $ \a -> ff a  *> fx a
-  Star ff <*  Star fx = Star $ \a -> ff a <*  fx a
-
-instance Alternative f => Alternative (Star f a) where
-  empty = Star $ \_ -> empty
-  Star f <|> Star g = Star $ \a -> f a <|> g a
-
-instance Monad f => Monad (Star f a) where
-#if __GLASGOW_HASKELL__ < 710
-  return a = Star $ \_ -> return a
-#endif
-  Star m >>= f = Star $ \ e -> do
-    a <- m e
-    runStar (f a) e
-
-instance MonadPlus f => MonadPlus (Star f a) where
-  mzero = Star $ \_ -> mzero
-  Star f `mplus` Star g = Star $ \a -> f a `mplus` g a
-
-instance Distributive f => Distributive (Star f a) where
-  distribute fs = Star $ \a -> collect (($ a) .# runStar) fs
-
-------------------------------------------------------------------------------
--- Costar
-------------------------------------------------------------------------------
-
--- | Lift a 'Functor' into a 'Profunctor' (backwards).
-newtype Costar f d c = Costar { runCostar :: f d -> c }
-
-instance Functor f => Profunctor (Costar f) where
-  dimap ab cd (Costar fbc) = Costar (cd . fbc . fmap ab)
-  {-# INLINE dimap #-}
-  lmap k (Costar f) = Costar (f . fmap k)
-  {-# INLINE lmap #-}
-  rmap k (Costar f) = Costar (k . f)
-  {-# INLINE rmap #-}
-#if __GLASGOW_HASKELL__ >= 708
-  ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b
-#else
-  ( #. ) _ = unsafeCoerce
-#endif
-  {-# INLINE ( #. ) #-}
-  -- We cannot overload ( .# ) because we didn't write the 'Functor'.
-
-instance Distributive (Costar f d) where
-  distribute fs = Costar $ \gd -> fmap (($ gd) .# runCostar) fs
-
-instance Functor (Costar f a) where
-  fmap k (Costar f) = Costar (k . f)
-  {-# INLINE fmap #-}
-  a <$ _ = Costar $ \_ -> a
-  {-# INLINE (<$) #-}
-
-instance Applicative (Costar f a) where
-  pure a = Costar $ \_ -> a
-  Costar ff <*> Costar fx = Costar $ \a -> ff a (fx a)
-  _ *> m = m
-  m <* _ = m
-
-instance Monad (Costar f a) where
-  return = pure
-  Costar m >>= f = Costar $ \ x -> runCostar (f (m x)) x
-
-------------------------------------------------------------------------------
--- Wrapped Profunctors
-------------------------------------------------------------------------------
-
--- | Wrap an arrow for use as a 'Profunctor'.
-newtype WrappedArrow p a b = WrapArrow { unwrapArrow :: p a b }
-
-instance Category p => Category (WrappedArrow p) where
-  WrapArrow f . WrapArrow g = WrapArrow (f . g)
-  {-# INLINE (.) #-}
-  id = WrapArrow id
-  {-# INLINE id #-}
-
-instance Arrow p => Arrow (WrappedArrow p) where
-  arr = WrapArrow . arr
-  {-# INLINE arr #-}
-  first = WrapArrow . first . unwrapArrow
-  {-# INLINE first #-}
-  second = WrapArrow . second . unwrapArrow
-  {-# INLINE second #-}
-  WrapArrow a *** WrapArrow b = WrapArrow (a *** b)
-  {-# INLINE (***) #-}
-  WrapArrow a &&& WrapArrow b = WrapArrow (a &&& b)
-  {-# INLINE (&&&) #-}
-
-instance ArrowZero p => ArrowZero (WrappedArrow p) where
-  zeroArrow = WrapArrow zeroArrow
-  {-# INLINE zeroArrow #-}
-
-instance ArrowChoice p => ArrowChoice (WrappedArrow p) where
-  left = WrapArrow . left . unwrapArrow
-  {-# INLINE left #-}
-  right = WrapArrow . right . unwrapArrow
-  {-# INLINE right #-}
-  WrapArrow a +++ WrapArrow b = WrapArrow (a +++ b)
-  {-# INLINE (+++) #-}
-  WrapArrow a ||| WrapArrow b = WrapArrow (a ||| b)
-  {-# INLINE (|||) #-}
-
-instance ArrowApply p => ArrowApply (WrappedArrow p) where
-  app = WrapArrow $ app . arr (first unwrapArrow)
-  {-# INLINE app #-}
-
-instance ArrowLoop p => ArrowLoop (WrappedArrow p) where
-  loop = WrapArrow . loop . unwrapArrow
-  {-# INLINE loop #-}
-
-instance Arrow p => Profunctor (WrappedArrow p) where
-  lmap = (^>>)
-  {-# INLINE lmap #-}
-  rmap = (^<<)
-  {-# INLINE rmap #-}
-  -- We cannot safely overload ( #. ) or ( .# ) because we didn't write the 'Arrow'.
-
-------------------------------------------------------------------------------
--- Forget
-------------------------------------------------------------------------------
-
-newtype Forget r a b = Forget { runForget :: a -> r }
-
-instance Profunctor (Forget r) where
-  dimap f _ (Forget k) = Forget (k . f)
-  {-# INLINE dimap #-}
-  lmap f (Forget k) = Forget (k . f)
-  {-# INLINE lmap #-}
-  rmap _ (Forget k) = Forget k
-  {-# INLINE rmap #-}
-
-instance Functor (Forget r a) where
-  fmap _ (Forget k) = Forget k
-  {-# INLINE fmap #-}
-
-instance Foldable (Forget r a) where
-  foldMap _ _ = mempty
-  {-# INLINE foldMap #-}
-
-instance Traversable (Forget r a) where
-  traverse _ (Forget k) = pure (Forget k)
-  {-# INLINE traverse #-}
-
-------------------------------------------------------------------------------
--- Strong
-------------------------------------------------------------------------------
-
--- | Generalizing 'Star' of a strong 'Functor'
---
--- /Note:/ Every 'Functor' in Haskell is strong with respect to @(,)@.
---
--- This describes profunctor strength with respect to the product structure
--- of Hask.
---
--- <http://www-kb.is.s.u-tokyo.ac.jp/~asada/papers/arrStrMnd.pdf>
-class Profunctor p => Strong p where
-  first' :: p a b  -> p (a, c) (b, c)
-  first' = dimap swap swap . second'
-
-  second' :: p a b -> p (c, a) (c, b)
-  second' = dimap swap swap . first'
-
-
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
-  {-# MINIMAL first' | second' #-}
-#endif
-
-instance Strong (->) where
-  first' ab ~(a, c) = (ab a, c)
-  {-# INLINE first' #-}
-  second' ab ~(c, a) = (c, ab a)
-
-instance Monad m => Strong (Kleisli m) where
-  first' (Kleisli f) = Kleisli $ \ ~(a, c) -> do
-     b <- f a
-     return (b, c)
-  {-# INLINE first' #-}
-  second' (Kleisli f) = Kleisli $ \ ~(c, a) -> do
-     b <- f a
-     return (c, b)
-  {-# INLINE second' #-}
-
-instance Functor m => Strong (Star m) where
-  first' (Star f) = Star $ \ ~(a, c) -> (\b' -> (b', c)) <$> f a
-  {-# INLINE first' #-}
-  second' (Star f) = Star $ \ ~(c, a) -> (,) c <$> f a
-  {-# INLINE second' #-}
-
--- | 'Arrow' is 'Strong' 'Category'
-instance Arrow p => Strong (WrappedArrow p) where
-  first' (WrapArrow k) = WrapArrow (first k)
-  {-# INLINE first' #-}
-  second' (WrapArrow k) = WrapArrow (second k)
-  {-# INLINE second' #-}
-
-instance Strong (Forget r) where
-  first' (Forget k) = Forget (k . fst)
-  {-# INLINE first' #-}
-  second' (Forget k) = Forget (k . snd)
-  {-# INLINE second' #-}
-
-------------------------------------------------------------------------------
--- Choice
-------------------------------------------------------------------------------
-
--- | The generalization of 'Costar' of 'Functor' that is strong with respect
--- to 'Either'.
---
--- Note: This is also a notion of strength, except with regards to another monoidal
--- structure that we can choose to equip Hask with: the cocartesian coproduct.
-class Profunctor p => Choice p where
-  left'  :: p a b -> p (Either a c) (Either b c)
-  left' =  dimap (either Right Left) (either Right Left) . right'
-
-  right' :: p a b -> p (Either c a) (Either c b)
-  right' =  dimap (either Right Left) (either Right Left) . left'
-
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
-  {-# MINIMAL left' | right' #-}
-#endif
-
-instance Choice (->) where
-  left' ab (Left a) = Left (ab a)
-  left' _ (Right c) = Right c
-  {-# INLINE left' #-}
-  right' = fmap
-  {-# INLINE right' #-}
-
-instance Monad m => Choice (Kleisli m) where
-  left' = left
-  {-# INLINE left' #-}
-  right' = right
-  {-# INLINE right' #-}
-
-instance Applicative f => Choice (Star f) where
-  left' (Star f) = Star $ either (fmap Left . f) (pure . Right)
-  {-# INLINE left' #-}
-  right' (Star f) = Star $ either (pure . Left) (fmap Right . f)
-  {-# INLINE right' #-}
-
--- | 'extract' approximates 'costrength'
-instance Comonad w => Choice (Cokleisli w) where
-  left' = left
-  {-# INLINE left' #-}
-  right' = right
-  {-# INLINE right' #-}
-
--- NB: This instance is highly questionable
-instance Traversable w => Choice (Costar w) where
-  left' (Costar wab) = Costar (either Right Left . fmap wab . traverse (either Right Left))
-  {-# INLINE left' #-}
-  right' (Costar wab) = Costar (fmap wab . sequence)
-  {-# INLINE right' #-}
-
-instance Choice Tagged where
-  left' (Tagged b) = Tagged (Left b)
-  {-# INLINE left' #-}
-  right' (Tagged b) = Tagged (Right b)
-  {-# INLINE right' #-}
-
-instance ArrowChoice p => Choice (WrappedArrow p) where
-  left' (WrapArrow k) = WrapArrow (left k)
-  {-# INLINE left' #-}
-  right' (WrapArrow k) = WrapArrow (right k)
-  {-# INLINE right' #-}
-
-instance Monoid r => Choice (Forget r) where
-  left' (Forget k) = Forget (either k (const mempty))
-  {-# INLINE left' #-}
-  right' (Forget k) = Forget (either (const mempty) k)
-  {-# INLINE right' #-}
-
---------------------------------------------------------------------------------
--- * Costrength for (,)
---------------------------------------------------------------------------------
-
--- | Analogous to 'ArrowLoop', 'loop' = 'unfirst'
-class Profunctor p => Costrong p where
-  unfirst  :: p (a, d) (b, d) -> p a b
-  unfirst = unsecond . dimap swap swap
-
-  unsecond :: p (d, a) (d, b) -> p a b
-  unsecond = unfirst . dimap swap swap
-
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
-  {-# MINIMAL unfirst | unsecond #-}
-#endif
-
-instance Costrong (->) where
-  unfirst f a = b where (b, d) = f (a, d)
-  unsecond f a = b where (d, b) = f (d, a)
-
-instance Functor f => Costrong (Costar f) where
-  unfirst (Costar f) = Costar f'
-    where f' fa = b where (b, d) = f ((\a -> (a, d)) <$> fa)
-  unsecond (Costar f) = Costar f'
-    where f' fa = b where (d, b) = f ((,) d <$> fa)
-
-instance Costrong Tagged where
-  unfirst (Tagged bd) = Tagged (fst bd)
-  unsecond (Tagged db) = Tagged (snd db)
-
-instance ArrowLoop p => Costrong (WrappedArrow p) where
-  unfirst (WrapArrow k) = WrapArrow (loop k)
-
-instance MonadFix m => Costrong (Kleisli m) where
-  unfirst (Kleisli f) = Kleisli (liftM fst . mfix . f')
-    where f' x y = f (x, snd y)
-
-instance Functor f => Costrong (Cokleisli f) where
-  unfirst (Cokleisli f) = Cokleisli f'
-    where f' fa = b where (b, d) = f ((\a -> (a, d)) <$> fa)
-
---------------------------------------------------------------------------------
--- * Costrength for Either
---------------------------------------------------------------------------------
-
-class Profunctor p => Cochoice p where
-  unleft  :: p (Either a d) (Either b d) -> p a b
-  unleft = unright . dimap (either Right Left) (either Right Left)
-
-  unright :: p (Either d a) (Either d b) -> p a b
-  unright = unleft . dimap (either Right Left) (either Right Left)
-
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
-  {-# MINIMAL unleft | unright #-}
-#endif
-
-instance Cochoice (->) where
-  unleft f = go . Left where go = either id (go . Right) . f
-  unright f = go . Right where go = either (go . Left) id . f
-
-instance Applicative f => Cochoice (Costar f) where
-  unleft (Costar f) = Costar (go . fmap Left)
-    where go = either id (go . pure . Right) . f
-
--- NB: Another instance that's highly questionable
-instance Traversable f => Cochoice (Star f) where
-  unright (Star f) = Star (go . Right)
-    where go = either (go . Left) id . sequence . f
+import Data.Profunctor.Choice
+import Data.Profunctor.Closed
+import Data.Profunctor.Mapping
+import Data.Profunctor.Strong
+import Data.Profunctor.Types
diff --git a/src/Data/Profunctor/Adjunction.hs b/src/Data/Profunctor/Adjunction.hs
--- a/src/Data/Profunctor/Adjunction.hs
+++ b/src/Data/Profunctor/Adjunction.hs
@@ -2,9 +2,19 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE RankNTypes #-}
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) 2015 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable, MPTCs, fundeps
+--
+----------------------------------------------------------------------------
 module Data.Profunctor.Adjunction where
 
-import Data.Profunctor
+import Data.Profunctor.Types
 import Data.Profunctor.Monad
 
 class (ProfunctorFunctor f, ProfunctorFunctor u) => ProfunctorAdjunction f u | f -> u, u -> f where
diff --git a/src/Data/Profunctor/Cayley.hs b/src/Data/Profunctor/Cayley.hs
--- a/src/Data/Profunctor/Cayley.hs
+++ b/src/Data/Profunctor/Cayley.hs
@@ -4,7 +4,7 @@
 #endif
 -----------------------------------------------------------------------------
 -- |
--- Copyright   :  (C) 2014 Edward Kmett
+-- Copyright   :  (C) 2014-2015 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
@@ -80,3 +80,6 @@
 
 instance (Applicative f, ArrowPlus p) => ArrowPlus (Cayley f p) where
   Cayley f <+> Cayley g = Cayley (liftA2 (<+>) f g)
+
+-- instance Adjunction f g => ProfunctorAdjunction (Cayley f) (Cayley g) where
+  
diff --git a/src/Data/Profunctor/Choice.hs b/src/Data/Profunctor/Choice.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Choice.hs
@@ -0,0 +1,364 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) 2014-2015 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  Rank2Types
+--
+----------------------------------------------------------------------------
+module Data.Profunctor.Choice
+  (
+  -- * Strength
+    Choice(..)
+  , TambaraSum(..)
+  , tambaraSum, untambaraSum
+  , PastroSum(..)
+  -- * Costrength
+  , Cochoice(..)
+  , CotambaraSum(..)
+  , cotambaraSum, uncotambaraSum
+  , CopastroSum(..)
+  ) where
+
+import Control.Applicative hiding (WrappedArrow(..))
+import Control.Arrow
+import Control.Category
+import Control.Comonad
+import Data.Bifunctor.Joker (Joker(..))
+import Data.Bifunctor.Product (Product(..))
+import Data.Bifunctor.Tannen (Tannen(..))
+import Data.Monoid hiding (Product)
+import Data.Profunctor.Adjunction
+import Data.Profunctor.Monad
+import Data.Profunctor.Strong
+import Data.Profunctor.Types
+import Data.Profunctor.Unsafe
+import Data.Tagged
+#if __GLASGOW_HASKELL__ < 710
+import Data.Traversable
+import Prelude hiding (id,(.),sequence)
+#else
+import Prelude hiding (id,(.))
+#endif
+
+------------------------------------------------------------------------------
+-- Choice
+------------------------------------------------------------------------------
+
+-- | The generalization of 'Costar' of 'Functor' that is strong with respect
+-- to 'Either'.
+--
+-- Note: This is also a notion of strength, except with regards to another monoidal
+-- structure that we can choose to equip Hask with: the cocartesian coproduct.
+class Profunctor p => Choice p where
+  left'  :: p a b -> p (Either a c) (Either b c)
+  left' =  dimap (either Right Left) (either Right Left) . right'
+
+  right' :: p a b -> p (Either c a) (Either c b)
+  right' =  dimap (either Right Left) (either Right Left) . left'
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
+  {-# MINIMAL left' | right' #-}
+#endif
+
+instance Choice (->) where
+  left' ab (Left a) = Left (ab a)
+  left' _ (Right c) = Right c
+  {-# INLINE left' #-}
+  right' = fmap
+  {-# INLINE right' #-}
+
+instance Monad m => Choice (Kleisli m) where
+  left' = left
+  {-# INLINE left' #-}
+  right' = right
+  {-# INLINE right' #-}
+
+instance Applicative f => Choice (Star f) where
+  left' (Star f) = Star $ either (fmap Left . f) (pure . Right)
+  {-# INLINE left' #-}
+  right' (Star f) = Star $ either (pure . Left) (fmap Right . f)
+  {-# INLINE right' #-}
+
+-- | 'extract' approximates 'costrength'
+instance Comonad w => Choice (Cokleisli w) where
+  left' = left
+  {-# INLINE left' #-}
+  right' = right
+  {-# INLINE right' #-}
+
+-- NB: This instance is highly questionable
+instance Traversable w => Choice (Costar w) where
+  left' (Costar wab) = Costar (either Right Left . fmap wab . traverse (either Right Left))
+  {-# INLINE left' #-}
+  right' (Costar wab) = Costar (fmap wab . sequence)
+  {-# INLINE right' #-}
+
+instance Choice Tagged where
+  left' (Tagged b) = Tagged (Left b)
+  {-# INLINE left' #-}
+  right' (Tagged b) = Tagged (Right b)
+  {-# INLINE right' #-}
+
+instance ArrowChoice p => Choice (WrappedArrow p) where
+  left' (WrapArrow k) = WrapArrow (left k)
+  {-# INLINE left' #-}
+  right' (WrapArrow k) = WrapArrow (right k)
+  {-# INLINE right' #-}
+
+instance Monoid r => Choice (Forget r) where
+  left' (Forget k) = Forget (either k (const mempty))
+  {-# INLINE left' #-}
+  right' (Forget k) = Forget (either (const mempty) k)
+  {-# INLINE right' #-}
+
+instance Functor f => Choice (Joker f) where
+  left' (Joker fb) = Joker (fmap Left fb)
+  {-# INLINE left' #-}
+  right' (Joker fb) = Joker (fmap Right fb)
+  {-# INLINE right' #-}
+
+instance (Choice p, Choice q) => Choice (Product p q) where
+  left' (Pair p q) = Pair (left' p) (left' q)
+  {-# INLINE left' #-}
+  right' (Pair p q) = Pair (right' p) (right' q)
+  {-# INLINE right' #-}
+
+instance (Functor f, Choice p) => Choice (Tannen f p) where
+  left' (Tannen fp) = Tannen (fmap left' fp)
+  {-# INLINE left' #-}
+  right' (Tannen fp) = Tannen (fmap right' fp)
+  {-# INLINE right' #-}
+
+instance Choice p => Choice (Tambara p) where
+  left' (Tambara f) = Tambara $ dimap hither yon $ left' f where
+    hither :: (Either a b, c) -> Either (a, c) (b, c)
+    hither (Left y, s) = Left (y, s)
+    hither (Right z, s) = Right (z, s)
+
+    yon :: Either (a, c) (b, c) -> (Either a b, c)
+    yon (Left (y, s)) = (Left y, s)
+    yon (Right (z, s)) = (Right z, s)
+
+
+----------------------------------------------------------------------------
+-- * TambaraSum
+----------------------------------------------------------------------------
+
+-- | TambaraSum is cofreely adjoins strength with respect to Either.
+--
+-- Note: this is not dual to 'Data.Profunctor.Tambara.Tambara'. It is 'Data.Profunctor.Tambara.Tambara' with respect to a different tensor.
+newtype TambaraSum p a b = TambaraSum { runTambaraSum :: forall c. p (Either a c) (Either b c) }
+
+instance ProfunctorFunctor TambaraSum where
+  promap f (TambaraSum p) = TambaraSum (f p)
+
+instance ProfunctorComonad TambaraSum where
+  proextract (TambaraSum p)   = dimap Left (\(Left a) -> a) p
+  produplicate (TambaraSum p) = TambaraSum (TambaraSum $ dimap hither yon p) where
+    hither :: Either (Either a b) c -> Either a (Either b c)
+    hither (Left (Left x))   = Left x
+    hither (Left (Right y))  = Right (Left y)
+    hither (Right z)         = Right (Right z)
+
+    yon    :: Either a (Either b c) -> Either (Either a b) c
+    yon    (Left x)          = Left (Left x)
+    yon    (Right (Left y))  = Left (Right y)
+    yon    (Right (Right z)) = Right z
+
+instance Profunctor p => Profunctor (TambaraSum p) where
+  dimap f g (TambaraSum p) = TambaraSum $ dimap (left f) (left g) p
+  {-# INLINE dimap #-}
+
+instance Profunctor p => Choice (TambaraSum p) where
+  left' = runTambaraSum . produplicate
+  {-# INLINE left' #-}
+
+instance Category p => Category (TambaraSum p) where
+  id = TambaraSum id
+  TambaraSum p . TambaraSum q = TambaraSum (p . q)
+
+instance Profunctor p => Functor (TambaraSum p a) where
+  fmap = rmap
+
+-- |
+-- @
+-- 'tambaraSum' '.' 'untambaraSum' ≡ 'id'
+-- 'untambaraSum' '.' 'tambaraSum' ≡ 'id'
+-- @
+tambaraSum :: Choice p => (p :-> q) -> p :-> TambaraSum q
+tambaraSum f p = TambaraSum $ f $ left' p
+
+-- |
+-- @
+-- 'tambaraSum' '.' 'untambaraSum' ≡ 'id'
+-- 'untambaraSum' '.' 'tambaraSum' ≡ 'id'
+-- @
+untambaraSum :: Profunctor q => (p :-> TambaraSum q) -> p :-> q
+untambaraSum f p = dimap Left (\(Left a) -> a) $ runTambaraSum $ f p
+
+----------------------------------------------------------------------------
+-- * PastroSum
+----------------------------------------------------------------------------
+
+-- | PastroSum -| TambaraSum
+--
+-- PastroSum freely constructs strength with respect to Either.
+data PastroSum p a b where
+  PastroSum :: (Either y z -> b) -> p x y -> (a -> Either x z) -> PastroSum p a b
+
+instance Profunctor (PastroSum p) where
+  dimap f g (PastroSum l m r) = PastroSum (g . l) m (r . f)
+  lmap f (PastroSum l m r) = PastroSum l m (r . f)
+  rmap g (PastroSum l m r) = PastroSum (g . l) m r
+  w #. PastroSum l m r = PastroSum (w #. l) m r
+  PastroSum l m r .# w = PastroSum l m (r .# w)
+
+instance ProfunctorAdjunction PastroSum TambaraSum where
+  counit (PastroSum f (TambaraSum g) h) = dimap h f g
+  unit p = TambaraSum $ PastroSum id p id
+
+instance ProfunctorFunctor PastroSum where
+  promap f (PastroSum l m r) = PastroSum l (f m) r
+
+instance ProfunctorMonad PastroSum where
+  proreturn p = PastroSum (\(Left a)-> a) p Left
+  projoin (PastroSum l (PastroSum m n o) q) = PastroSum lm n oq where
+    oq a = case q a of
+      Left b -> Left <$> o b
+      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
+
+instance Choice (PastroSum p) where
+  left' (PastroSum l m r) = PastroSum l' m r' where
+    r' = either (fmap Left . r) (Right . Right)
+    l' (Left y)          = Left (l (Left y))
+    l' (Right (Left z))  = Left (l (Right z))
+    l' (Right (Right c)) = Right c
+  right' (PastroSum l m r) = PastroSum l' m r' where
+    r' = either (Right . Left) (fmap Right . r)
+    l' (Right (Left c))  = Left c
+    l' (Right (Right z)) = Right (l (Right z))
+    l' (Left y)          = Right (l (Left y))
+
+--------------------------------------------------------------------------------
+-- * Costrength for Either
+--------------------------------------------------------------------------------
+
+class Profunctor p => Cochoice p where
+  unleft  :: p (Either a d) (Either b d) -> p a b
+  unleft = unright . dimap (either Right Left) (either Right Left)
+
+  unright :: p (Either d a) (Either d b) -> p a b
+  unright = unleft . dimap (either Right Left) (either Right Left)
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
+  {-# MINIMAL unleft | unright #-}
+#endif
+
+instance Cochoice (->) where
+  unleft f = go . Left where go = either id (go . Right) . f
+  unright f = go . Right where go = either (go . Left) id . f
+
+instance Applicative f => Cochoice (Costar f) where
+  unleft (Costar f) = Costar (go . fmap Left)
+    where go = either id (go . pure . Right) . f
+
+-- NB: Another instance that's highly questionable
+instance Traversable f => Cochoice (Star f) where
+  unright (Star f) = Star (go . Right)
+    where go = either (go . Left) id . sequence . f
+
+instance (Functor f, Cochoice p) => Cochoice (Tannen f p) where
+  unleft (Tannen fp) = Tannen (fmap unleft fp)
+  {-# INLINE unleft #-}
+  unright (Tannen fp) = Tannen (fmap unright fp)
+  {-# INLINE unright #-}
+
+instance (Cochoice p, Cochoice q) => Cochoice (Product p q) where
+  unleft (Pair p q) = Pair (unleft p) (unleft q)
+  unright (Pair p q) = Pair (unright p) (unright q)
+
+----------------------------------------------------------------------------
+-- * CotambaraSum
+----------------------------------------------------------------------------
+
+-- | 'CotambaraSum' cofreely constructs costrength with respect to 'Either' (aka 'Choice')
+data CotambaraSum q a b where
+    CotambaraSum :: Cochoice r => (r :-> q) -> r a b -> CotambaraSum q a b
+
+instance Profunctor (CotambaraSum p) where
+  lmap f (CotambaraSum n p) = CotambaraSum n (lmap f p)
+  rmap g (CotambaraSum n p) = CotambaraSum n (rmap g p)
+  dimap f g (CotambaraSum n p) = CotambaraSum n (dimap f g p)
+
+instance ProfunctorFunctor CotambaraSum where
+  promap f (CotambaraSum n p) = CotambaraSum (f . n) p
+
+instance ProfunctorComonad CotambaraSum where
+  proextract (CotambaraSum n p)  = n p
+  produplicate (CotambaraSum n p) = CotambaraSum id (CotambaraSum n p)
+
+instance Cochoice (CotambaraSum p) where
+  unleft (CotambaraSum n p) = CotambaraSum n (unleft p)
+  unright (CotambaraSum n p) = CotambaraSum n (unright p)
+
+instance Functor (CotambaraSum p a) where
+  fmap = rmap
+
+-- |
+-- @
+-- 'cotambaraSum' '.' 'uncotambaraSum' ≡ 'id'
+-- 'uncotambaraSum' '.' 'cotambaraSum' ≡ 'id'
+-- @
+cotambaraSum :: Cochoice p => (p :-> q) -> p :-> CotambaraSum q
+cotambaraSum = CotambaraSum
+
+-- |
+-- @
+-- 'cotambaraSum' '.' 'uncotambaraSum' ≡ 'id'
+-- 'uncotambaraSum' '.' 'cotambaraSum' ≡ 'id'
+-- @
+uncotambaraSum :: Profunctor q => (p :-> CotambaraSum q) -> p :-> q
+uncotambaraSum f p = proextract (f p)
+
+----------------------------------------------------------------------------
+-- * Copastro
+----------------------------------------------------------------------------
+
+-- | CopastroSum -| CotambaraSum
+--
+-- 'CopastroSum' freely constructs costrength with respect to 'Either' (aka 'Choice')
+newtype CopastroSum p a b = CopastroSum { runCopastroSum :: forall r. Cochoice r => (forall x y. p x y -> r x y) -> r a b }
+
+instance Profunctor (CopastroSum p) where
+  dimap f g (CopastroSum h) = CopastroSum $ \ n -> dimap f g (h n)
+  lmap f (CopastroSum h) = CopastroSum $ \ n -> lmap f (h n)
+  rmap g (CopastroSum h) = CopastroSum $ \ n -> rmap g (h n)
+
+instance ProfunctorAdjunction CopastroSum CotambaraSum where
+ unit p = CotambaraSum id (proreturn p)
+ counit (CopastroSum h) = proextract (h id)
+
+instance ProfunctorFunctor CopastroSum where
+  promap f (CopastroSum h) = CopastroSum $ \n -> h (n . f)
+
+instance ProfunctorMonad CopastroSum where
+  proreturn p = CopastroSum $ \n -> n p
+  projoin p = CopastroSum $ \c -> runCopastroSum p (\x -> runCopastroSum x c)
+
+instance Cochoice (CopastroSum p) where
+  unleft (CopastroSum p) = CopastroSum $ \n -> unleft (p n)
+  unright (CopastroSum p) = CopastroSum $ \n -> unright (p n)
diff --git a/src/Data/Profunctor/Closed.hs b/src/Data/Profunctor/Closed.hs
--- a/src/Data/Profunctor/Closed.hs
+++ b/src/Data/Profunctor/Closed.hs
@@ -3,29 +3,45 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708
+
+#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 708
 {-# LANGUAGE Trustworthy #-}
 #endif
 
+-----------------------------------------------------------------------------
+-- |
+-- 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.Closed
   ( Closed(..)
   , Closure(..)
   , close
   , unclose
   , Environment(..)
+  , curry'
   ) where
 
 import Control.Applicative
 import Control.Arrow
 import Control.Category
 import Control.Comonad
+import Data.Bifunctor.Product (Product(..))
+import Data.Bifunctor.Tannen (Tannen(..))
 import Data.Distributive
-import Data.Monoid
-import Data.Profunctor
+import Data.Monoid hiding (Product)
 import Data.Profunctor.Adjunction
 import Data.Profunctor.Monad
+import Data.Profunctor.Strong
+import Data.Profunctor.Types
 import Data.Profunctor.Unsafe
 import Data.Tagged
+import Data.Tuple
 import Prelude hiding ((.),id)
 
 --------------------------------------------------------------------------------
@@ -56,9 +72,18 @@
 instance (Distributive f, Monad f) => Closed (Kleisli f) where
   closed (Kleisli afb) = Kleisli $ \xa -> distribute $ \x -> afb (xa x)
 
+instance (Closed p, Closed q) => Closed (Product p q) where
+  closed (Pair p q) = Pair (closed p) (closed q)
+
+instance (Functor f, Closed p) => Closed (Tannen f p) where
+  closed (Tannen fp) = Tannen (fmap closed fp)
+
 -- instance Monoid r => Closed (Forget r) where
 --  closed _ = Forget $ \_ -> mempty
 
+curry' :: Closed p => p (a, b) c -> p a (b -> c)
+curry' = lmap (,) . closed
+
 --------------------------------------------------------------------------------
 -- * Closure
 --------------------------------------------------------------------------------
@@ -150,7 +175,7 @@
 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
+instance 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
@@ -169,3 +194,8 @@
 instance ProfunctorAdjunction Environment Closure where
   counit (Environment g (Closure p) f) = dimap f g p
   unit p = Closure (Environment id p id)
+
+instance Closed (Environment p) where
+  closed (Environment l m r) = Environment l' m r' where
+    r' wa (z,w) = r (wa w) z
+    l' zx2y x = l (\z -> zx2y (z,x))
diff --git a/src/Data/Profunctor/Codensity.hs b/src/Data/Profunctor/Codensity.hs
deleted file mode 100644
--- a/src/Data/Profunctor/Codensity.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE TypeFamilies #-}
-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708
-{-# 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
@@ -11,7 +11,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Profunctor.Composition
--- Copyright   :  (C) 2014 Edward Kmett
+-- Copyright   :  (C) 2014-2015 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
@@ -28,6 +28,9 @@
   , idl
   , idr
   , assoc
+  -- * Categories as monoid objects
+  , eta
+  , mu
   -- * Generalized Composition
   , stars, kleislis
   , costars, cokleislis
@@ -43,7 +46,6 @@
 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.Sieve
@@ -227,6 +229,7 @@
 ----------------------------------------------------------------------------
 -- * 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 }
 
@@ -272,3 +275,16 @@
   unit q = Rift $ \p -> Procompose p q
 
 --instance (ProfunctorAdjunction f g, ProfunctorAdjunction f' g') => ProfunctorAdjunction (ProfunctorCompose f' f) (ProfunctorCompose g g') where
+
+----------------------------------------------------------------------------
+-- * Monoids
+----------------------------------------------------------------------------
+
+
+-- | a 'Category' that is also a 'Profunctor' is a 'Monoid' in @Prof@
+
+eta :: (Profunctor p, Category p) => (->) :-> p
+eta f = rmap f id
+
+mu :: Category p => Procompose p p :-> p
+mu (Procompose f g) = f . g
diff --git a/src/Data/Profunctor/Mapping.hs b/src/Data/Profunctor/Mapping.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Mapping.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+module Data.Profunctor.Mapping
+  ( Mapping(..)
+  , CofreeMapping(..)
+  , FreeMapping(..)
+  -- * Closed in terms of Mapping
+  , traverseMapping
+  , closedMapping
+  ) where
+
+import Control.Arrow (Kleisli(..))
+import Data.Distributive
+import Data.Functor.Compose
+import Data.Functor.Identity
+import Data.Profunctor.Choice
+import Data.Profunctor.Closed
+import Data.Profunctor.Monad
+import Data.Profunctor.Strong
+import Data.Profunctor.Traversing
+import Data.Profunctor.Types
+import Data.Profunctor.Unsafe
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative
+#endif
+
+class (Traversing p, Closed p) => Mapping p where
+  map' :: Functor f => p a b -> p (f a) (f b)
+
+instance Mapping (->) where
+  map' = fmap
+
+instance (Monad m, Distributive m) => Mapping (Kleisli m) where
+  map' (Kleisli f) = Kleisli (collect f)
+
+-- see <https://github.com/ekmett/distributive/issues/12>
+instance (Applicative m, Distributive m) => Mapping (Star m) where
+  map' (Star f) = Star (collect f)
+
+traverseMapping :: (Mapping p, Functor f) => p a b -> p (f a) (f b)
+traverseMapping = map'
+
+closedMapping :: Mapping p => p a b -> p (x -> a) (x -> b)
+closedMapping = map'
+
+newtype CofreeMapping p a b = CofreeMapping { runCofreeMapping :: forall f. Functor f => p (f a) (f b) }
+
+instance Profunctor p => Profunctor (CofreeMapping p) where
+  lmap f (CofreeMapping p) = CofreeMapping (lmap (fmap f) p)
+  rmap g (CofreeMapping p) = CofreeMapping (rmap (fmap g) p)
+  dimap f g (CofreeMapping p) = CofreeMapping (dimap (fmap f) (fmap g) p)
+
+instance Profunctor p => Strong (CofreeMapping p) where
+  second' = map'
+
+instance Profunctor p => Choice (CofreeMapping p) where
+  right' = map'
+
+instance Profunctor p => Closed (CofreeMapping p) where
+  closed = map'
+
+instance Profunctor p => Traversing (CofreeMapping p) where
+  traverse' = map'
+
+instance Profunctor p => Mapping (CofreeMapping p) where
+  -- !@(#*&() Compose isn't representational in its second arg or we could use #. and .#
+  map' (CofreeMapping p) = CofreeMapping (dimap Compose getCompose p)
+
+instance ProfunctorFunctor CofreeMapping where
+  promap f (CofreeMapping p) = CofreeMapping (f p)
+
+instance ProfunctorComonad CofreeMapping where
+  proextract (CofreeMapping p) = runIdentity #. p .# Identity
+  produplicate (CofreeMapping p) = CofreeMapping (CofreeMapping (dimap Compose getCompose p))
+
+-- | @FreeMapping -| CofreeMapping@
+data FreeMapping p a b where
+  FreeMapping :: Functor f => (f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
+
+instance Profunctor (FreeMapping p) where
+  lmap f (FreeMapping l m r) = FreeMapping l m (r . f)
+  rmap g (FreeMapping l m r) = FreeMapping (g . l) m r
+  dimap f g (FreeMapping l m r) = FreeMapping (g . l) m (r . f)
+  g #. FreeMapping l m r = FreeMapping (g #. l) m r
+  FreeMapping l m r .# f = FreeMapping l m (r .# f)
+
+instance Strong (FreeMapping p) where
+  second' = map'
+
+instance Choice (FreeMapping p) where
+  right' = map'
+
+instance Closed (FreeMapping p) where
+  closed = map'
+
+instance Traversing (FreeMapping p) where
+  traverse' = map'
+
+instance Mapping (FreeMapping p) where
+  map' (FreeMapping l m r) = FreeMapping (fmap l .# getCompose) m (Compose #. fmap r)
+
+instance ProfunctorFunctor FreeMapping where
+  promap f (FreeMapping l m r) = FreeMapping l (f m) r
+
+instance ProfunctorMonad FreeMapping where
+  proreturn p = FreeMapping runIdentity p Identity
+  projoin (FreeMapping l (FreeMapping l' m r') r) = FreeMapping ((l . fmap l') .# getCompose) m (Compose #. (fmap r' . r))
diff --git a/src/Data/Profunctor/Monad.hs b/src/Data/Profunctor/Monad.hs
--- a/src/Data/Profunctor/Monad.hs
+++ b/src/Data/Profunctor/Monad.hs
@@ -1,16 +1,62 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeOperators #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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.Monad where
 
-import Data.Profunctor
+import Control.Comonad
+import Data.Bifunctor.Tannen
+import Data.Bifunctor.Product
+import Data.Bifunctor.Sum
+import Data.Profunctor.Types
 
 class ProfunctorFunctor t where
   promap    :: Profunctor p => (p :-> q) -> t p :-> t q
 
+instance Functor f => ProfunctorFunctor (Tannen f) where
+  promap f (Tannen g) = Tannen (fmap f g)
+
+instance ProfunctorFunctor (Product p) where
+  promap f (Pair p q) = Pair p (f q)
+
+instance ProfunctorFunctor (Sum p) where
+  promap _ (L2 p) = L2 p
+  promap f (R2 q) = R2 (f q)
+
 class ProfunctorFunctor t => ProfunctorMonad t where
   proreturn :: Profunctor p => p :-> t p
   projoin   :: Profunctor p => t (t p) :-> t p
 
+#if __GLASGOW_HASKELL__ < 710
+instance (Functor f, Monad f) => ProfunctorMonad (Tannen f) where
+#else
+instance Monad f => ProfunctorMonad (Tannen f) where
+#endif
+  proreturn = Tannen . return
+  projoin (Tannen m) = Tannen $ m >>= runTannen
+
+instance ProfunctorMonad (Sum p) where
+  proreturn = R2
+  projoin (L2 p) = L2 p
+  projoin (R2 m) = m
+
 class ProfunctorFunctor t => ProfunctorComonad t where
   proextract :: Profunctor p => t p :-> p
   produplicate :: Profunctor p => t p :-> t (t p)
+
+instance Comonad f => ProfunctorComonad (Tannen f) where
+  proextract = extract . runTannen
+  produplicate (Tannen w) = Tannen $ extend Tannen w
+
+instance ProfunctorComonad (Product p) where
+  proextract (Pair _ q) = q
+  produplicate pq@(Pair p _) = Pair p pq
diff --git a/src/Data/Profunctor/Monoid.hs b/src/Data/Profunctor/Monoid.hs
deleted file mode 100644
--- a/src/Data/Profunctor/Monoid.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Data.Profunctor.Monoid where
-
-import Control.Category
-import Data.Profunctor
-import Data.Profunctor.Composition
-
--- | a 'Category' that is also a 'Profunctor' is a 'Monoid' in @Prof@
-
-eta :: (Profunctor p, Category p) => (->) :-> p
-eta f = rmap f id
-
-mu :: Category p => Procompose p p :-> p
-mu (Procompose f g) = f . g
diff --git a/src/Data/Profunctor/Ran.hs b/src/Data/Profunctor/Ran.hs
--- a/src/Data/Profunctor/Ran.hs
+++ b/src/Data/Profunctor/Ran.hs
@@ -7,7 +7,7 @@
 #endif
 -----------------------------------------------------------------------------
 -- |
--- Copyright   :  (C) 2013-2014 Edward Kmett and Dan Doel
+-- Copyright   :  (C) 2013-2015 Edward Kmett and Dan Doel
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
@@ -21,6 +21,8 @@
   , precomposeRan
   , curryRan
   , uncurryRan
+  , Codensity(..)
+  , decomposeCodensity
   ) where
 
 import Control.Category
@@ -30,6 +32,10 @@
 import Data.Profunctor.Unsafe
 import Prelude hiding (id,(.))
 
+--------------------------------------------------------------------------------
+-- * Ran
+--------------------------------------------------------------------------------
+
 -- | 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 }
 
@@ -81,3 +87,36 @@
 uncurryRan :: (p :-> Ran q r) -> Procompose p q :-> r
 uncurryRan f (Procompose p q) = runRan (f p) q
 {-# INLINE uncurryRan #-}
+
+--------------------------------------------------------------------------------
+-- * Codensity
+--------------------------------------------------------------------------------
+
+-- | 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/Rep.hs b/src/Data/Profunctor/Rep.hs
--- a/src/Data/Profunctor/Rep.hs
+++ b/src/Data/Profunctor/Rep.hs
@@ -30,6 +30,7 @@
   , Corepresentable(..)
   , cotabulated
   , unfirstCorep, unsecondCorep
+  , closedCorep
   -- * Prep -| Star
   , Prep(..)
   , prepAdj
@@ -89,7 +90,14 @@
   tabulate = Forget . (getConst .)
   {-# INLINE tabulate #-}
 
+{- TODO: coproducts and products
+instance (Representable p, Representable q) => Representable (Bifunctor.Product p q)
+  type Rep (Bifunctor.Product p q) = Functor.Product p q
 
+instance (Corepresentable p, Corepresentable q) => Corepresentable (Bifunctor.Product p q) where
+  type Rep (Bifunctor.Product p q) = Functor.Sum p q
+-}
+
 type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
 
 -- | 'tabulate' and 'sieve' form two halves of an isomorphism.
@@ -109,15 +117,19 @@
   type Corep p :: * -> *
   cotabulate :: (Corep p d -> c) -> p d c
 
--- | Default definition for 'unfirst' given that p is 'Corepresentable'.
+-- | Default definition for 'unfirst' given that @p@ is 'Corepresentable'.
 unfirstCorep :: Corepresentable p => p (a, d) (b, d) -> p a b
 unfirstCorep p = cotabulate f
   where f fa = b where (b, d) = cosieve p ((\a -> (a, d)) <$> fa)
 
--- | Default definition for 'unsecond' given that p is 'Corepresentable'.
+-- | Default definition for 'unsecond' given that @p@ is 'Corepresentable'.
 unsecondCorep :: Corepresentable p => p (d, a) (d, b) -> p a b
 unsecondCorep p = cotabulate f
   where f fa = b where (d, b) = cosieve p ((,) d <$> fa)
+
+-- | Default definition for 'closed' given that @p@ is 'Corepresentable'
+closedCorep :: Corepresentable p => p a b -> p (x -> a) (x -> b)
+closedCorep p = cotabulate $ \fs x -> cosieve p (fmap ($x) fs)
 
 instance Corepresentable (->) where
   type Corep (->) = Identity
diff --git a/src/Data/Profunctor/Strong.hs b/src/Data/Profunctor/Strong.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Strong.hs
@@ -0,0 +1,390 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 708
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) 2014-2015 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  Rank2Types
+--
+----------------------------------------------------------------------------
+module Data.Profunctor.Strong
+  (
+  -- * Strength
+    Strong(..)
+  , uncurry'
+  , Tambara(..)
+  , tambara, untambara
+  , Pastro(..)
+  -- * Costrength
+  , Costrong(..)
+  , Cotambara(..)
+  , cotambara, uncotambara
+  , Copastro(..)
+  ) where
+
+import Control.Applicative hiding (WrappedArrow(..))
+import Control.Arrow
+import Control.Category
+import Control.Comonad
+import Control.Monad (liftM)
+import Control.Monad.Fix
+import Data.Bifunctor.Clown (Clown(..))
+import Data.Bifunctor.Product (Product(..))
+import Data.Bifunctor.Tannen (Tannen(..))
+import Data.Functor.Contravariant (Contravariant(..))
+import Data.Monoid hiding (Product)
+import Data.Profunctor.Adjunction
+import Data.Profunctor.Monad
+import Data.Profunctor.Types
+import Data.Profunctor.Unsafe
+import Data.Tagged
+import Data.Tuple
+import Prelude hiding (id,(.))
+
+------------------------------------------------------------------------------
+-- Strong
+------------------------------------------------------------------------------
+
+-- | Generalizing 'Star' of a strong 'Functor'
+--
+-- /Note:/ Every 'Functor' in Haskell is strong with respect to @(,)@.
+--
+-- This describes profunctor strength with respect to the product structure
+-- of Hask.
+--
+-- <http://www-kb.is.s.u-tokyo.ac.jp/~asada/papers/arrStrMnd.pdf>
+class Profunctor p => Strong p where
+  first' :: p a b  -> p (a, c) (b, c)
+  first' = dimap swap swap . second'
+
+  second' :: p a b -> p (c, a) (c, b)
+  second' = dimap swap swap . first'
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
+  {-# MINIMAL first' | second' #-}
+#endif
+
+uncurry' :: Strong p => p a (b -> c) -> p (a, b) c
+uncurry' = rmap (\(f,x) -> f x) . first'
+{-# INLINE uncurry' #-}
+
+instance Strong (->) where
+  first' ab ~(a, c) = (ab a, c)
+  {-# INLINE first' #-}
+  second' ab ~(c, a) = (c, ab a)
+
+instance Monad m => Strong (Kleisli m) where
+  first' (Kleisli f) = Kleisli $ \ ~(a, c) -> do
+     b <- f a
+     return (b, c)
+  {-# INLINE first' #-}
+  second' (Kleisli f) = Kleisli $ \ ~(c, a) -> do
+     b <- f a
+     return (c, b)
+  {-# INLINE second' #-}
+
+instance Functor m => Strong (Star m) where
+  first' (Star f) = Star $ \ ~(a, c) -> (\b' -> (b', c)) <$> f a
+  {-# INLINE first' #-}
+  second' (Star f) = Star $ \ ~(c, a) -> (,) c <$> f a
+  {-# INLINE second' #-}
+
+-- | 'Arrow' is 'Strong' 'Category'
+instance Arrow p => Strong (WrappedArrow p) where
+  first' (WrapArrow k) = WrapArrow (first k)
+  {-# INLINE first' #-}
+  second' (WrapArrow k) = WrapArrow (second k)
+  {-# INLINE second' #-}
+
+instance Strong (Forget r) where
+  first' (Forget k) = Forget (k . fst)
+  {-# INLINE first' #-}
+  second' (Forget k) = Forget (k . snd)
+  {-# INLINE second' #-}
+
+instance Contravariant f => Strong (Clown f) where
+  first' (Clown fa) = Clown (contramap fst fa)
+  {-# INLINE first' #-}
+  second' (Clown fa) = Clown (contramap snd fa)
+  {-# INLINE second' #-}
+
+instance (Strong p, Strong q) => Strong (Product p q) where
+  first' (Pair p q) = Pair (first' p) (first' q)
+  {-# INLINE first' #-}
+  second' (Pair p q) = Pair (second' p) (second' q)
+  {-# INLINE second' #-}
+
+instance (Functor f, Strong p) => Strong (Tannen f p) where
+  first' (Tannen fp) = Tannen (fmap first' fp)
+  {-# INLINE first' #-}
+  second' (Tannen fp) = Tannen (fmap second' fp)
+  {-# INLINE second' #-}
+
+----------------------------------------------------------------------------
+-- * Tambara
+----------------------------------------------------------------------------
+
+-- | 'Tambara' cofreely makes any 'Profunctor' 'Strong'.
+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 ProfunctorFunctor Tambara where
+  promap f (Tambara p) = Tambara (f p)
+
+instance ProfunctorComonad Tambara where
+  proextract (Tambara p) = dimap (\a -> (a,())) fst p
+  produplicate (Tambara p) = Tambara (Tambara $ dimap hither yon p) where
+    hither :: ((a, b), c) -> (a, (b, c))
+    hither ~(~(x,y),z) = (x,(y,z))
+
+    yon    :: (a, (b, c)) -> ((a, b), c)
+    yon    ~(x,~(y,z)) = ((x,y),z)
+
+instance Profunctor p => Strong (Tambara p) where
+  first' = runTambara . produplicate
+  {-# INLINE first' #-}
+
+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 :: ((a, b), c) -> ((a, c), b)
+    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 :: (Either a b, c) -> Either (a, c) (b, c)
+    hither (Left y, s) = Left (y, s)
+    hither (Right z, s) = Right (z, s)
+
+    yon :: Either (a, c) (b, c) -> (Either a b, c)
+    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 :: ((a, b), c) -> ((a, c), b)
+    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 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
+--
+-- @
+-- Pastro p ~ exists z. Costar ((,)z) `Procompose` p `Procompose` Star ((,)z)
+-- @
+--
+-- 'Pastro' freely makes any 'Profunctor' 'Strong'.
+data Pastro p a b where
+  Pastro :: ((y, z) -> b) -> p x y -> (a -> (x, z)) -> Pastro p a b
+
+instance 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 ProfunctorFunctor Pastro where
+  promap f (Pastro l m r) = Pastro l (f m) r
+
+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 ProfunctorAdjunction Pastro Tambara where
+  counit (Pastro g (Tambara p) f) = dimap f g p
+  unit p = Tambara (Pastro id p id)
+
+instance Strong (Pastro p) where
+  first' (Pastro l m r) = Pastro l' m r' where
+    r' (a,c) = case r a of
+      (x,z) -> (x,(z,c))
+    l' (y,(z,c)) = (l (y,z), c)
+  second' (Pastro l m r) = Pastro l' m r' where
+    r' (c,a) = case r a of
+      (x,z) -> (x,(c,z))
+    l' (y,(c,z)) = (c,l (y,z))
+
+--------------------------------------------------------------------------------
+-- * Costrength for (,)
+--------------------------------------------------------------------------------
+
+-- | Analogous to 'ArrowLoop', 'loop' = 'unfirst'
+class Profunctor p => Costrong p where
+  unfirst  :: p (a, d) (b, d) -> p a b
+  unfirst = unsecond . dimap swap swap
+
+  unsecond :: p (d, a) (d, b) -> p a b
+  unsecond = unfirst . dimap swap swap
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
+  {-# MINIMAL unfirst | unsecond #-}
+#endif
+
+instance Costrong (->) where
+  unfirst f a = b where (b, d) = f (a, d)
+  unsecond f a = b where (d, b) = f (d, a)
+
+instance Functor f => Costrong (Costar f) where
+  unfirst (Costar f) = Costar f'
+    where f' fa = b where (b, d) = f ((\a -> (a, d)) <$> fa)
+  unsecond (Costar f) = Costar f'
+    where f' fa = b where (d, b) = f ((,) d <$> fa)
+
+instance Costrong Tagged where
+  unfirst (Tagged bd) = Tagged (fst bd)
+  unsecond (Tagged db) = Tagged (snd db)
+
+instance ArrowLoop p => Costrong (WrappedArrow p) where
+  unfirst (WrapArrow k) = WrapArrow (loop k)
+
+instance MonadFix m => Costrong (Kleisli m) where
+  unfirst (Kleisli f) = Kleisli (liftM fst . mfix . f')
+    where f' x y = f (x, snd y)
+
+instance Functor f => Costrong (Cokleisli f) where
+  unfirst (Cokleisli f) = Cokleisli f'
+    where f' fa = b where (b, d) = f ((\a -> (a, d)) <$> fa)
+
+instance (Functor f, Costrong p) => Costrong (Tannen f p) where
+  unfirst (Tannen fp) = Tannen (fmap unfirst fp)
+  unsecond (Tannen fp) = Tannen (fmap unsecond fp)
+
+instance (Costrong p, Costrong q) => Costrong (Product p q) where
+  unfirst (Pair p q) = Pair (unfirst p) (unfirst q)
+  unsecond (Pair p q) = Pair (unsecond p) (unsecond q)
+
+----------------------------------------------------------------------------
+-- * Cotambara
+----------------------------------------------------------------------------
+
+-- | Cotambara cofreely constructs costrength
+data Cotambara q a b where
+    Cotambara :: Costrong r => (r :-> q) -> r a b -> Cotambara q a b
+
+instance Profunctor (Cotambara p) where
+  lmap f (Cotambara n p) = Cotambara n (lmap f p)
+  rmap g (Cotambara n p) = Cotambara n (rmap g p)
+  dimap f g (Cotambara n p) = Cotambara n (dimap f g p)
+
+instance ProfunctorFunctor Cotambara where
+  promap f (Cotambara n p) = Cotambara (f . n) p
+
+instance ProfunctorComonad Cotambara where
+  proextract (Cotambara n p)  = n p
+  produplicate (Cotambara n p) = Cotambara id (Cotambara n p)
+
+instance Costrong (Cotambara p) where
+  unfirst (Cotambara n p) = Cotambara n (unfirst p)
+
+instance Functor (Cotambara p a) where
+  fmap = rmap
+
+-- |
+-- @
+-- 'cotambara' '.' 'uncotambara' ≡ 'id'
+-- 'uncotambara' '.' 'cotambara' ≡ 'id'
+-- @
+cotambara :: Costrong p => (p :-> q) -> p :-> Cotambara q
+cotambara = Cotambara
+
+-- |
+-- @
+-- 'cotambara' '.' 'uncotambara' ≡ 'id'
+-- 'uncotambara' '.' 'cotambara' ≡ 'id'
+-- @
+uncotambara :: Profunctor q => (p :-> Cotambara q) -> p :-> q
+uncotambara f p = proextract (f p)
+
+----------------------------------------------------------------------------
+-- * Copastro
+----------------------------------------------------------------------------
+
+-- | Copastro -| Cotambara
+--
+-- Copastro freely constructs costrength
+newtype Copastro p a b = Copastro { runCopastro :: forall r. Costrong r => (forall x y. p x y -> r x y) -> r a b }
+
+instance Profunctor (Copastro p) where
+  dimap f g (Copastro h) = Copastro $ \ n -> dimap f g (h n)
+  lmap f (Copastro h) = Copastro $ \ n -> lmap f (h n)
+  rmap g (Copastro h) = Copastro $ \ n -> rmap g (h n)
+
+instance ProfunctorAdjunction Copastro Cotambara where
+ unit p = Cotambara id (proreturn p)
+ counit (Copastro h) = proextract (h id)
+
+instance ProfunctorFunctor Copastro where
+  promap f (Copastro h) = Copastro $ \n -> h (n . f)
+
+instance ProfunctorMonad Copastro where
+  proreturn p = Copastro $ \n -> n p
+  projoin p = Copastro $ \c -> runCopastro p (\x -> runCopastro x c)
+
+instance Costrong (Copastro p) where
+  unfirst (Copastro p) = Copastro $ \n -> unfirst (p n)
+  unsecond (Copastro p) = Copastro $ \n -> unsecond (p n)
diff --git a/src/Data/Profunctor/Tambara.hs b/src/Data/Profunctor/Tambara.hs
deleted file mode 100644
--- a/src/Data/Profunctor/Tambara.hs
+++ /dev/null
@@ -1,261 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708
-{-# 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 ProfunctorFunctor Tambara where
-  promap f (Tambara p) = Tambara (f p)
-
-instance ProfunctorComonad Tambara where
-  proextract (Tambara p) = dimap (\a -> (a,())) fst p
-  produplicate (Tambara p) = Tambara (Tambara $ dimap hither yon p) where
-    hither :: ((a, b), c) -> (a, (b, c))
-    hither ~(~(x,y),z) = (x,(y,z))
-
-    yon    :: (a, (b, c)) -> ((a, b), c)
-    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 :: (Either a b, c) -> Either (a, c) (b, c)
-    hither (Left y, s) = Left (y, s)
-    hither (Right z, s) = Right (z, s)
-
-    yon :: Either (a, c) (b, c) -> (Either a b, c)
-    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 :: ((a, b), c) -> ((a, c), b)
-    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 :: (Either a b, c) -> Either (a, c) (b, c)
-    hither (Left y, s) = Left (y, s)
-    hither (Right z, s) = Right (z, s)
-
-    yon :: Either (a, c) (b, c) -> (Either a b, c)
-    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 :: ((a, b), c) -> ((a, c), b)
-    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
---
--- @
--- Pastro p ~ exists z. Costar ((,)z) `Procompose` p `Procompose` Star ((,)z)
--- @
-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 ProfunctorFunctor Pastro where
-  promap f (Pastro l m r) = Pastro l (f m) r
-
-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 ProfunctorAdjunction 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
---
--- Note: this is not dual to 'Tambara'. It is 'Tambara' with respect to a different tensor.
-newtype Cotambara p a b = Cotambara { runCotambara :: forall c. p (Either a c) (Either b c) }
-
-instance ProfunctorFunctor Cotambara where
-  promap f (Cotambara p) = Cotambara (f p)
-
-instance ProfunctorComonad Cotambara where
-  proextract (Cotambara p)   = dimap Left (\(Left a) -> a) p
-  produplicate (Cotambara p) = Cotambara (Cotambara $ dimap hither yon p) where
-    hither :: Either (Either a b) c -> Either a (Either b c)
-    hither (Left (Left x))   = Left x
-    hither (Left (Right y))  = Right (Left y)
-    hither (Right z)         = Right (Right z)
-
-    yon    :: Either a (Either b c) -> Either (Either a b) c
-    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 ProfunctorAdjunction Copastro Cotambara where
-  counit (Copastro f (Cotambara g) h) = dimap h f g
-  unit p = Cotambara $ Copastro id p id
-
-instance ProfunctorFunctor Copastro where
-  promap f (Copastro l m r) = Copastro l (f m) r
-
-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
diff --git a/src/Data/Profunctor/Trace.hs b/src/Data/Profunctor/Trace.hs
deleted file mode 100644
--- a/src/Data/Profunctor/Trace.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE GADTs #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Profunctor.Trace
--- Copyright   :  (C) 2011-2012 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  GADTs
---
-----------------------------------------------------------------------------
-module Data.Profunctor.Trace
-  ( Trace(..)
-  ) where
-
--- | Coend of 'Data.Profunctor.Profunctor' from @Hask -> Hask@.
-data Trace f where
-  Trace :: f a a -> Trace f
diff --git a/src/Data/Profunctor/Traversing.hs b/src/Data/Profunctor/Traversing.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Traversing.hs
@@ -0,0 +1,157 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DeriveFunctor #-}
+module Data.Profunctor.Traversing
+  ( Traversing(..)
+  , CofreeTraversing(..)
+  , FreeTraversing(..)
+  -- * Strong in terms of Traversing
+  , firstTraversing
+  , secondTraversing
+  -- * Choice in terms of Traversing
+  , leftTraversing
+  , rightTraversing
+  ) where
+
+import Control.Applicative
+import Control.Arrow (Kleisli(..))
+import Data.Functor.Compose
+import Data.Functor.Identity
+import Data.Orphans ()
+import Data.Profunctor.Choice
+import Data.Profunctor.Monad
+import Data.Profunctor.Strong
+import Data.Profunctor.Types
+import Data.Profunctor.Unsafe
+import Data.Traversable
+import Data.Tuple (swap)
+
+#if __GLASGOW_HASKELL__ < 710
+import Data.Foldable
+import Prelude hiding (mapM)
+#endif
+
+firstTraversing :: Traversing p => p a b -> p (a, c) (b, c)
+firstTraversing = dimap swap swap . traverse'
+
+secondTraversing :: Traversing p => p a b -> p (c, a) (c, b)
+secondTraversing = traverse'
+
+swapE :: Either a b -> Either b a
+swapE = either Right Left
+
+leftTraversing :: Traversing p => p a b -> p (Either a c) (Either b c)
+leftTraversing = dimap swapE swapE . traverse'
+
+rightTraversing :: Traversing p => p a b -> p (Either c a) (Either c b)
+rightTraversing = traverse'
+
+newtype Bazaar a b t = Bazaar { runBazaar :: forall f. Applicative f => (a -> f b) -> f t }
+  deriving Functor
+
+instance Applicative (Bazaar a b) where
+  pure a = Bazaar $ \_ -> pure a
+  mf <*> ma = Bazaar $ \k -> runBazaar mf k <*> runBazaar ma k
+
+instance Profunctor (Bazaar a) where
+  dimap f g m = Bazaar $ \k -> g <$> runBazaar m (fmap f . k)
+
+sell :: a -> Bazaar a b b
+sell a = Bazaar $ \k -> k a
+
+newtype Baz t b a = Baz { runBaz :: forall f. Applicative f => (a -> f b) -> f t }
+  deriving Functor
+
+-- bsell :: a -> Baz b b a
+-- bsell a = Baz $ \k -> k a
+
+-- aar :: Bazaar a b t -> Baz t b a
+-- aar (Bazaar f) = Baz f
+
+sold :: Baz t a a -> t
+sold m = runIdentity (runBaz m Identity)
+
+instance Foldable (Baz t b) where
+  foldMap = foldMapDefault
+
+instance Traversable (Baz t b) where
+  traverse f bz = fmap (\m -> Baz (runBazaar m)) . getCompose . runBaz bz $ \x -> Compose $ sell <$> f x
+
+instance Profunctor (Baz t) where
+  dimap f g m = Baz $ \k -> runBaz m (fmap f . k . g)
+
+-- | Note: Definitions in terms of 'wander' are much more efficient!
+class (Choice p, Strong p) => Traversing p where
+  traverse' :: Traversable f => p a b -> p (f a) (f b)
+  traverse' = wander traverse
+
+  wander :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t
+  wander f pab = dimap (\s -> Baz $ \afb -> f afb s) sold (traverse' pab)
+
+#if __GLASGOW_HASKELL__ >= 706
+  {-# MINIMAL wander | traverse' #-}
+#endif
+
+instance Traversing (->) where
+  traverse' = fmap
+  wander f ab = runIdentity #. f (Identity #. ab)
+
+instance Monad m => Traversing (Kleisli m) where
+  traverse' (Kleisli m) = Kleisli (mapM m)
+  wander f (Kleisli amb) = Kleisli $ unwrapMonad #. f (WrapMonad #. amb)
+
+instance Applicative m => Traversing (Star m) where
+  traverse' (Star m) = Star (traverse m)
+  wander f (Star amb) = Star (f amb)
+
+newtype CofreeTraversing p a b = CofreeTraversing { runCofreeTraversing :: forall f. Traversable f => p (f a) (f b) }
+
+instance Profunctor p => Profunctor (CofreeTraversing p) where
+  lmap f (CofreeTraversing p) = CofreeTraversing (lmap (fmap f) p)
+  rmap g (CofreeTraversing p) = CofreeTraversing (rmap (fmap g) p)
+  dimap f g (CofreeTraversing p) = CofreeTraversing (dimap (fmap f) (fmap g) p)
+
+instance Profunctor p => Strong (CofreeTraversing p) where
+  second' = traverse'
+
+instance Profunctor p => Choice (CofreeTraversing p) where
+  right' = traverse'
+
+instance Profunctor p => Traversing (CofreeTraversing p) where
+  -- !@(#*&() Compose isn't representational in its second arg or we could use #. and .#
+  traverse' (CofreeTraversing p) = CofreeTraversing (dimap Compose getCompose p)
+
+instance ProfunctorFunctor CofreeTraversing where
+  promap f (CofreeTraversing p) = CofreeTraversing (f p)
+
+instance ProfunctorComonad CofreeTraversing where
+  proextract (CofreeTraversing p) = runIdentity #. p .# Identity
+  produplicate (CofreeTraversing p) = CofreeTraversing (CofreeTraversing (dimap Compose getCompose p))
+
+-- | @FreeTraversing -| CofreeTraversing@
+data FreeTraversing p a b where
+  FreeTraversing :: Traversable f => (f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b
+
+instance Profunctor (FreeTraversing p) where
+  lmap f (FreeTraversing l m r) = FreeTraversing l m (r . f)
+  rmap g (FreeTraversing l m r) = FreeTraversing (g . l) m r
+  dimap f g (FreeTraversing l m r) = FreeTraversing (g . l) m (r . f)
+  g #. FreeTraversing l m r = FreeTraversing (g #. l) m r
+  FreeTraversing l m r .# f = FreeTraversing l m (r .# f)
+
+instance Strong (FreeTraversing p) where
+  second' = traverse'
+
+instance Choice (FreeTraversing p) where
+  right' = traverse'
+
+instance Traversing (FreeTraversing p) where
+  traverse' (FreeTraversing l m r) = FreeTraversing (fmap l .# getCompose) m (Compose #. fmap r)
+
+instance ProfunctorFunctor FreeTraversing where
+  promap f (FreeTraversing l m r) = FreeTraversing l (f m) r
+
+instance ProfunctorMonad FreeTraversing where
+  proreturn p = FreeTraversing runIdentity p Identity
+  projoin (FreeTraversing l (FreeTraversing l' m r') r) = FreeTraversing ((l . fmap l') .# getCompose) m (Compose #. (fmap r' . r))
diff --git a/src/Data/Profunctor/Types.hs b/src/Data/Profunctor/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Profunctor/Types.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 708
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (C) 2011-2015 Edward Kmett,
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- For a good explanation of profunctors in Haskell see Dan Piponi's article:
+--
+-- <http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html>
+--
+-- For more information on strength and costrength, see:
+--
+-- <http://comonad.com/reader/2008/deriving-strength-from-laziness/>
+----------------------------------------------------------------------------
+module Data.Profunctor.Types
+  ( Profunctor(dimap, lmap, rmap)
+  , Star(..)
+  , Costar(..)
+  , WrappedArrow(..)
+  , Forget(..)
+#ifndef HLINT
+  , (:->)
+#endif
+  ) where
+
+import Control.Applicative hiding (WrappedArrow(..))
+import Control.Arrow
+import Control.Category
+import Control.Comonad
+import Control.Monad (MonadPlus(..))
+import Data.Distributive
+import Data.Foldable
+import Data.Monoid hiding (Product)
+import Data.Profunctor.Unsafe
+import Data.Traversable
+import Prelude hiding (id,(.),sequence)
+
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Coerce
+#else
+import Unsafe.Coerce
+#endif
+
+infixr 0 :->
+type p :-> q = forall a b. p a b -> q a b
+
+------------------------------------------------------------------------------
+-- Star
+------------------------------------------------------------------------------
+
+-- | Lift a 'Functor' into a 'Profunctor' (forwards).
+newtype Star f d c = Star { runStar :: d -> f c }
+
+instance Functor f => Profunctor (Star f) where
+  dimap ab cd (Star bfc) = Star (fmap cd . bfc . ab)
+  {-# INLINE dimap #-}
+  lmap k (Star f) = Star (f . k)
+  {-# INLINE lmap #-}
+  rmap k (Star f) = Star (fmap k . f)
+  {-# INLINE rmap #-}
+  -- We cannot safely overload ( #. ) because we didn't write the 'Functor'.
+#if __GLASGOW_HASKELL__ >= 708
+  p .# _ = coerce p
+#else
+  p .# _ = unsafeCoerce p
+#endif
+  {-# INLINE ( .# ) #-}
+
+instance Functor f => Functor (Star f a) where
+  fmap = rmap
+  {-# INLINE fmap #-}
+
+instance Applicative f => Applicative (Star f a) where
+  pure a = Star $ \_ -> pure a
+  Star ff <*> Star fx = Star $ \a -> ff a <*> fx a
+  Star ff  *> Star fx = Star $ \a -> ff a  *> fx a
+  Star ff <*  Star fx = Star $ \a -> ff a <*  fx a
+
+instance Alternative f => Alternative (Star f a) where
+  empty = Star $ \_ -> empty
+  Star f <|> Star g = Star $ \a -> f a <|> g a
+
+instance Monad f => Monad (Star f a) where
+#if __GLASGOW_HASKELL__ < 710
+  return a = Star $ \_ -> return a
+#endif
+  Star m >>= f = Star $ \ e -> do
+    a <- m e
+    runStar (f a) e
+
+instance MonadPlus f => MonadPlus (Star f a) where
+  mzero = Star $ \_ -> mzero
+  Star f `mplus` Star g = Star $ \a -> f a `mplus` g a
+
+instance Distributive f => Distributive (Star f a) where
+  distribute fs = Star $ \a -> collect (($ a) .# runStar) fs
+
+------------------------------------------------------------------------------
+-- Costar
+------------------------------------------------------------------------------
+
+-- | Lift a 'Functor' into a 'Profunctor' (backwards).
+newtype Costar f d c = Costar { runCostar :: f d -> c }
+
+instance Functor f => Profunctor (Costar f) where
+  dimap ab cd (Costar fbc) = Costar (cd . fbc . fmap ab)
+  {-# INLINE dimap #-}
+  lmap k (Costar f) = Costar (f . fmap k)
+  {-# INLINE lmap #-}
+  rmap k (Costar f) = Costar (k . f)
+  {-# INLINE rmap #-}
+#if __GLASGOW_HASKELL__ >= 708
+  ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b
+#else
+  ( #. ) _ = unsafeCoerce
+#endif
+  {-# INLINE ( #. ) #-}
+  -- We cannot overload ( .# ) because we didn't write the 'Functor'.
+
+instance Distributive (Costar f d) where
+  distribute fs = Costar $ \gd -> fmap (($ gd) .# runCostar) fs
+
+instance Functor (Costar f a) where
+  fmap k (Costar f) = Costar (k . f)
+  {-# INLINE fmap #-}
+  a <$ _ = Costar $ \_ -> a
+  {-# INLINE (<$) #-}
+
+instance Applicative (Costar f a) where
+  pure a = Costar $ \_ -> a
+  Costar ff <*> Costar fx = Costar $ \a -> ff a (fx a)
+  _ *> m = m
+  m <* _ = m
+
+instance Monad (Costar f a) where
+  return = pure
+  Costar m >>= f = Costar $ \ x -> runCostar (f (m x)) x
+
+------------------------------------------------------------------------------
+-- Wrapped Profunctors
+------------------------------------------------------------------------------
+
+-- | Wrap an arrow for use as a 'Profunctor'.
+newtype WrappedArrow p a b = WrapArrow { unwrapArrow :: p a b }
+
+instance Category p => Category (WrappedArrow p) where
+  WrapArrow f . WrapArrow g = WrapArrow (f . g)
+  {-# INLINE (.) #-}
+  id = WrapArrow id
+  {-# INLINE id #-}
+
+instance Arrow p => Arrow (WrappedArrow p) where
+  arr = WrapArrow . arr
+  {-# INLINE arr #-}
+  first = WrapArrow . first . unwrapArrow
+  {-# INLINE first #-}
+  second = WrapArrow . second . unwrapArrow
+  {-# INLINE second #-}
+  WrapArrow a *** WrapArrow b = WrapArrow (a *** b)
+  {-# INLINE (***) #-}
+  WrapArrow a &&& WrapArrow b = WrapArrow (a &&& b)
+  {-# INLINE (&&&) #-}
+
+instance ArrowZero p => ArrowZero (WrappedArrow p) where
+  zeroArrow = WrapArrow zeroArrow
+  {-# INLINE zeroArrow #-}
+
+instance ArrowChoice p => ArrowChoice (WrappedArrow p) where
+  left = WrapArrow . left . unwrapArrow
+  {-# INLINE left #-}
+  right = WrapArrow . right . unwrapArrow
+  {-# INLINE right #-}
+  WrapArrow a +++ WrapArrow b = WrapArrow (a +++ b)
+  {-# INLINE (+++) #-}
+  WrapArrow a ||| WrapArrow b = WrapArrow (a ||| b)
+  {-# INLINE (|||) #-}
+
+instance ArrowApply p => ArrowApply (WrappedArrow p) where
+  app = WrapArrow $ app . arr (first unwrapArrow)
+  {-# INLINE app #-}
+
+instance ArrowLoop p => ArrowLoop (WrappedArrow p) where
+  loop = WrapArrow . loop . unwrapArrow
+  {-# INLINE loop #-}
+
+instance Arrow p => Profunctor (WrappedArrow p) where
+  lmap = (^>>)
+  {-# INLINE lmap #-}
+  rmap = (^<<)
+  {-# INLINE rmap #-}
+  -- We cannot safely overload ( #. ) or ( .# ) because we didn't write the 'Arrow'.
+
+------------------------------------------------------------------------------
+-- Forget
+------------------------------------------------------------------------------
+
+newtype Forget r a b = Forget { runForget :: a -> r }
+
+instance Profunctor (Forget r) where
+  dimap f _ (Forget k) = Forget (k . f)
+  {-# INLINE dimap #-}
+  lmap f (Forget k) = Forget (k . f)
+  {-# INLINE lmap #-}
+  rmap _ (Forget k) = Forget k
+  {-# INLINE rmap #-}
+
+instance Functor (Forget r a) where
+  fmap _ (Forget k) = Forget k
+  {-# INLINE fmap #-}
+
+instance Foldable (Forget r a) where
+  foldMap _ _ = mempty
+  {-# INLINE foldMap #-}
+
+instance Traversable (Forget r a) where
+  traverse _ (Forget k) = pure (Forget k)
+  {-# INLINE traverse #-}
diff --git a/src/Data/Profunctor/Unsafe.hs b/src/Data/Profunctor/Unsafe.hs
--- a/src/Data/Profunctor/Unsafe.hs
+++ b/src/Data/Profunctor/Unsafe.hs
@@ -7,7 +7,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
--- Copyright   :  (C) 2011-2013 Edward Kmett
+-- Copyright   :  (C) 2011-2015 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
@@ -38,8 +38,14 @@
 import Control.Category
 import Control.Comonad (Cokleisli(..))
 import Control.Monad (liftM)
+import Data.Bifunctor.Biff (Biff(..))
 import Data.Bifunctor.Clown (Clown(..))
 import Data.Bifunctor.Joker (Joker(..))
+import Data.Bifunctor.Product (Product(..))
+import Data.Bifunctor.Tannen (Tannen(..))
+#if __GLASGOW_HASKELL__ < 710
+import Data.Functor
+#endif
 import Data.Functor.Contravariant (Contravariant(..))
 import Data.Tagged
 import Prelude hiding (id,(.),sequence)
@@ -258,3 +264,32 @@
   {-# INLINE rmap #-}
   dimap _ g (Joker fb) = Joker (fmap g fb)
   {-# INLINE dimap #-}
+
+instance (Profunctor p, Functor f, Functor g) => Profunctor (Biff p f g) where
+  lmap f (Biff p) = Biff (lmap (fmap f) p)
+  rmap g (Biff p) = Biff (rmap (fmap g) p)
+  dimap f g (Biff p) = Biff (dimap (fmap f) (fmap g) p)
+
+instance (Profunctor p, Profunctor q) => Profunctor (Product p q) where
+  lmap  f   (Pair p q) = Pair (lmap f p) (lmap f q)
+  {-# INLINE lmap #-}
+  rmap    g (Pair p q) = Pair (rmap g p) (rmap g q)
+  {-# INLINE rmap #-}
+  dimap f g (Pair p q) = Pair (dimap f g p) (dimap f g q)
+  {-# INLINE dimap #-}
+  ( #. ) f (Pair p q) = Pair (f #. p) (f #. q)
+  {-# INLINE ( #. ) #-}
+  ( .# ) (Pair p q) f = Pair (p .# f) (q .# f)
+  {-# INLINE ( .# ) #-}
+
+instance (Functor f, Profunctor p) => Profunctor (Tannen f p) where
+  lmap f (Tannen h) = Tannen (lmap f <$> h)
+  {-# INLINE lmap #-}
+  rmap g (Tannen h) = Tannen (rmap g <$> h)
+  {-# INLINE rmap #-}
+  dimap f g (Tannen h) = Tannen (dimap f g <$> h)
+  {-# INLINE dimap #-}
+  ( #. ) f (Tannen h) = Tannen ((f #.) <$> h)
+  {-# INLINE ( #. ) #-}
+  ( .# ) (Tannen h) f = Tannen ((.# f) <$> h)
+  {-# INLINE ( .# ) #-}