Last active
December 6, 2019 01:54
-
-
Save notxcain/7568d6f764f47b15b140e001bf7b4b24 to your computer and use it in GitHub Desktop.
All you need is ReaderT (https://twitter.com/snoyberg/status/1083365544949096448)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import cats.data.Kleisli | |
import cats.effect.{ Concurrent, Sync } | |
import cats.effect.concurrent.MVar | |
import cats.implicits._ | |
import cats.{ Applicative, Functor, Monad } | |
// Let's start with our dsl | |
// First we need to interact with a console | |
trait Console[F[_]] { | |
def readLn: F[String] | |
def write(text: String): F[Unit] | |
} | |
// Then we need a key value store | |
trait KeyValueStore[F[_], K, A] { | |
def setValue(key: K, value: A): F[Unit] | |
def getValue(key: K): F[Option[A]] | |
} | |
// And finally we need to log what we do | |
trait Logger[F[_]] { | |
def log(message: String): F[Unit] | |
} | |
// Let's write our program | |
object Program { | |
def apply[F[_]: Monad](implicit c: Console[F], | |
kvs: KeyValueStore[F, String, String], | |
l: Logger[F]): F[Unit] = | |
for { | |
_ <- c.write("Enter a key: ") | |
key <- c.readLn | |
_ <- l.log(s"Querying KVS for key [$key]") | |
value <- kvs.getValue(key) | |
_ <- l.log(s"Got [$value]") | |
_ <- c.write(value.fold(s"No value for [$key]")(v => s"Current value is [$v]")) | |
_ <- c.write("\n") | |
_ <- c.write("Do you want to change the value (y/n/e)?: ") | |
answer <- c.readLn | |
_ <- answer match { | |
case "y" => | |
c.write("Enter value: ") >> | |
c.readLn.flatMap(kvs.setValue(key, _)) >> | |
l.log(s"$key = $value") >> | |
c.write("Done!\n") >> | |
Program[F] | |
case "n" => Program[F] | |
case _ => ().pure[F] | |
} | |
} yield () | |
} | |
// We gonna need an implementations for our algebra | |
final class InMemKeyValueStore[F[_]: Monad, K, V] private (mvar: MVar[F, Map[K, V]]) | |
extends KeyValueStore[F, K, V] { | |
override def setValue(key: K, value: V): F[Unit] = | |
mvar.take.flatMap(m => mvar.put(m.updated(key, value))) | |
override def getValue(key: K): F[Option[V]] = | |
mvar.read.map(_.get(key)) | |
} | |
object InMemKeyValueStore { | |
// Notice that creation of KeyValueStore is an effect. | |
def create[F[_]: Concurrent, K, V]: F[KeyValueStore[F, K, V]] = | |
MVar[F].of(Map.empty[K, V]).map(mvar => new InMemKeyValueStore(mvar)) | |
} | |
final class DefaultConsole[F[_]] private (implicit F: Sync[F]) extends Console[F] { | |
override def readLn: F[String] = F.delay(scala.io.StdIn.readLine()) | |
override def write(text: String): F[Unit] = F.delay(print(text)) | |
} | |
object DefaultConsole { | |
def create[F[_]: Sync]: F[Console[F]] = (new DefaultConsole[F](): Console[F]).pure[F] | |
} | |
final class RemoteLogger[F[_]: Applicative] extends Logger[F] { | |
override def log(message: String): F[Unit] = ().pure[F] | |
} | |
object RemoteLogger { | |
// Yes, I'm lazy. Because this is not the most exciting part. | |
// But it's important to notice that creation is also an effect. | |
def create[F[_]: Applicative]: F[Logger[F]] = | |
(new RemoteLogger[F]: Logger[F]).pure[F] | |
} | |
// What rather naive implementation would look like | |
object NaiveApp { | |
def run[F[_]: Concurrent]: F[Unit] = | |
InMemKeyValueStore.create[F, String, String].flatMap { implicit kvs => | |
RemoteLogger.create[F].flatMap { implicit logger => | |
DefaultConsole.create[F].flatMap { implicit console => | |
Program[F] | |
} | |
} | |
} | |
} | |
// Yes it works, but we have orphan type class instances. | |
// Orphans are something you would like to avoid because at scale it makes reasoning much harder. | |
// So we want to avoid orphan instances, yet be able to perform effect on instance creation | |
// Here is the machinery that we gonna need | |
// A `Has` type class. It just says that T contains A | |
trait Has[T, A] { | |
def get(t: T): A | |
} | |
object Has { | |
final class Builder[T] { | |
def apply[A](f: T => A): Has[T, A] = new Has[T, A] { | |
override def get(t: T): A = f(t) | |
} | |
} | |
def instance[T]: Builder[T] = new Builder[T] | |
object syntax { | |
implicit final class HasSyntaxIdOps[T](val a: T) extends AnyVal { | |
def get[X](implicit T: Has[T, X]): X = T.get(a) | |
} | |
} | |
} | |
// An `Ask` type class, says that can as for A out of a thin air performing effect F[_] | |
trait Ask[F[_], A] { | |
def ask: F[A] | |
} | |
object Ask { | |
implicit def kleisliHasInstance[F[_]: Applicative, A]: Ask[Kleisli[F, A, ?], A] = | |
new Ask[Kleisli[F, A, ?], A] { | |
override def ask: Kleisli[F, A, A] = Kleisli.ask[F, A] | |
} | |
def ask[F[_], A](implicit ask: Ask[F, A]): F[A] = ask.ask | |
} | |
// A 'Lift' type class says that we can lift F[A] into G[A] | |
trait Lift[F[_], G[_]] { | |
def lift[A](fa: F[A]): G[A] | |
} | |
object Lift { | |
object syntax { | |
implicit final class LiftOps[F[_], A](val fa: F[A]) extends AnyVal { | |
def lift[G[_]](implicit lift: Lift[F, G]): G[A] = lift.lift(fa) | |
} | |
} | |
implicit def kleisliLift[F[_], A]: Lift[F, Kleisli[F, A, ?]] = new Lift[F, Kleisli[F, A, ?]] { | |
override def lift[B](fb: F[B]): Kleisli[F, A, B] = Kleisli.liftF(fb) | |
} | |
} | |
// Now the interesting part | |
import Ask._ | |
import Has.syntax._ | |
import Lift.syntax._ | |
object Logger { | |
// We got a proper instance here. | |
// Let's read our constraints | |
// For any G[_] which: | |
// - is a Monad | |
// - can provide an Env[F], which has a Logger[F] and F can be lifted to G | |
// we have an instance of Logger[G] | |
// Yes it looks like a lot of boilerplate | |
// But it can be totally eliminated using ReifiedInvocations type class, | |
// but let's keep this pain for now | |
implicit def instance[F[_], G[_]: Monad: Ask[?[_], Env[F]], Env[_]](implicit | |
has: Has[Env[F], Logger[F]], | |
lift: Lift[F, G]): Logger[G] = | |
new Logger[G] { | |
override def log(text: String): G[Unit] = | |
for { | |
env <- ask[G, Env[F]] | |
_ <- env.get[Logger[F]].log(text).lift[G] | |
} yield () | |
} | |
} | |
object KeyValueStore { | |
implicit def instance[F[_], G[_]: Monad: Ask[?[_], Env[F]], Env[_], K, V]( | |
implicit | |
has: Has[Env[F], KeyValueStore[F, K, V]], | |
lift: Lift[F, G] | |
): KeyValueStore[G, K, V] = | |
new KeyValueStore[G, K, V] { | |
override def setValue(key: K, value: V): G[Unit] = | |
for { | |
env <- ask[G, Env[F]] | |
out <- env.get[KeyValueStore[F, K, V]].setValue(key, value).lift[G] | |
} yield out | |
override def getValue(key: K): G[Option[V]] = | |
for { | |
env <- ask[G, Env[F]] | |
out <- env.get[KeyValueStore[F, K, V]].getValue(key).lift[G] | |
} yield out | |
} | |
} | |
object Console { | |
implicit def instance[F[_], G[_]: Monad: Ask[?[_], Env[F]], Env[_]]( | |
implicit | |
has: Has[Env[F], Console[F]], | |
lift: Lift[F, G] | |
): Console[G] = | |
new Console[G] { | |
override def write(text: String): G[Unit] = | |
for { | |
env <- ask[G, Env[F]] | |
_ <- env.get[Console[F]].write(text).lift[G] | |
} yield () | |
override def readLn: G[String] = | |
for { | |
env <- ask[G, Env[F]] | |
_ <- env.get[Console[F]].readLn.lift[G] | |
} yield () | |
} | |
} | |
final case class Env[F[_]](logger: Logger[F], | |
kvs: KeyValueStore[F, String, String], | |
console: Console[F]) | |
object Env { | |
implicit def hasLogger[F[_]] = Has.instance[Env[F]](_.logger) | |
implicit def hasKVS[F[_]] = Has.instance[Env[F]](_.kvs) | |
implicit def hasConsole[F[_]] = Has.instance[Env[F]](_.console) | |
} | |
object App { | |
def run[F[_]: Concurrent]: F[Unit] = | |
for { | |
logger <- RemoteLogger.create[F] | |
kvs <- InMemKeyValueStore.create[F, String, String] | |
console <- DefaultConsole.create[F] | |
env = Env(logger, kvs, console) | |
program = Program[Kleisli[F, Env[F], ?]] | |
_ <- program.run(env) | |
} yield () | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment