Skip to content

Instantly share code, notes, and snippets.

@purefn
Created April 19, 2012 22:36
Show Gist options
  • Save purefn/2424662 to your computer and use it in GitHub Desktop.
Save purefn/2424662 to your computer and use it in GitHub Desktop.
import scalaz._, Free._
sealed trait Arithmetic[+A]
sealed case class Addition[A](a: Int, b: Int, f: Int => A) extends Arithmetic[A]
object Arithmetic {
implicit val ArithmeticFunctor: Functor[Arithmetic] = new Functor[Arithmetic] {
def map[A, B](fa: Arithmetic[A])(f: A => B) = fa match {
case z@Addition(_, _, g) => z.copy(f = f compose g)
}
}
}
sealed trait Geometry[+A]
sealed case class RectangleArea[A](a: Int, b: Int, f: Int => A) extends Geometry[A]
object Geometry {
implicit val GeometryFunctor: Functor[Geometry] = new Functor[Geometry] {
def map[A, B](fa: Geometry[A])(f: A => B) = fa match {
case z@RectangleArea(_, _, g) => z.copy(f = f compose g)
}
}
}
object LL {
type F[+A] = Either[Arithmetic[A], Geometry[A]]
type LL[+A] = Free[F, A]
implicit val FFunctor: Functor[F] = new Functor[F] {
override def map[A, B](e: F[A])(f: (A) => B): F[B] =
e match {
case Left(fa) => Left(Functor[Arithmetic].map(fa)(f))
case Right(gb) => Right(Functor[Geometry].map(gb)(f))
}
}
def ??? = sys.error("Not implemented")
def ⊕(a: Int, b: Int): LL[Int] =
Suspend(Left(Addition(a, b, Return[F, Int](_))) : F[Free[F, Int]])
def rectArea(a: Int, b: Int): LL[Int] =
Suspend(Right(RectangleArea(a, b, Return[F, Int](_))) : F[Free[F, Int]])
type ArithDual[+A] = A // ??? should be "dual" to Arithmetic in some way
type GeomDual[+A] = A // ??? should be "dual" to Geometry in some way
type G[+A] = (ArithDual[A], GeomDual[A]) // product of duals
implicit val GFunctor: Functor[G] = new Functor[G] {
override def map[A, B](e: G[A])(f: A => B): G[B] = ???
}
implicit val zapArithDual = new Zap[Arithmetic, ArithDual] {
def zapWith[A, B, C](fa: Arithmetic[A], gb: ArithDual[B])(f: (A, B) => C) = ???
}
implicit val zapGeomDual = new Zap[Geometry, GeomDual] {
def zapWith[A, B, C](fa: Geometry[A], gb: GeomDual[B])(f: (A, B) => C) = ???
}
implicit val ZapFG: Zap[F, G] = Zap.productCoproductZap[Arithmetic, ArithDual, Geometry, GeomDual]
type CoLL[A, B] = Cofree[G, A => B]
def run: CoLL[Int, Int] = ??? //Cofree(
// goal
import Scalaz._
val a: LL[Int] =
for {
x <- rectArea(2, 2)
y <- rectArea(1, 1)
z <- ⊕(x, y)
} yield z
a.zap(run) assert_=== 4
}
@YoEight
Copy link

YoEight commented Jun 10, 2012

I don't know if you've already solved your problem here but defining ArithDual as

case class ArithDual[A](v: A, f: (Int, Int) => Int)

seems to do the trick ?

@YoEight
Copy link

YoEight commented Jun 10, 2012

Here's a more concrete implementation

case class ArithmeticDual[+A](v: A, f: (Int, Int) => Int) 
case class AdditionDual[+A](p: A) extends ArithmeticDual(p, _ + _)

case class GeometryDual[+A](v: A, f: (Int, Int) => Int) 
case class RectangleDual[+A](p: A) extends ArithmeticDual(p, _ * _)

implicit val ArithmeticDualFunctor: Functor[ArithmeticDual] = new Functor[ArithmeticDual] {
    def map[A, B](fa: ArithmeticDual[A])(f: A => B) = fa match {
      case ArithmeticDual(a, k) => ArithmeticDual(f(a),k)
    }
  }

implicit val GeometryDualFunctor: Functor[GeometryDual] = new Functor[GeometryDual] {
    def map[A, B](fa: GeometryDual[A])(f: A => B) = fa match {
      case GeometryDual(a, k) => GeometryDual(f(a),k)
    }
  }

type G[+A] = (ArithmeticDual[A], GeometryDual[A])

implicit val GFunctor: Functor[G] = new Functor[G] {
    override def map[A, B](e: G[A])(f: A => B): G[B] = e match {
      case (fa, ga) => (Functor[ArithmeticDual].map(fa)(f), Functor[GeometryDual].map(ga)(f))
    }
 }

implicit val zapArithDual = new Zap[Arithmetic, ArithmeticDual] {
    def zapWith[A, B, C](fa: Arithmetic[A], gb: ArithmeticDual[B])(f: (A, B) => C) = (fa, gb) match {
      case (Arithmetic(x, y, k), ArithmeticDual(b, g)) => f(k(g(x, y)), b)
    }
  }

mplicit val zapGeomDual = new Zap[Arithmetic, ArithmeticDual] {
    def zapWith[A, B, C](fa: Arithmetic[A], gb: ArithmeticDual[B])(f: (A, B) => C) = (fa, gb) match {
      case (RectangleArea(x, y, k), GeometryDual(b, g)) => f(k(g(x, y)), b)
    }
  }

import Cofree._

def run: Cofree[F, Unit] = unfoldC[G, Unit](())(_ => (AdditionDual(()), RectangleDual(())))


a.zapWith(run)((a, _) => a) assert_=== 5

@purefn
Copy link
Author

purefn commented Jun 11, 2012

Oh cool! Thanks, I was still struggling with the Cofree portion, and now that I see it I can't help but feel like an idiot.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment