Free PreArrow

build.sbt

scalaVersion := "2.11.7"

name := "FreePreArrow"

libraryDependencies += "org.scalaz" %% "scalaz-core" % "7.1.3"

licenses := Seq("MIT License" -> url("http://opensource.org/licenses/mit"))

scalacOptions ++= (
  "-deprecation" ::
  "-unchecked" ::
  "-Xlint" ::
  "-language:existentials" ::
  "-language:higherKinds" ::
  "-language:implicitConversions" ::
  Nil
)

FreePreArrow.scala

package scalaz

/**
 * @see [[http://www.fceia.unr.edu.ar/~mauro/pubs/Notions_of_Computation_as_Monoids.pdf]]
 */
sealed abstract class FreePreArrow[F[_, _], A, B] extends Product with Serializable {
  def mapfst[AA](f: AA => A)(implicit F: Profunctor[F]): FreePreArrow[F, AA, B] =
    FreePreArrow.instance[F].mapfst(this)(f)

  def mapsnd[BB](f: B => BB)(implicit F: Profunctor[F]): FreePreArrow[F, A, BB] =
    FreePreArrow.instance[F].mapsnd(this)(f)

  def >>>[C](that: FreePreArrow[F, B, C])(implicit F: Profunctor[F]): FreePreArrow[F, A, C] =
    FreePreArrow.instance[F].>>>(this, that)
}

object FreePreArrow {

  final case class Hom[F[_, _], A, B](f: A => B) extends FreePreArrow[F, A, B]

  sealed abstract case class Comp[F[_, _], A, B]() extends FreePreArrow[F, A, B] {
    type I
    val a: F[A, I]
    val f: FreePreArrow[F, I, B]
  }

  def comp[F0[_, _], A0, B0, I0](a0: F0[A0, I0], f0: FreePreArrow[F0, I0, B0]): FreePreArrow[F0, A0, B0] =
    new Comp[F0, A0, B0] {
      type I = I0
      val a = a0
      val f = f0
    }

  implicit def instance[F[_, _]](implicit F: Profunctor[F]): PreArrow[({type l[a, b] = FreePreArrow[F, a, b]})#l] =
    new PreArrow[({type l[a, b] = FreePreArrow[F, a, b]})#l] {
      override def arr[A, B](f: A => B) =
        Hom(f)

      override def >>>[A, B, C](x: FreePreArrow[F, A, B], y: FreePreArrow[F, B, C]) =
        x match {
          case Hom(f) =>
            y.mapfst(f)
          case a @ Comp() =>
            comp(a.a, a.f >>> y)
        }

      override def mapfst[A, B, C](fab: FreePreArrow[F, A, B])(f: C => A) =
        fab match {
          case Hom(g) =>
            Hom(f andThen g)
          case a @ Comp() =>
            comp(F.mapfst(a.a)(f), a.f)
        }

      override def mapsnd[A, B, C](fab: FreePreArrow[F, A, B])(f: B => C) =
        fab match {
          case Hom(g) =>
            Hom(f compose g)
          case a @ Comp() =>
            comp(a.a, a.f.mapsnd(f))
        }
    }
}

PreArrow.scala

package scalaz

trait PreArrow[F[_, _]] extends Profunctor[F] {
  def arr[A, B](f: A => B): F[A, B]
  def >>>[A, B, C](x: F[A, B], y: F[B, C]): F[A, C]
}