Example of different approaches to wrapping STM with Cats

STMExample.scala

package com.changlinli

import cats.effect.{IO, Sync}
import cats.free.Free
import cats.implicits._
import cats.~>

import scala.language.higherKinds

/*
 * A skeleton demonstration of what STM might look like with a Free monad vs
 * tagless final. The standard tagless final approach is NOT what you want
 * here. In particular it makes STM _too_ composable with other monads. The
 * strength of the STM data type is precisely that it can't be combined with
 * other effects because STM might arbitrarily retry actions.
 *
 * This is problematic with tagless final because the straightforward interpreter
 * for STM into something like IO is the atomically operator, which executes
 * all the built-up STM actions in a single transaction. With the usual tagless
 * final machinery, this would force every STM action to be executed in a transaction
 * of its own, which defeats the purpose of having STM (allowing multiple STM
 * actions to be run in a single transaction).
 *
 * If you want to have tagless final work for STM you have two options (I think
 * ; there may be other ones I haven't thought of):
 *
 * 1. Hide the fact you're using tagless final behind some opaque data type.
 * 2. Use a non-standard representation of tagless final (e.g. just with
 *    standard OO interfaces/traits). I had a debate with some folks on the
 *    fs2 channel about whether that actually constitutes tagless final but
 *    that's really just a naming thing at that point.
 */

final case class TVar[A](x: A)

sealed trait STMAlgebra[A]
final case class NewTVar[A](a: A) extends STMAlgebra[TVar[A]]
final case class ReadTVar[A](tVar: TVar[A]) extends STMAlgebra[A]
final case class WriteTVar[A](tVar: TVar[A], value: A) extends STMAlgebra[Unit]

object FreeMonadExample {

  type STM[A] = Free[STMAlgebra, A]

  def newTVar[A](a: A): STM[TVar[A]] =
    Free.liftF(NewTVar(a): STMAlgebra[TVar[A]])

  def readTVar[A](tVar: TVar[A]): STM[A] =
    Free.liftF(ReadTVar(tVar) : STMAlgebra[A])

  def writeTVar[A](tVar: TVar[A], value: A): STM[Unit] =
    Free.liftF(WriteTVar(tVar, value): STMAlgebra[Unit])

  def ioInterpreter: STM ~> IO = ???

  def someCrazyEffect[F[_] : Sync]: F[Unit] = ???

  def atomically[A](stmAction: STM[A]): IO[A] =
    ioInterpreter(stmAction)

  // Does not compile and it shouldn't compile
  def attemptedBadSTMAction(tVar: TVar[Int]) = {
    for {
      currentValue <- readTVar(tVar)
      _ <- someCrazyEffect[IO] // You have to choose some concrete Monad here
      newValue = currentValue + 1
      _ <- writeTVar(tVar, newValue)
    } yield ()
  }
}

trait STMTaglessAlgebra[F[_]] {
  def newTVar[A](a: A): F[A]

  def readTVar[A](tVar: TVar[A]): F[A]

  def writeTVar[A](tVar: TVar[A], a: A): F[Unit]
}

object STMTaglessAlgebra {
  def apply[F[_]]: STMTaglessAlgebra[F] = implicitly[STMTaglessAlgebra[F]]
}

object TaglessFinalExample {

  def someCrazyEffect[F[_] : Sync]: F[Unit] = ???

  def myBadSTMAction[F[_] : Sync : STMTaglessAlgebra](tVar: TVar[Int]): F[Unit] = {
    for {
      currentValue <- STMTaglessAlgebra[F].readTVar(tVar)
      _ <- someCrazyEffect[F]
      newValue = currentValue + 1
      _ <- STMTaglessAlgebra[F].writeTVar(tVar, newValue)
    } yield ()
  }

  def stmInterpreter: STMTaglessAlgebra[IO] = ???

  val someTVar: TVar[Int] = ???

  val nonAtomicReadAndWrite: IO[Unit] = myBadSTMAction(someTVar)(implicitly, stmInterpreter)

}