Monad Transformers

Monad transformers allow us to stack monads in way that lets us treat them as a single monadic type. this lets us "flatten" our for comprehensions.

Monad transformers look like they're inside-out. OptionT[Future, A] behaves like Future[Option[A]] if you wave your hands and squint.

Monad

trait Monad[M[_]] {
  def pure[A](x: A): M[A]
  def map[A, B](x: M[A])(f: A => B): M[B] = flatMap(x)(a => pure(f(a)))
  def flatMap[A, B](x: M[A])(f: A => M[B]): M[B]
}

implicit class MonadOps[M[_]: Monad, A](ma: M[A]) {
  val M = implicitly[Monad[M]]
  def map[B](f: A => B): M[B] = M.map(ma)(f)
  def flatMap[B](f: A => M[B]): M[B] = M.flatMap(ma)(f)
}

We'll need a monadic type at the bottom of our monad transformer stack that gives us access to its own value.

type ID[A] = A

implicit val idMonad: Monad[ID] =
  new Monad[ID] {
    override def pure[A](x: A): ID[A] = x
    override def flatMap[A, B](x: ID[A])(f: A => ID[B]): ID[B] = f(x)
  }

ReadEnvT

Our environment-reading effect abstracts over a continuation from the environment to a value.

abstract class ReadEnvT[F[_]: Monad, A] {
  def runEnv(env: Map[String, String]): F[A]
}

implicit def readEnvTMonad[F[_]: Monad]: Monad[({type λ[α] = ReadEnvT[F, α]})#λ] =
  new Monad[({type λ[α] = ReadEnvT[F, α]})#λ] {

    val F = implicitly[Monad[F]]

    override def pure[A](x: A): ReadEnvT[F, A] =
      new ReadEnvT[F, A] {
        override def runEnv(env: Map[String, String]): F[A] =
          F.pure(x)
      }

    override def flatMap[A, B](x: ReadEnvT[F, A])(f: A => ReadEnvT[F, B]): ReadEnvT[F, B] =
      new ReadEnvT[F, B] {
        override def runEnv(env: Map[String, String]): F[B] =
          F.flatMap(F.map(x.runEnv(env))(f))(_.runEnv(env))
      }
  }

ReadLnT

Our line-reading effect abstracts over a continuation from a line-reading function to a value.

abstract class ReadLnT[F[_]: Monad, A] {
  def runIn(readLn: () => String): F[A]
}

implicit def readLnTMonad[F[_]: Monad]: Monad[({type λ[α] = ReadLnT[F, α]})#λ] =
  new Monad[({type λ[α] = ReadLnT[F, α]})#λ] {

    val F = implicitly[Monad[F]]

    override def pure[A](x: A): ReadLnT[F, A] =
      new ReadLnT[F, A] {
        override def runIn(readLn: () => String): F[A] =
          F.pure(x)
      }

    override def flatMap[A, B](x: ReadLnT[F, A])(f: A => ReadLnT[F, B]): ReadLnT[F, B] =
      new ReadLnT[F, B] {
        override def runIn(readLn: () => String): F[B] =
          F.flatMap(F.map(x.runIn(readLn))(f))(_.runIn(readLn))
      }
  }

WriteT

Our line-reading effect abstracts over a continuation from a line-writing function to a value.

abstract class WriteT[F[_]: Monad, A] {
  def runOut(write: String => Unit): F[A]
}

implicit def writeTMonad[F[_]: Monad]: Monad[({type λ[α] = WriteT[F, α]})#λ] =
  new Monad[({type λ[α] = WriteT[F, α]})#λ] {

    val F = implicitly[Monad[F]]

    override def pure[A](x: A): WriteT[F, A] =
      new WriteT[F, A] {
        override def runOut(write: String => Unit): F[A] =
          F.pure(x)
      }

    override def flatMap[A, B](x: WriteT[F, A])(f: A => WriteT[F, B]): WriteT[F, B] =
      new WriteT[F, B] {
        override def runOut(write: String => Unit): F[B] =
          F.flatMap(F.map(x.runOut(write))(f))(_.runOut(write))
      }
  }

Usage

type Program[A] = WriteT[({type λ[α] = ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, α] })#λ, A]

def readEnv(name: String): Program[String] =
  new WriteT[({type λ[α] = ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, α] })#λ, String] {
    def runOut(write: String => Unit): ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, String] = {
      new ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, String] {
        override def runEnv(env: Map[String, String]): ReadLnT[ID, String] =
          new ReadLnT[ID, String] {
            override def runIn(readLn: () => String): String = {
              env(name)
            }
          }
      }
    }
  }

def readLn(): Program[String] =
  new WriteT[({type λ[α] = ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, α] })#λ, String] {
    def runOut(write: String => Unit): ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, String] = {
      new ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, String] {
        override def runEnv(env: Map[String, String]): ReadLnT[ID, String] =
          new ReadLnT[ID, String] {
            override def runIn(readLn: () => String): String = {
              readLn()
            }
          }
      }
    }
  }

def write(output: String): Program[Unit] =
  new WriteT[({type λ[α] = ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, α] })#λ, Unit] {
    def runOut(write: String => Unit): ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, Unit] = {
      new ReadEnvT[({type λ[α] = ReadLnT[({type λ[α] = ID[α]})#λ, α]})#λ, Unit] {
        override def runEnv(env: Map[String, String]): ReadLnT[ID, Unit] =
          new ReadLnT[ID, Unit] {
            override def runIn(readLn: () => String): Unit = {
              write(output)
            }
          }
      }
    }
  }

val enProgram: Program[Unit] =
  for {
    _    <- write("What's your name? ")
    name <- readLn()
    _    <- write(s"Hello, ${name}!\n")
  } yield ()

val esProgram: Program[Unit] =
  for {
    _    <- write("¿Cómo te llamas? ")
    name <- readLn()
    _    <- write(s"¡Hola, ${name}!\n")
  } yield ()

val program: Program[Unit] =
  for {
    lang <- readEnv("LANG")
    _    <- if (lang.startsWith("es")) {
              esProgram
            } else {
              enProgram
            }
  } yield ()