Free version of Invariant functor type class + Monoidal type class

FreeInvariantMonoidal.scala

package nl.mdj

import cats._
import cats.arrow.NaturalTransformation
import cats.functor.Invariant
import cats.state._
import cats.syntax.all._

import scala.language.{implicitConversions, higherKinds}

sealed abstract class FreeInvariant[F[_], A] extends Product with Serializable {

  import FreeInvariant.{FA, Imap, Zip}

  def imap[B](f: A => B)(g: B => A): FA[F, B] = Imap(this, f, g)

  def product[B](b: FreeInvariant[F, B]): FA[F, (A, B)] = Zip(this, b)

  def foldMap[G[_]](n: F ~> G)(implicit I: Invariant[G], M: Monoidal[G]): G[A]
}


object FreeInvariant {

  type FA[F[_], A] = FreeInvariant[F, A]

  private final case class Zip[F[_], A, B](fa: FA[F, A], fb: FA[F, B]) extends FA[F, (A,B)] {
    def foldMap[G[_]](n: F ~> G)
                     (implicit I: Invariant[G], M: Monoidal[G]): G[(A,B)] =
      M.product(fa.foldMap(n), fb.foldMap(n))
  }

  private final case class Suspend[F[_], A](value: F[A]) extends FA[F, A] {
    def foldMap[G[_]](n: F ~> G)
                     (implicit I: Invariant[G], M: Monoidal[G]): G[A] =
      n.apply(value)
  }

  private final case class Imap[F[_], X, Y](value: FA[F, X], g: X => Y, f: Y => X) extends FA[F, Y] {
    def foldMap[G[_]](n: F ~> G)
                     (implicit I: Invariant[G], M: Monoidal[G]): G[Y] =
      I.imap(value.foldMap(n))(g)(f)
  }

  final def lift[F[_], A](a: F[A]): FA[F, A] = Suspend(a)

  implicit def imap[F[_]]: Invariant[FA[F, ?]] = new Invariant[FA[F, ?]] {
    override def imap[A, B](fa: FA[F, A])(f: (A) => B)(g: (B) => A): FA[F, B] = fa.imap(f)(g)
  }

  implicit def monoidal[F[_]]: Monoidal[FA[F, ?]] = new Monoidal[FA[F, ?]] {
    override def product[A, B](fa: FA[F, A], fb: FA[F, B]): FA[F, (A, B)] = fa.product(fb)
  }

}

object Main extends App {

  object algebra {
    sealed trait RoutePartF[A]
    object RoutePartF {
      final case class IntPart[A](description: Option[String], f: Int => A, g: A => Int) extends RoutePartF[A]
      final case class Slash[A](f: Unit => A, g: A => Unit) extends RoutePartF[A]
      final case class Segment[A](text: String, f: Unit => A, g: A => Unit) extends RoutePartF[A]
    }
  }

  object dsl {
    import algebra._
    type Dsl[A] = FreeInvariant[RoutePartF, A]

    implicit class RichDsl[A](val self: Dsl[A]) {
      def /[B](other: Dsl[B]) = self |@| slash |@| other
    }

    private def lift[A](value: RoutePartF[A]): Dsl[A] = FreeInvariant.lift[RoutePartF, A](value)

    def int(description: Option[String] = None): Dsl[Int] = lift(RoutePartF.IntPart(description, identity, identity))
    def slash: Dsl[Unit] = lift(RoutePartF.Slash(identity, identity))
    def segment(text: String): Dsl[Unit] = lift(RoutePartF.Segment(text, identity, identity))

    implicit def strToSegment(str: String): Dsl[Unit] = segment(str)
  }

  import algebra._
  import dsl._

  case class GameId(id: Int)

  val gameId = int(description = Some("A game id")).imap(GameId.apply)(_.id)
  val route = (segment("test") / gameId).tupled

  val codec = route.foldMap(new NaturalTransformation[RoutePartF, Codec] {
    override def apply[A](fa: RoutePartF[A]): Codec[A] = fa match {
      case RoutePartF.IntPart(_, f, g) => Codec.int.imap(f, g)
      case RoutePartF.Segment(text, f, g) => Codec.const(text).imap(f, g)
      case RoutePartF.Slash(f, g) => Codec.const("/").imap(f, g)
    }
  })

  case class Doc(help: String = "") {
    def --> (h: String): Doc =
      copy(help = help + h)
  }

  type DocState[A] = State[Doc, A]

  val docs = route.foldMap(new NaturalTransformation[RoutePartF, DocState] {
    override def apply[A](fa: RoutePartF[A]): DocState[A] = fa match {
      case RoutePartF.IntPart(Some(help), f, g) => State.modify[Doc](_ --> s"int : $help") *> State.pure(f(0))
      case RoutePartF.IntPart(None, f, g) => State.pure(f(0))
      case RoutePartF.Segment(text, f, g) => State.modify[Doc](_ --> text) *> State.pure(f())
      case RoutePartF.Slash(f, g) => State.modify[Doc](_ --> "/") *> State.pure(f())
    }
  })

  println(docs.run(Doc()).value)

  println(codec.encode(((), (), GameId(5))))

  implicit def invariantState[S]: Invariant[State[S, ?]] = new Invariant[State[S, ?]] {
    override def imap[A, B](fa: State[S, A])(f: (A) => B)(g: (B) => A): State[S, B] = fa.map(f)
  }

  implicit def monoidalState[S]: Monoidal[State[S, ?]] = new Monoidal[State[S, ?]] {
    override def product[A, B](fa: State[S, A], fb: State[S, B]): State[S, (A, B)] = for {
      a <- fa
      b <- fb
    } yield a -> b
  }

  trait Codec[A] { self =>
    def encode(a: A): String

    /** This is currently broken, decode should return a DecodeResult/Cursor which tracks the position, strips off the processed stuff */
    def decode(v: String): Option[A]
    def imap[B](f: A => B, g: B => A): Codec[B] = new Codec[B] {
      override def encode(a: B): String = self.encode(g(a))
      override def decode(v: String): Option[B] = self.decode(v).map(f)
    }
  }

  object Codec {
    def const(text: String) = new Codec[Unit] {
      override def encode(a: Unit): String = text
      override def decode(v: String): Option[Unit] = ???
    }

    val int = new Codec[Int] {
      override def encode(a: Int): String = a.toString
      override def decode(v: String): Option[Int] = ???
    }

    implicit val invariant: Invariant[Codec] = new Invariant[Codec] {
      override def imap[A, B](fa: Codec[A])(f: (A) => B)(g: (B) => A): Codec[B] = fa.imap(f, g)
    }
    implicit val monoidal: Monoidal[Codec] = new Monoidal[Codec] {
      override def product[A, B](fa: Codec[A], fb: Codec[B]): Codec[(A, B)] = new Codec[(A, B)] {
        override def encode(a: (A, B)): String = fa.encode(a._1) ++ fb.encode(a._2)
        override def decode(v: String): Option[(A, B)] = for {
          a <- fa.decode(v)
          b <- fb.decode(v)
        } yield a -> b
      }
    }
  }

}