Skip to content

Instantly share code, notes, and snippets.

@tel
Created June 21, 2016 14:31
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save tel/ccfb747f93b748a9a6ec3cc957886ac3 to your computer and use it in GitHub Desktop.
Save tel/ccfb747f93b748a9a6ec3cc957886ac3 to your computer and use it in GitHub Desktop.
Scala profunctor lens
import scala.language.higherKinds
import scala.language.implicitConversions
trait Pt[C[_[_, _]], S, T, A, B] {
def apply[~>[_, _]](ex: C[~>])(p: A ~> B): S ~> T
}
trait Profunctor[~>[_, _]] {
def dimap[X, Y, A, B](f: X => A, g: B => Y)(p: A ~> B): X ~> Y
def lmap[X, A, B](f: X => A)(p: A ~> B): X ~> B =
dimap[X, B, A, B](f, identity)(p)
def rmap[Y, A, B](g: B => Y)(p: A ~> B): A ~> Y =
dimap[A, Y, A, B](identity, g)(p)
}
trait Strong[~>[_, _]] extends Profunctor {
def first[X, A, B](p: A ~> B): (X, A) ~> (X, B)
}
trait Choice[~>[_, _]] extends Profunctor {
def left[X, A, B](p: A ~> B): Either[X, A] ~> Either[X, B]
}
type xLens[S, T, A, B] = Pt[Strong, S, T, A, B]
type xSLens[S, A] = xLens[S, S, A, A]
trait Lens[S, T, A, B] {
def get(s: S): A
def put(s: S, b: B): T
def over(f: A => B)(s: S): T
}
object Lens {
def id[A]: xSLens[A, A] = new Pt[Strong, A, A, A, A] {
def apply[~>[_, _]](ex: Strong[~>])(psa: ~>[A, A]) = psa
}
class Get[S] {
trait ~>[A, B] extends (A => S)
object ~> {
implicit def ofFunction[A, B](f: A => S): ~>[A, B] = new ~>[A, B] {
def apply(v: A) = f(v)
}
}
val isStrong: Strong[~>] = new Strong[~>] {
def dimap[X, Y, A, B](f: X => A, g: B => Y)(p: A ~> B): X ~> Y =
p compose f
def first[X, A, B](p: A ~> B): (X, A) ~> (X, B) =
~>.ofFunction { case (x, a) => p(a) }
}
}
object Over {
type ~>[A, B] = A => B
val isStrong: Strong[~>] = new Strong[~>] {
def dimap[X, Y, A, B](f: X => A, g: B => Y)(p: A ~> B): X ~> Y =
f andThen p andThen g
def first[X, A, B](p: A ~> B): (X, A) ~> (X, B) = {
case (x, a) => (x, p(a))
}
}
}
implicit def ofX[S, T, A, B](x: xLens[S, T, A, B]): Lens[S, T, A, B] =
new Lens[S, T, A, B] {
val G = new Get[A]
type ~>[X, Y] = G.~>[X, Y]
val getter = x(G.isStrong)
val overer = x(Over.isStrong)
def get(s: S): A = getter(identity[A])(s)
def put(s: S, b: B): T = over(_ => b)(s)
def over(f: A => B)(s: S): T = overer(f)(s)
}
}
@Softsapiens
Copy link

Softsapiens commented Dec 16, 2016

Hi, first of all thanks for sharing the code!

I made some changes to get it compiled with scala 2.12:

import scala.language.higherKinds
import scala.language.implicitConversions

trait Pt[C[_[_, _]], S, T, A, B] {
  def apply[~>[_, _]](ex: C[~>])(p: A ~> B): S ~> T
}

trait Profunctor[~>[_, _]] {
  def dimap[X, Y, A, B](f: X => A, g: B => Y)(p: A ~> B): X ~> Y

  def lmap[X, A, B](f: X => A)(p: A ~> B): X ~> B =
    dimap[X, B, A, B](f, identity)(p)

  def rmap[Y, A, B](g: B => Y)(p: A ~> B): A ~> Y =
    dimap[A, Y, A, B](identity, g)(p)
}

trait Strong[~>[_, _]] extends Profunctor[~>]  {
  def first[X, A, B](p: A ~> B): (X, A) ~> (X, B)
}

trait Choice[~>[_, _]] extends Profunctor[~>]  {
  def left[X, A, B](p: A ~> B): Either[X, A] ~> Either[X, B]
}

type xLens[S, T, A, B] = Pt[Strong, S, T, A, B]
type xSLens[S, A] = xLens[S, S, A, A]

trait Lens[S, T, A, B] {
  def get(s: S): A

  def put(s: S, b: B): T

  def over(f: A => B)(s: S): T
}

object Lens {
  def id[A]: xSLens[A, A] = new Pt[Strong, A, A, A, A] {
    def apply[~>[_, _]](ex: Strong[~>])(psa: ~>[A, A]) = psa
  }

  class Get[S] {

    trait ~>[A, B] extends (A => S)

    object ~> {
      implicit def ofFunction[A, B](f: A => S): ~>[A, B] = new ~>[A, B] {
        def apply(v: A) = f(v)
      }
    }


    val isStrong: Strong[~>] = new Strong[~>] {

      def dimap[X, Y, A, B](f: X => A, g: B => Y)(p: A ~> B): X ~> Y =
        p compose f

      def first[X, A, B](p: A ~> B): (X, A) ~> (X, B) =
        ~>.ofFunction { case (x, a) => p(a) }

    }
  }

  object Over {
    type ~>[A, B] = A => B

    val isStrong: Strong[~>] = new Strong[~>] {
      def dimap[X, Y, A, B](f: X => A, g: B => Y)(p: A ~> B): X ~> Y =
        f andThen p andThen g

      def first[X, A, B](p: A ~> B): (X, A) ~> (X, B) = {
        case (x, a) => (x, p(a))
      }
    }
  }

  implicit def ofX[S, T, A, B](x: xLens[S, T, A, B]): Lens[S, T, A, B] =
    new Lens[S, T, A, B] {
      val G = new Get[A]
      type ~>[X, Y] = G.~>[X, Y]
      val getter = x.apply(G.isStrong)(_)
      val overer = x.apply(Over.isStrong)(_)

      def get(s: S): A = getter(identity[A])(s)

      def put(s: S, b: B): T = over(_ => b)(s)

      def over(f: A => B)(s: S): T = overer(f)(s)
    }
}

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