Monad Transformers

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)
}

ID

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

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

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

abstract class WriteT[F[_]: Monad, A] {
  def runOut(write: String => ()): 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 => ()): 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 => ()): 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 => ()): 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 => ()): 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 => ()): 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 ()
program
  .runOut(print)
  .runEnv(sys.env)
  .runIn(scala.io.StdIn.readLine)

Demo

This file is literate Scala, and can be run using Codedown:

$ curl -s https://earldouglas.com/posts/effect-systems/mtx.md |
  codedown scala > script.scala
$ LANG=es scala -Dfile.encoding=UTF-8 -nc script.scala
¿Cómo te llamas? James
¡Hola, James!