non-subtyped typeclass relations idea

typeclasses.scala

//
// each TC companion declares a Has[F] that expresses a relation to that TC
// impls obvs. have themselves as Has relations
//
// pro:  no subtyping between TCs as the TC relations are encoded in the HasX subtypes
// pro:  survives multiple relations
// cons: boilerplate for TC authors, and a little tricky to get right
// cons: impl needs to impl the full laundry list (can have template impls that do this eg: Monad.Template

trait Functor[F[_]] extends Functor.Has[F] {
  override implicit final def HasFunctor: Functor[F] = this

  def map[A, B](fa: F[A])(f: A => B): F[B]
}

object Functor {
  trait Has[F[_]] {
    def HasFunctor: Functor[F]
  }
  def apply[F[_]: Functor.Has]: Functor[F] = implicitly[Functor.Has[F]].HasFunctor

  implicit class FunctorOps[F[_]: Functor, A](val fa: F[A]) {
    def map[B](f: A => B) = Functor[F].map(fa)(f)
  }
}

trait Apply[F[_]] extends Apply.Has[F] {
  override implicit final def HasApply = this
  def ap[A, B](fa: F[A])(f: F[A => B]): F[B]
}

object Apply {
  trait Has[F[_]] extends Functor.Has[F] {
    def HasApply: Apply[F]
  }
  def apply[F[_]: Apply.Has]: Apply[F] =
    implicitly[Apply.Has[F]].HasApply
}

trait Applicative[F[_]] extends Applicative.Has[F] {
  override implicit final def HasApplicative = this

  def point[A](a: A): F[A]
}

object Applicative {
  trait Has[F[_]] extends Functor.Has[F] with Apply.Has[F] {
    def HasApplicative: Applicative[F]
  }
  def apply[F[_]: Applicative.Has]: Applicative[F] =
    implicitly[Applicative.Has[F]].HasApplicative
}

trait Bind[F[_]] extends Bind.Has[F] {
  implicit override final def HasBind = this
  def bind[A, B](fa: F[A])(f: A => F[B]): F[B]
}

object Bind {
  trait Has[F[_]] extends Apply.Has[F] {
    def HasBind: Bind[F]
  }

  def apply[F[_]: Bind.Has]: Bind[F] =
    implicitly[Bind.Has[F]].HasBind

  implicit class BindOps[F[_]: Bind, A](val fa: F[A]) {
    def flatMap[B](f: A => F[B]) = Bind[F].bind(fa)(f)
  }
}

// this implements Functor as it provides a default impl
trait Monad[F[_]] extends Functor[F] with Monad.Has[F] {
  implicit final def HasMonad = this

  def map[A, B](fa: F[A])(f: A => B): F[B] =
    Bind[F].bind(fa)(f andThen Applicative[F].point)
}

object Monad {
  trait Has[F[_]] extends Bind.Has[F] with Applicative.Has[F] {
    def HasMonad: Monad[F]
  }

  def apply[F[_]: Monad.Has]: Monad[F] =
    implicitly[Monad.Has[F]].HasMonad

  trait Template[F[_]] extends Monad[F] with Apply[F] with Applicative[F] with Bind[F]
}

trait Invariant[F[_]] extends Invariant.Has[F] {
  implicit override final def HasInvariant: Invariant[F] = this

  def xmap[A, B](ma: F[A], f: A => B, g: B => A): F[B]
}

object Invariant {
  trait Has[F[_]] {
    def HasInvariant: Invariant[F]
  }
  def apply[F[_]: Invariant.Has]: Invariant[F] =
    implicitly[Invariant.Has[F]].HasInvariant
}

trait MonadError[F[_], E] extends MonadError.Has[F, E] {
  implicit final def HasMonadError = this

  def raiseError[A](err: E): F[A]
  def handleError[A](fa: F[A])(err: E => F[A]): F[A]
}

object MonadError {
  trait Has[F[_], E] extends Monad.Has[F] with Invariant.Has[({ type f[x] = MonadError[F, x] })#f] {
    def HasMonadError: MonadError[F, E]
    override final def HasInvariant = InvariantMonadError[F, E](HasMonadError)
  }

  def apply[F[_], E](implicit ev: MonadError.Has[F, E]): MonadError[F, E] =
    ev.HasMonadError

  trait Template[F[_], E] extends Monad.Template[F] with MonadError[F, E]
  abstract class Proxy[F[_], E](F: Monad[F]) extends MonadError[F, E] {
    final def HasMonad: forth.Monad[F] = F.HasMonad
    final def HasFunctor: forth.Functor[F] = F.HasFunctor
    final def HasApplicative: forth.Applicative[F] = F.HasApplicative
    final def HasBind: forth.Bind[F] = F.HasBind
    final def HasApply: forth.Apply[F] = F.HasApply
  }

  def InvariantMonadError[F[_], A](implicit mea: MonadError[F, A]): Invariant[({ type f[x] = MonadError[F, x] })#f] =
    new Invariant[({ type f[x] = MonadError[F, x] })#f] {
      def xmap[A, B](ma: MonadError[F, A], f: A => B, g: B => A): MonadError[F, B] =
        new Proxy[F, B](ma.HasMonad) {
          def raiseError[X](b: B) = ma.raiseError(g(b))
          import Functor._
          def handleError[X](fb: F[X])(handle: B => F[X]): F[X] = ma.handleError[X](fb)(f andThen handle)
        }
    }
}

case class Box[A](a: A)
object Box {

  implicit object BoxMonad extends Monad.Template[Box] {
    override def map[A, B](fa: Box[A])(f: A => B) = Box(f(fa.a))
    def point[A](a: A) = Box(a)
    def ap[A, B](fa: Box[A])(f: Box[A => B]) = Box(f.a(fa.a))
    def bind[A, B](fa: Box[A])(f: A => Box[B]) = f(fa.a)
  }
}

sealed trait Or[L, R] {
  def fold[A](fl: L => A, fr: R => A) =
    this match {
      case Or.Left(l)  => fl(l)
      case Or.Right(r) => fr(r)
    }
}
object Or {
  case class Left[L, R](l: L) extends Or[L, R]
  case class Right[L, R](r: R) extends Or[L, R]

  implicit def MonadErrorOr[E]: MonadError[({ type f[a] = Or[E, a] })#f, E] =
    new MonadError.Template[({ type f[a] = Or[E, a] })#f, E] {
      def point[A](a: A) = Right(a)
      def ap[A, B](or: Or[E, A])(ff: Or[E, A => B]) =
        or.fold(Left.apply, a => ff.fold(Left.apply, f => Right(f(a))))
      def bind[A, B](or: Or[E, A])(f: A => Or[E, B]) = or.fold(Left.apply, f)
      def raiseError[A](err: E) = Left(err)
      def handleError[A](fa: Or[E, A])(f: E => Or[E, A]) =
        fa.fold(f, Right.apply)
    }
}

object Test {
  type Id[A] = A

  def foo[F[_]: Monad] = Functor[F]

  def applic[F[_]: Monad] = Applicative[F]

  import Functor._
  val b1 = Box(1).map { _ + 1 }

  import Bind._
  val b2 = Box(1).flatMap { i => Box(i + 1) }
}