Defining Haskell FixF in scala

Question

So comonad.com has an interesting series of articles on working with applicatives and I've been trying to bring what I can to scala (for fun, and to learn). So, haskell defines FixF –

newtype FixF f a = FixF (f (FixF f) a)

it is written ,"FixF is of kind ((* -> *) -> * -> *) -> * -> *). It takes the fixpoint of a "second-order Functor" (a Functor that sends a Functor to another Functor, i.e. an endofunctor on the functor category of hask), to recover a standard "first order Functor" back out."

kinds classify types
*                   type  A
* -> *              type F[_]
* -> * -> *         type F[_,_]
((* -> *) -> *)     type F[F'[_]]
((* -> *) ->* -> *) type F[F'[_], A] 

Now I've seen this

case class Fix[F[_]](out: F[Fix[F]])
// ((* -> *) -> * )

and this

case class BFixF[F[_,_], A](out: F[A, BFixF[F,A]])

So it's not the first one Fix (wrong kinds) Is it the second? I don't the think the kinds are right

BFixF :: ((* -> * -> * ) -> * -> *) ?

is it -

    // edit as of this morning it is really not this
    class FixF[F[_[_], _], A] :: ((* -> *) -> * -> *) -> *)

is it ?

    case class FixF'[F[_], A](run: F[Fix[F, A]]) 

if so I'd love to see the proper definition and functor

 case class FixF[F[_], A] (out: F[Fix[F, A]])

 trait FixFFunctor[F[_]: Functor] extends Functor[({type l[x] = FixF[F, x]})#l] {

   def map[A, B](f: A => B): FixF[F, A] => FixF[F, B] = ???

 }

now bonus question, can someone define the applicative ?

Answer 1

This is a pretty cool question—I'd also read those posts, and had wondered about how terrifying a Scala implementation would look, but I never actually tried it. So I'm going to respond in some detail, but please note that the following is extremely off-the-cuff (it's Saturday morning, after all) and doesn't necessarily represent the cleanest way to do this in Scala.

It's probably best to start by defining some of the types from the first post in the series:

import scala.language.higherKinds
import scalaz._, Scalaz._

case class Const[M, A](mo: M)

sealed trait Sum[F[_], G[_], A]

object Sum {
  def inL[F[_], G[_], A](l: F[A]): Sum[F, G, A] = InL(l)
  def inR[F[_], G[_], A](r: G[A]): Sum[F, G, A] = InR(r)
}

case class InL[F[_], G[_], A](l: F[A]) extends Sum[F, G, A]
case class InR[F[_], G[_], A](r: G[A]) extends Sum[F, G, A]

And a couple more from the blog post itself:

case class Embed[F[_], A](out: A)

case class ProductF[F[_[_], _], G[_[_], _], B[_], A](f: F[B, A], g: G[B, A])

If you've worked through the above, you should have some sense of what FixF should look like:

case class FixF[F[f[_], _], A](out: F[({ type L[x] = FixF[F, x] })#L, A])

It turns out that this is a little too strict, though, so we'll use the following instead:

class FixF[F[f[_], _], A](v: => F[({ type L[x] = FixF[F, x] })#L, A]) {
  lazy val out = v
  override def toString = s"FixF($out)"
}

Now suppose we want to implement lists as a "second-order fixpoint of polynomial functors", as in the blog post. We can start by defining some useful aliases:

type UnitConst[x] = Const[Unit, x]
type UnitConstOr[F[_], x] = Sum[UnitConst, F, x]
type EmbedXUnitConstOr[F[_], x] = ProductF[Embed, UnitConstOr, F, x]

type MyList[x] = FixF[EmbedXUnitConstOr, x]

And now we can define the Scala version of the examples from the post:

val foo: MyList[String] = new FixF[EmbedXUnitConstOr, String](
  ProductF[Embed, UnitConstOr, MyList, String](
    Embed("foo"),
    Sum.inL[UnitConst, MyList, String](Const())
  )
)

val baz: MyList[String] = new FixF[EmbedXUnitConstOr, String](
  ProductF[Embed, UnitConstOr, MyList, String](
    Embed("baz"),
    Sum.inL[UnitConst, MyList, String](Const())
  )
)

val bar: MyList[String] = new FixF[EmbedXUnitConstOr, String](
  ProductF[Embed, UnitConstOr, MyList, String](
    Embed("bar"),
    Sum.inR[UnitConst, MyList, String](baz)
  )
)

This looks like what we'd expect given the Haskell implementation:

scala> println(foo)
FixF(ProductF(Embed(foo),InL(Const(()))))

scala> println(bar)
FixF(ProductF(Embed(bar),InR(FixF(ProductF(Embed(baz),InL(Const(())))))))

Now we need our type class instances. Most of these are pretty straightforward:

implicit def applicativeConst[M: Monoid]: Applicative[
  ({ type L[x] = Const[M, x] })#L
] = new Applicative[({ type L[x] = Const[M, x] })#L] {
  def point[A](a: => A): Const[M, A] = Const(mzero[M])
  def ap[A, B](fa: => Const[M, A])(f: => Const[M, A => B]): Const[M, B] =
    Const(f.mo |+| fa.mo) 
}

implicit def applicativeEmbed[F[_]]: Applicative[
  ({ type L[x] = Embed[F, x] })#L
] = new Applicative[({ type L[x] = Embed[F, x] })#L] {
  def point[A](a: => A): Embed[F, A] = Embed(a)
  def ap[A, B](fa: => Embed[F, A])(f: => Embed[F, A => B]): Embed[F, B] =
    Embed(f.out(fa.out))
}

implicit def applicativeProductF[F[_[_], _], G[_[_], _], B[_]](implicit
  fba: Applicative[({ type L[x] = F[B, x] })#L],
  gba: Applicative[({ type L[x] = G[B, x] })#L]
): Applicative[({ type L[x] = ProductF[F, G, B, x] })#L] =
  new Applicative[({ type L[x] = ProductF[F, G, B, x] })#L] {
    def point[A](a: => A): ProductF[F, G, B, A] =
      ProductF(fba.point(a), gba.point(a))
    def ap[A, C](fa: => ProductF[F, G, B, A])(
      f: => ProductF[F, G, B, A => C]
    ): ProductF[F, G, B, C] = ProductF(fba.ap(fa.f)(f.f), gba.ap(fa.g)(f.g))
  }

Including the applicative instance for FixF itself:

implicit def applicativeFixF[F[_[_], _]](implicit
  ffa: Applicative[({ type L[x] = F[({ type M[y] = FixF[F, y] })#M, x] })#L]
): Applicative[({ type L[x] = FixF[F, x] })#L] =
  new Applicative[({ type L[x] = FixF[F, x] })#L] {
    def point[A](a: => A): FixF[F, A] = new FixF(ffa.pure(a))
    def ap[A, B](fa: => FixF[F, A])(f: => FixF[F, A => B]): FixF[F, B] =
      new FixF(ffa.ap(fa.out)(f.out))
  }

We'll also define the terminal transformation:

implicit def terminal[F[_], M: Monoid]: F ~> ({ type L[x] = Const[M, x] })#L =
  new (F ~> ({ type L[x] = Const[M, x] })#L) {
    def apply[A](fa: F[A]): Const[M, A] = Const(mzero[M])
  }

But now we're in trouble. We really need some extra laziness in here, so we'll cheat a little:

def applicativeSum[F[_], G[_]](
  fa: Applicative[F],
  ga: => Applicative[G],
  nt: G ~> F
): Applicative[({ type L[x] = Sum[F, G, x] })#L] =
  new Applicative[({ type L[x] = Sum[F, G, x] })#L] {
    def point[A](a: => A): Sum[F, G, A] = InR(ga.point(a))
    def ap[A, B](x: => Sum[F, G, A])(f: => Sum[F, G, A => B]): Sum[F, G, B] =
      (x, f) match {
        case (InL(v), InL(f)) => InL(fa.ap(v)(f))
        case (InR(v), InR(f)) => InR(ga.ap(v)(f))
        case (InR(v), InL(f)) => InL(fa.ap(nt(v))(f))
        case (InL(v), InR(f)) => InL(fa.ap(v)(nt(f)))
      }
  }

implicit def myListApplicative: Applicative[MyList] =
  applicativeFixF[EmbedXUnitConstOr](
    applicativeProductF[Embed, UnitConstOr, MyList](
      applicativeEmbed[MyList],
      applicativeSum[UnitConst, MyList](
        applicativeConst[Unit],
        myListApplicative,
        terminal[MyList, Unit]
      )
    )
  )

Maybe there's a way to get this to work with Scalaz 7's encoding of applicatives without the hack, but if there is I don't want to spend my Saturday afternoon figuring it out.

So that sucks, but at least now we can check our work:

scala> println((foo |@| bar)(_ ++ _))
FixF(ProductF(Embed(foobar),InL(Const(()))))

Which is exactly what we wanted.