Automatic generation of lenses and MonadState instances based on 'em

autolenses.scala

import cats.Monad
import cats.data.StateT
import cats.effect._
import cats.implicits._
import cats.mtl._
import cats.mtl.implicits._
import shapeless._
import scala.language.higherKinds

case class Health(num: Int)
case class Player(name: String, health: Health)

object Sample extends App {

  implicit def zoomMonadState[F[_], S, A](
      implicit
      MS: MonadState[F, S],
      ne: S =:!= A,
      mkLens: Lazy[AutoLens[S, A]]): MonadState[F, A] =
    new MonadState[F, A] with DefaultMonadState[F, A] {
      private[this] val lens = mkLens.value.lens
      implicit val monad: Monad[F] = MS.monad

      def get: F[A] = MS.get.map(lens.get)
      def set(s: A): F[Unit] = MS.modify(lens.set(_)(s))
    }

  // These two only require Health part, they would pick one from player
  def healUp[F[_]](implicit F: MonadState[F, Health]): F[Unit] =
    F.set(Health(100))

  def damage[F[_]](implicit F: MonadState[F, Health]): F[Unit] =
    F.modify { h =>
      Health(h.num - 30)
    }

  // This one only wants Int, it would find one in Health in Player
  def printInt[F[_]: Sync](implicit F: MonadState[F, Int]): F[Unit] =
    F.get.flatMap { value =>
      Sync[F].delay(println(s"Current value is $value"))
    }

  // This one only wants String, it would find the name of Player
  def greet[F[_]: Sync](implicit F: MonadState[F, String]): F[Unit] =
    F.get.flatMap { name =>
      Sync[F].delay(println(s"Hello, $name"))
    }

  // ... and you can combine them all together
  def program[F[_]: Sync](implicit F: MonadState[F, Player]): F[Unit] =
    for {
      _ <- greet
      _ <- printInt
      _ <- damage
      _ <- printInt
      _ <- healUp
      _ <- printInt
    } yield ()

  type St[A] = StateT[IO, Player, A]

  program[St]
    .runS(Player("Oleg", Health(42)))
    .flatMap(player => IO(println(player)))
    .unsafeRunSync()
}

class AutoLens[S, A](val lens: Lens[S, A])

trait AutoLensLP0 {
  implicit def root[S]: AutoLens[S, S] = new AutoLens(OpticDefns.id[S])

  implicit def hlistElem[L <: HList, A](
      implicit
      mkHListSelectLens: MkHListSelectLens[L, A]) =
    new AutoLens(mkHListSelectLens())
}

trait AutoLensLP1 extends AutoLensLP0 {
  implicit def deriveInstance[A, L, S](
      implicit
      gen: MkGenericLens.Aux[A, L],
      ll: Lazy[AutoLens[L, S]]): AutoLens[A, S] =
    new AutoLens(ll.value.lens compose gen())
}

trait AutoLensLP2 extends AutoLensLP1 {
  implicit def deriveTail[H, T <: HList, A](
      implicit
      ll: Lazy[AutoLens[T, A]]): AutoLens[H :: T, A] =
    new AutoLens(new Lens[H :: T, A] {
      private[this] val tlz = ll.value.lens

      def get(s: H :: T): A = tlz.get(s.tail)
      def set(s: H :: T)(a: A): H :: T = s.head :: tlz.set(s.tail)(a)
    })
}

object AutoLens extends AutoLensLP2 {
  implicit def deriveHead[H, T <: HList, A](
      implicit
      ll: Lazy[AutoLens[H, A]]): AutoLens[H :: T, A] =
    new AutoLens(new Lens[H :: T, A] {
      private[this] val hlz = ll.value.lens

      def get(s: H :: T): A = hlz.get(s.head)
      def set(s: H :: T)(a: A): H :: T = hlz.set(s.head)(a) :: s.tail
    })
}