Port Clown, Joker, Product (Product2), Costar from bifunctors/profunctor (#27)

* Update CI to v0.14.0-rc5

* Port Clown, Joker, and Product2 newtypes from purescript-bifunctors and purescript-profunctor to this repo and merge them

* Port Costar newtypes from purescript-profunctor to this repo

* Add FunctorRight and implement its instances

* Update docs for Clown and Joker to refer to paper

* Added docs to the newtypes that were ported

Author: JordanMartinez

CHANGELOG.md

@@ -6,8 +6,11 @@ Notable changes to this project are documented in this file. The format is based
 
 Breaking changes:
 - Added support for PureScript 0.14 and dropped support for all previous versions (#24)
+- Ported `Clown`, `Joker`, and `Product` (named `Product2` here) from `purescript-bifunctors`/`purescript-profunctor` to this repo (#27)
+- Ported `purescript-profunctor`'s `Costar` to this repo (#27)
 
 New features:
+- Added `FunctorRight` type class (#27)
 
 Bugfixes:
 

src/Data/Functor/Clown.purs

@@ -0,0 +1,31 @@
+module Data.Functor.Clown where
+
+import Prelude
+
+import Data.Functor.FunctorRight (class FunctorRight)
+import Data.Newtype (class Newtype)
+
+-- | This advance type's usage and its relation to `Joker` is best understood
+-- | by reading through "Clowns to the Left, Jokers to the Right (Functional
+-- | Pearl)"
+-- | https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.475.6134&rep=rep1&type=pdf
+newtype Clown :: (Type -> Type) -> Type -> Type -> Type
+newtype Clown f a b = Clown (f a)
+
+derive instance newtypeClown :: Newtype (Clown f a b) _
+
+derive newtype instance eqClown :: Eq (f a) => Eq (Clown f a b)
+
+derive newtype instance ordClown :: Ord (f a) => Ord (Clown f a b)
+
+instance showClown :: Show (f a) => Show (Clown f a b) where
+  show (Clown x) = "(Clown " <> show x <> ")"
+
+instance functorClown :: Functor (Clown f a) where
+  map _ (Clown a) = Clown a
+
+instance functorRightClown :: FunctorRight (Clown f) where
+  rmap = map
+
+hoistClown :: forall f g a b. (f ~> g) -> Clown f a b -> Clown g a b
+hoistClown f (Clown a) = Clown (f a)

src/Data/Functor/Costar.purs

@@ -0,0 +1,49 @@
+module Data.Functor.Costar where
+
+import Prelude
+
+import Control.Comonad (class Comonad, extract)
+import Control.Extend (class Extend, (=<=))
+
+import Data.Distributive (class Distributive, distribute)
+import Data.Functor.Invariant (class Invariant, imapF)
+import Data.Functor.FunctorRight (class FunctorRight)
+import Data.Newtype (class Newtype)
+
+-- | `Costar` turns a `Functor` into a `Profunctor` "backwards".
+-- |
+-- | `Costar f` is also the co-Kleisli category for `f`.
+newtype Costar :: (Type -> Type) -> Type -> Type -> Type
+newtype Costar f b a = Costar (f b -> a)
+
+derive instance newtypeCostar :: Newtype (Costar f a b) _
+
+instance semigroupoidCostar :: Extend f => Semigroupoid (Costar f) where
+  compose (Costar f) (Costar g) = Costar (f =<= g)
+
+instance categoryCostar :: Comonad f => Category (Costar f) where
+  identity = Costar extract
+
+instance functorCostar :: Functor (Costar f a) where
+  map f (Costar g) = Costar (f <<< g)
+
+instance functorRightCostar :: FunctorRight (Costar f) where
+  rmap = map
+
+instance invariantCostar :: Invariant (Costar f a) where
+  imap = imapF
+
+instance applyCostar :: Apply (Costar f a) where
+  apply (Costar f) (Costar g) = Costar \a -> f a (g a)
+
+instance applicativeCostar :: Applicative (Costar f a) where
+  pure a = Costar \_ -> a
+
+instance bindCostar :: Bind (Costar f a) where
+  bind (Costar m) f = Costar \x -> case f (m x) of Costar g -> g x
+
+instance monadCostar :: Monad (Costar f a)
+
+instance distributiveCostar :: Distributive (Costar f a) where
+  distribute f = Costar \a -> map (\(Costar g) -> g a) f
+  collect f = distribute <<< map f

src/Data/Functor/FunctorRight.purs

@@ -0,0 +1,7 @@
+module Data.Functor.FunctorRight where
+
+-- | Same as `Functor` but works on types that take two type parameters
+-- | instead of just one.
+class FunctorRight :: (Type -> Type -> Type) -> Constraint
+class FunctorRight f where
+  rmap :: forall a b c. (b -> c) -> f a b -> f a c

src/Data/Functor/Joker.purs

@@ -0,0 +1,42 @@
+module Data.Functor.Joker where
+
+import Prelude
+
+import Data.Functor.FunctorRight (class FunctorRight)
+import Data.Newtype (class Newtype, un)
+
+-- | This advance type's usage and its relation to `Clown` is best understood
+-- | by reading through "Clowns to the Left, Jokers to the Right (Functional
+-- | Pearl)"
+-- | https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.475.6134&rep=rep1&type=pdf
+newtype Joker :: (Type -> Type) -> Type -> Type -> Type
+newtype Joker g a b = Joker (g b)
+
+derive instance newtypeJoker :: Newtype (Joker f a b) _
+
+derive newtype instance eqJoker :: Eq (f b) => Eq (Joker f a b)
+
+derive newtype instance ordJoker :: Ord (f b) => Ord (Joker f a b)
+
+instance showJoker :: Show (f b) => Show (Joker f a b) where
+  show (Joker x) = "(Joker " <> show x <> ")"
+
+instance functorJoker :: Functor f => Functor (Joker f a) where
+  map f (Joker a) = Joker (map f a)
+
+instance functorRightJoker :: Functor f => FunctorRight (Joker f) where
+  rmap = map
+
+instance applyJoker :: Apply f => Apply (Joker f a) where
+  apply (Joker f) (Joker g) = Joker $ apply f g
+
+instance applicativeJoker :: Applicative f => Applicative (Joker f a) where
+  pure = Joker <<< pure
+
+instance bindJoker :: Bind f => Bind (Joker f a) where
+  bind (Joker ma) amb = Joker $ ma >>= (amb >>> un Joker)
+
+instance monadJoker :: Monad m => Monad (Joker m a)
+
+hoistJoker :: forall f g a b. (f ~> g) -> Joker f a b -> Joker g a b
+hoistJoker f (Joker a) = Joker (f a)

src/Data/Functor/Product2.purs

@@ -0,0 +1,27 @@
+module Data.Functor.Product2 where
+
+import Prelude
+import Data.Functor.FunctorRight (class FunctorRight, rmap)
+
+-- | The Product of two types that both take two type parameters (e.g. `Either`,
+-- | `Tuple, etc.) where both type parameters are the same.
+-- |
+-- | ```purescript
+-- | Product2 (Tuple 4 true) (Right false) :: Product2 Tuple Either Int Boolean
+-- | Product2 (Tuple 4 true) (Left      8) :: Product2 Tuple Either Int Boolean
+-- | ```
+data Product2 :: (Type -> Type -> Type) -> (Type -> Type -> Type) -> Type -> Type -> Type
+data Product2 f g a b = Product2 (f a b) (g a b)
+
+derive instance eqProduct2 :: (Eq (f a b), Eq (g a b)) => Eq (Product2 f g a b)
+
+derive instance ordProduct2 :: (Ord (f a b), Ord (g a b)) => Ord (Product2 f g a b)
+
+instance showProduct2 :: (Show (f a b), Show (g a b)) => Show (Product2 f g a b) where
+  show (Product2 x y) = "(Product2 " <> show x <> " " <> show y <> ")"
+
+instance functorProduct2 :: (Functor (f a), Functor (g a)) => Functor (Product2 f g a) where
+  map f (Product2 x y) = Product2 (map f x) (map f y)
+
+instance functorRight :: (FunctorRight f, FunctorRight g) => FunctorRight (Product2 f g) where
+  rmap f (Product2 x y) = Product2 (rmap f x) (rmap f y)