/core/src/main/scala/scalaz/Cokleisli.scala

  1package scalaz
  2
  3final case class Cokleisli[F[_], A, B](run: F[A] => B) { self =>
  4  def apply(fa: F[A]): B =
  5    run(fa)
  6
  7
  8  def dimap[C, D](f: C => A, g: B => D)(implicit b: Functor[F]): Cokleisli[F, C, D] =
  9    Cokleisli(c => g(run(b.map(c)(f)))) // b.map(run(f(c)))(g))
 10
 11  def contramapValue[C](f: F[C] => F[A]): Cokleisli[F, C,  B] = Cokleisli(run compose f)
 12
 13  def map[C](f: B => C): Cokleisli[F, A, C] = Cokleisli(f compose run)
 14
 15  def flatMap[C](f: B => Cokleisli[F, A, C]): Cokleisli[F, A, C] =
 16    Cokleisli(fa => f(self.run(fa)).run(fa))
 17
 18  def <<=(a: F[A])(implicit F: Cobind[F]): F[B] =
 19    F.extend(a)(run)
 20
 21  def =>=[C](c: Cokleisli[F, B, C])(implicit F: Cobind[F]): Cokleisli[F, A, C] =
 22    Cokleisli(fa => c run (<<=(fa)))
 23
 24  def compose[C](c: Cokleisli[F, C, A])(implicit F: Cobind[F]): Cokleisli[F, C, B] =
 25    c =>= this
 26
 27  def =<=[C](c: Cokleisli[F, C, A])(implicit F: Cobind[F]): Cokleisli[F, C, B] =
 28    compose(c)
 29
 30  def endo(implicit ev: B === A): Endomorphic[Cokleisli[F, *, *], A] =
 31    Endomorphic[Cokleisli[F, *, *], A](ev.subst[Cokleisli[F, A, *]](this))
 32}
 33
 34object Cokleisli extends CokleisliInstances {
 35
 36}
 37
 38sealed abstract class CokleisliInstances0 {
 39  implicit def cokleisliCompose[F[_]](implicit F0: Cobind[F]): Compose[Cokleisli[F, *, *]] =
 40    new CokleisliCompose[F] {
 41      override implicit def F = F0
 42    }
 43  implicit def cokleisliProfunctor[F[_]: Functor]: Profunctor[Cokleisli[F, *, *]] =
 44    new CokleisliProfunctor[F] {
 45      def F = implicitly
 46    }
 47}
 48
 49sealed abstract class CokleisliInstances extends CokleisliInstances0 {
 50  implicit def cokleisliMonad[F[_], R]: Monad[Cokleisli[F, R, *]] with BindRec[Cokleisli[F, R, *]] =
 51    new CokleisliMonad[F, R] {}
 52
 53  implicit def cokleisliArrow[F[_]](implicit F0: Comonad[F]): Arrow[Cokleisli[F, *, *]] with ProChoice[Cokleisli[F, *, *]] =
 54    new CokleisliArrow[F] {
 55      override implicit def F = F0
 56    }
 57}
 58
 59private trait CokleisliMonad[F[_], R] extends Monad[Cokleisli[F, R, *]] with BindRec[Cokleisli[F, R, *]] {
 60  override def map[A, B](fa: Cokleisli[F, R, A])(f: A => B) = fa map f
 61  override def ap[A, B](fa: => Cokleisli[F, R, A])(f: => Cokleisli[F, R, A => B]) = f flatMap (fa map _)
 62  def point[A](a: => A) = Cokleisli(_ => a)
 63  def bind[A, B](fa: Cokleisli[F, R, A])(f: A => Cokleisli[F, R, B]) = fa flatMap f
 64  def tailrecM[A, B](a: A)(f: A => Cokleisli[F, R, A \/ B]): Cokleisli[F, R, B] = {
 65    @annotation.tailrec
 66    def go(a0: A)(r: F[R]): B =
 67      f(a0).run(r) match {
 68        case -\/(a1) => go(a1)(r)
 69        case \/-(b) => b
 70      }
 71
 72    Cokleisli(go(a))
 73  }
 74}
 75
 76private trait CokleisliCompose[F[_]] extends Compose[Cokleisli[F, *, *]] {
 77  implicit def F: Cobind[F]
 78
 79  override def compose[A, B, C](f: Cokleisli[F, B, C], g: Cokleisli[F, A, B]) = f compose g
 80}
 81
 82private trait CokleisliProfunctor[F[_]] extends Profunctor[Cokleisli[F, *, *]] {
 83  implicit def F: Functor[F]
 84
 85  override def dimap[A, B, C, D](fab: Cokleisli[F, A, B])(f: C => A)(g: B => D) =
 86    fab.dimap(f, g)
 87
 88  override final def mapfst[A, B, C](fa: Cokleisli[F, A, B])(f: C => A) =
 89    Cokleisli[F, C, B](fc => fa(F.map(fc)(f)))
 90
 91  override final def mapsnd[A, B, C](fa: Cokleisli[F, A, B])(f: B => C) =
 92    fa map f
 93}
 94
 95private trait CokleisliArrow[F[_]]
 96  extends Arrow[Cokleisli[F, *, *]]
 97  with ProChoice[Cokleisli[F, *, *]]
 98  with CokleisliProfunctor[F]
 99  with CokleisliCompose[F] {
100
101  implicit def F: Comonad[F]
102
103  def left[A, B, C](fa: Cokleisli[F, A, B]): Cokleisli[F, A \/ C, B \/ C] =
104    Cokleisli { (ac: F[A \/ C]) =>
105      F.copoint(ac) match {
106        case -\/(a) => -\/(fa run (F.map(ac)(_ => a)))
107        case \/-(b) => \/-(b)
108      }
109    }
110
111  def right[A, B, C](fa: Cokleisli[F, A, B]): Cokleisli[F, C \/ A, C \/ B] =
112    Cokleisli { (ac: F[C \/ A]) =>
113      F.copoint(ac) match {
114        case -\/(b) => -\/(b)
115        case \/-(a) => \/-(fa run (F.map(ac)(_ => a)))
116      }
117    }
118
119  def arr[A, B](f: A => B) = Cokleisli(a => f(F.copoint(a)))
120  def id[A] = Cokleisli[F, A, A](F.copoint)
121
122  def first[A, B, C](f: Cokleisli[F, A, B]) =
123      Cokleisli[F, (A, C), (B, C)](w => (f.run(F.map(w)(ac => ac._1)), F.copoint(w)._2))
124}