Adds profunctor encodings and minimal changes

DontFearTheProfunctorOptics.hs

@@ -101,3 +101,100 @@ newtype Traversal' s t a b = Traversal' { extract :: s -> FunList a b t }
 
 firstNSecond' :: Traversal' (a, a, c) (b, b, c) a b
 firstNSecond' = Traversal' (\(a1, a2, c) -> More a1 (More a2 (Done (,,c))))
+
+---------------------------------------------------
+-- Part II: Profunctors as Generalized Functions --
+---------------------------------------------------
+
+-- Functor
+
+-- class Functor f where
+--   fmap :: (a -> b) -> f a -> f b
+
+-- instance Functor ((->) r) where
+--   fmap f g = g . f
+
+-- Contravariant
+
+class Contravariant f where
+  cmap :: (b -> a) -> f a -> f b
+
+newtype CReader r a = CReader (a -> r)
+
+instance Contravariant (CReader r) where
+  cmap f (CReader g) = CReader (g . f)
+
+-- Profunctor
+
+class Profunctor p where
+  dimap :: (a' -> a) -> (b -> b') -> p a b -> p a' b'
+
+  lmap :: (a' -> a) -> p a b -> p a' b
+  lmap f = dimap f id
+  rmap :: (b -> b') -> p a b -> p a b'
+  rmap f = dimap id f
+
+instance Profunctor (->) where
+  dimap f g h = g . h . f
+
+-- Cartesian
+
+class Profunctor p => Cartesian p where
+  first  :: p a b -> p (a, c) (b, c)
+  second :: p a b -> p (c, a) (c, b)
+
+instance Cartesian (->) where
+  first  f (a, c) = (f a, c)
+  second f (c, a) = (c, f a)
+
+-- Cocartesian
+
+class Profunctor p => Cocartesian p where
+  left  :: p a b -> p (Either a c) (Either b c)
+  right :: p a b -> p (Either c a) (Either c b)
+
+instance Cocartesian (->) where
+  left  f = either (Left . f) Right
+  right f = either Left (Right . f)
+
+-- Monoidal
+
+class Profunctor p => Monoidal p where
+  par   :: p a b -> p c d -> p (a, c) (b, d)
+  empty :: p () ()
+
+instance Monoidal (->) where
+  par f g (a, c) = (f a, g c)
+  empty = id
+
+-- Beyond Functions
+
+newtype UpStar f a b = UpStar { runUpStar :: a -> f b }
+
+instance Functor f => Profunctor (UpStar f) where
+  dimap f g (UpStar h) = UpStar (fmap g . h . f)
+
+instance Functor f => Cartesian (UpStar f) where
+  first  (UpStar f) = UpStar (\(a, c) -> fmap (,c) (f a))
+  second (UpStar f) = UpStar (\(c, a) -> fmap (c,) (f a))
+
+instance Applicative f => Cocartesian (UpStar f) where
+  left  (UpStar f) = UpStar (either (fmap Left . f) (fmap Right . pure))
+  right (UpStar f) = UpStar (either (fmap Left . pure) (fmap Right . f))
+
+instance Applicative f => Monoidal (UpStar f) where
+  par (UpStar f) (UpStar g) = UpStar (\(a, b) -> (,) <$> f a <*> g b)
+  empty = UpStar pure
+
+newtype Tagged a b = Tagged { unTagged :: b }
+
+instance Profunctor Tagged where
+  dimap _ g (Tagged b) = Tagged (g b)
+
+instance Cocartesian Tagged where
+  left  (Tagged b) = Tagged (Left b)
+  right (Tagged b) = Tagged (Right b)
+
+instance Monoidal Tagged where
+  par (Tagged b) (Tagged d) = Tagged (b, d)
+  empty = Tagged ()

Profunctors.md

@@ -205,8 +205,8 @@ instance Cocartesian (->) where
 Indeed, this typeclass is very similar to `Cartesian`, but the resulting box
 deals with sum types (`Either`) instead of product types. What does it mean from
 our diagram perspective? It means that inputs are exclusive and only one of them
-will be active in a particular time. The input itself determines which part of
-the component is active. The new component is shown in the next picture:
+will be active in a particular time. The input itself determines which path
+should be active. The corresponding diagram is shown in the next picture:
 
 ![cocartesian](diagram/cocartesian.svg)
 
@@ -250,15 +250,14 @@ instance Monoidal (->) where
   empty = id
 ```
 
-Now, we'll focus on `par`. It receives a pair of components, `p a b` and `p c
-d`, and it builds a new component `p (a, c) (b, d)`. Given this signature, it's
-easy to figure out what is going on inside the resulting component. It's shown
-in the next diagram:
+Now, we'll focus on `par`. It receives a pair of boxes, `p a b` and `p c d`, and
+it builds a new box typed `p (a, c) (b, d)`. Given this signature, it's easy to
+figure out what's going on in the shadows. It's shown in the next diagram:
 
 ![monoidal](diagram/monoidal.svg)
 
-The resulting component make both arguments (`h` and `j`) coexist, by connecting
-them in parallel (therefore the name `par`).
+The resulting box make both arguments (`h` and `j`) coexist, by connecting them
+in parallel (therefore the name `par`).
 
 ### Beyond Functions
 
@@ -334,4 +333,4 @@ We've chosen `DownStar` and `Tagged` because we'll use them in the final part.
 However, you should know that there're other awesome instances for profunctors
 [out
 there](https://ocharles.org.uk/blog/guest-posts/2013-12-22-24-days-of-hackage-profunctors.html).
-As you see, profunctors arise everywhere!
+As you see, profunctors also arise everywhere!