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

http://github.com/scalaz/scalaz
Scala | 124 lines | 94 code | 30 blank | 0 comment | 0 complexity | 5c883cdf686df785bfa3932b3c1a6134 MD5 | raw file
```  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, *]] =
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
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}
```