Edward Kmett's new lens trickery in scala

MirroredLens.scala

package scalaz.lens

import scalaz.Functor

case class Store[C, D, B](f: D => B, c: C)
object Store extends StoreInstances

trait StoreInstances {
  implicit def storeFunctor[C, D]: Functor[({type l[b]=Store[C, D, b]})#l] = new Functor[({type l[b]=Store[C, D, b]})#l] {
    def map[A, B](fa: Store[C, D, A])(f: A => B): Store[C, D, B] = {
      Store(f compose fa.f, fa.c)
    }
  }
}

case class Getting[B, A](got: B)
object Getting {
  implicit def gettingFunctor[T]: Functor[({type l[a]=Getting[T, a]})#l] = new Functor[({type l[a]=Getting[T, a]})#l] {
    def map[A, B](fa: Getting[T, A])(f: A => B): Getting[T, B] = Getting(fa.got)
  }

  def ^[A, B, C, D]: A => ((C => Getting[C, D]) => A => Getting[C, B]) => C = {
    x => l => l(Getting[C, D](_))(x).got
  }
}

trait Getter[A, C] {
  def apply[R, D, B]: (C => Getting[R, D]) => A => Getting[R, B]
}
object Getter {
  def getting[A, BB](g: A => BB): Getter[A, BB] = new Getter[A, BB] {
    def apply[R, D, B]: ((BB) => Getting[R, D]) => (A) => Getting[R, B] = {
      f => a => Getting(f(g(a)).got)
    }
  }
}

case class Setting[A](unsetting: A)
object Setting {
  implicit def settingFunctor: Functor[Setting] = new Functor[Setting] {
    def map[A, B](fa: Setting[A])(f: A => B): Setting[B] = Setting(f(fa.unsetting))
  }

  def %=[A, B, C, D]: ((C => Setting[D]) => A => Setting[B]) => (C => D) => A => B = {
    l => f => ((s: Setting[B]) => s.unsetting) compose l(c => Setting[D](f(c)))
  }

  def ^=[A, B, C, D]: ((C => Setting[D]) => A => Setting[B]) => D => A => B = {
    l => v => %=(l)(Function.const(v)(_))
  }
}

trait Setter[A, D, B] {
  def apply: (() => Setting[D]) => A => Setting[B]
}
object Setter {
  def setting[A, D, B](f :(A => D => B)): Setter[A, D, B] = new Setter[A, D, B] {
    def apply: (() => Setting[D]) => (A) => Setting[B] = {
      g => a => Setting(f(a)(g().unsetting))
    }
  }
}

object MirrorLens {
  //  trait Lens[A, B] {
  //    def func[F[_]](implicit F: Functor[F]): (B => F[B]) => A => F[A]
  //  }


  //type LensFamily a b c d =
  //	forall f. Functor f =>
  //	(c -> f d) -> a -> f b
  trait LensFamily[A, B, C, D] {
    def apply[F[_]](implicit F: Functor[F]): (C => F[D]) => A => F[B]
  }

  // lens :: (a -> c) -> (a -> d -> b) -> LensFamily a b c d
  // lens f g h a = fmap (g a) (h (f a))
  def lens[A, B, C, D](f: A => C, g: A => D => B): LensFamily[A, B, C, D] = {
    new LensFamily[A, B, C, D] {
      def apply[F[_]](implicit F: Functor[F]): ((C) => F[D]) => (A) => F[B] = {
        h => a =>  F.map(h(f(a)))(g(a))
      }
    }
  }

  //    iso :: (a -> c) -> (d -> b) -> LensFamily a b c d
  //    iso f g h a = fmap g (h (f a))
  def iso[A, B, C, D](f: A => C, g: D => B): LensFamily[A, B, C, D] = new LensFamily[A, B, C, D] {
    def apply[F[_]](implicit F: Functor[F]): ((C) => F[D]) => (A) => F[B] = {
      h => a => F.map(h(f(a)))(g)
    }
  }

  def fstLens[A, B, C, D]: LensFamily[(A,C), (B, C), A, B] = new LensFamily[(A,C), (B, C), A, B] {
    def apply[F[_]](implicit F: Functor[F]): ((A) => F[B]) => ((A, C)) => F[(B, C)] = {
      f => a => F.map(f(a._1))(x => (x, a._2))
    }
  }


  import Getter._
  def getFst[A, B]: Getter[(A, B), A] = getting(_._1)
  def getSnd[A, B]: Getter[(A, B), B] = getting(_._2)

  def sndLens[A, B, C, D]: LensFamily[(A,B), (A, C), B, C] = new LensFamily[(A,B), (A, C), B, C] {
    def apply[F[_]](implicit F: Functor[F]): ((B) => F[C]) => ((A, B)) => F[(A, C)] = {
      f => a => F.map(f(a._2))(a._1 -> _)
    }
  }

//  def swap[A, B](in: (A, B)): (B, A) = (in._2, in._1)
//  def swapped[A, B, C, D]: LensFamily[(A,B), (C,D), (B, A), (D, C)] = iso(swap, swap)
//  def negate[A: math.Numeric](a: A): A = implicitly[math.Numeric[A]].negate(a)

  def main = {
    import Getting._
    // using the lens
    ^(1->2)(fstLens.apply[({type l[a]=Getting[Int, a]})#l](gettingFunctor[Int]))
    // using the Getter
    ^(1->2)(getFst[Int, Int].apply[Int, Int, Int])

    import Setting._
    ^=[(Int, Int), (Int, Int), Int, Int](fstLens.apply[Setting](settingFunctor))(12)(1->2)

  }
}