Skip to content

Instantly share code, notes, and snippets.

@purefn
Created January 15, 2016 20:36
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save purefn/d58db2c01d7bdac3cf11 to your computer and use it in GitHub Desktop.
Save purefn/d58db2c01d7bdac3cf11 to your computer and use it in GitHub Desktop.
import scalaz._
import Scalaz._
import scalaz.effect._
package object types {
type Bytes = String
type Path = String
}
import types._
// The API for cloud files.
trait MonadCloud[M[_]] {
def saveFile(p: Path, data: Bytes): M[Unit]
def listFiles(p: Path): M[List[Path]]
}
object MonadCloud {
@inline def apply[M[_]](implicit M: MonadCloud[M]) = M
}
sealed trait Level
case object Debug extends Level
case object Info extends Level
// The API for logging.
trait MonadLog[M[_]] {
def log(l: Level, message: String): M[Unit]
}
object MonadLog {
@inline def apply[M[_]](implicit M: MonadLog[M]) = M
@inline def log[M[_]: MonadLog](l: Level, message: String): M[Unit] =
MonadLog[M].log(l, message)
}
// The API for REST clients.
trait MonadRest[M[_]] {
def get(p: Path): M[Bytes]
def put(p: Path, data: Bytes): M[Bytes]
}
object MonadRest {
@inline def apply[M[_]](implicit M: MonadRest[M]) = M
}
// An instrumenting implementation that adds logging to every call.
final case class CloudFilesLogT[M[_], A](run: M[A])
object CloudFilesLogT {
// in practice, we'd want to also create separate Functor and Apply instances at lower implicit priority levels
implicit def CloudFilesLogTMonad[G[_]: Monad] =
new Monad[CloudFilesLogT[G, ?]] {
def point[A](a: => A) = CloudFilesLogT(Monad[G].point(a))
def bind[A, B](fa: CloudFilesLogT[G, A])(f: A => CloudFilesLogT[G, B]) =
CloudFilesLogT(Monad[G].bind(fa.run)(f(_).run))
}
implicit val CloudFilesLogTMonadTrans =
new MonadTrans[CloudFilesLogT] {
def liftM[G[_]: Monad, A](a: G[A]) = CloudFilesLogT(a)
def apply[G[_]: Monad] = CloudFilesLogTMonad[G]
}
implicit def CloudFilesLogTMonadLog[G[_]: Monad: MonadLog] =
new MonadLog[CloudFilesLogT[G, ?]] {
def log(l: Level, m: String) =
CloudFilesLogT(MonadLog[G].log(l, m))
}
implicit def CloudFilesLogTMonadCloud[G[_]: Monad](implicit Log: MonadLog[G], Cloud: MonadCloud[G]) =
new MonadCloud[CloudFilesLogT[G, ?]] {
def saveFile(p: Path, bytes: Bytes) = CloudFilesLogT {
Log.log(Debug, "Saving file: " ++ p) >>
Cloud.saveFile(p, bytes)
}
def listFiles(p: Path) = CloudFilesLogT {
Log.log(Debug, "Listing " ++ p) >>
Cloud.listFiles(p)
}
}
}
// An implementation of logging to standard out.
case class StdoutLoggingT[M[_], A](run: M[A])
object StdoutLoggingT {
implicit def StdoutLoggingTMonadIO[G[_]: MonadIO] =
new MonadIO[StdoutLoggingT[G, ?]] {
def point[A](a: => A) = StdoutLoggingT(Monad[G].point(a))
def bind[A, B](fa: StdoutLoggingT[G, A])(f: A => StdoutLoggingT[G, B]) =
StdoutLoggingT(Monad[G].bind(fa.run)(f(_).run))
def liftIO[A](ioa: IO[A]) = StdoutLoggingT(MonadIO[G].liftIO(ioa))
}
implicit def StdoutLoggingTMonadLog[M[_]: MonadIO] =
new MonadLog[StdoutLoggingT[M, ?]] {
def log(l: Level, msg: String) =
StdoutLoggingT(MonadIO[M].liftIO {
l match {
case Info => IO.putStrLn("[Info] " ++ msg)
case Debug => IO.putStrLn("[Debug] " ++ msg)
}
})
}
}
// An implementation of MonadCloud that uses a REST client.
case class CloudFilesRestT[M[_], A](run: M[A])
object CloudFilesRestT {
implicit def CloudFilesRestTMonad[G[_]: Monad] =
new Monad[CloudFilesRestT[G, ?]] {
def point[A](a: => A) = CloudFilesRestT(Monad[G].point(a))
def bind[A, B](fa: CloudFilesRestT[G, A])(f: A => CloudFilesRestT[G, B]) =
CloudFilesRestT(Monad[G].bind(fa.run)(f(_).run))
}
implicit def CloudFilesRestTMonadLog[G[_]: Monad: MonadLog] =
new MonadLog[CloudFilesRestT[G, ?]] {
def log(l: Level, m: String) =
CloudFilesRestT(MonadLog[G].log(l, m))
}
implicit def CloudFilesRestTMonadRest[G[_]: Monad: MonadRest] =
new MonadRest[CloudFilesRestT[G, ?]] {
def get(p: Path) = CloudFilesRestT(MonadRest[G].get(p))
def put(p: Path, data: Bytes) = CloudFilesRestT(MonadRest[G].put(p, data))
}
implicit def CloudFilesRestTMonadCloud[G[_]: Monad: MonadRest] =
new MonadCloud[CloudFilesRestT[G, ?]] {
def saveFile(path: Path, bytes: Bytes) =
CloudFilesRestT(MonadRest[G].put("/file/" ++ path, bytes).as(()))
def listFiles(path: Path) =
CloudFilesRestT(MonadRest[G].get("/files/" ++ path).as(List("MockFile")))
}
}
// A (non-functional) REST client.
case class RestClientT[M[_], A](run: M[A])
object RestClientT {
implicit def RestClientTMonadIO[G[_]: MonadIO] =
new MonadIO[RestClientT[G, ?]] {
def point[A](a: => A) = RestClientT(Monad[G].point(a))
def bind[A, B](fa: RestClientT[G, A])(f: A => RestClientT[G, B]) =
RestClientT(Monad[G].bind(fa.run)(f(_).run))
def liftIO[A](ioa: IO[A]) = RestClientT(MonadIO[G].liftIO(ioa))
}
implicit def RestClientTMonadLog[G[_]: Monad: MonadLog] =
new MonadLog[RestClientT[G, ?]] {
def log(l: Level, m: String) =
RestClientT(MonadLog[G].log(l, m))
}
implicit def RestClientTMonadRest[G[_]: MonadIO] =
new MonadRest[RestClientT[G, ?]] {
def get(path: Path) =
RestClientT(MonadIO[G].liftIO(IO.putStrLn("I should GET " ++ path)).as(""))
def put(path: Path, bytes: Bytes) =
RestClientT(MonadIO[G].liftIO(IO.putStrLn("I should PUT " ++ path ++ " " ++ bytes)).as(""))
}
}
object App extends SafeApp {
// Our application only talks about MonadCloud and MonadLog.
def app[M[_]: Monad](implicit Cloud: MonadCloud[M], Log: MonadLog[M]) =
for {
fs <- Cloud.listFiles("/home/ollie")
f = fs.head
_ <- Log.log(Info, "Found " ++ f)
_ <- Cloud.saveFile(f, "Ollie")
} yield ()
// we should be able to use
//
// app[CloudFilesLogT[CloudFilesRestT[RestClientT[StdoutLoggingT[IO, ?], ?], ?], ?]]
//
// but kind-projector will use the same parameter names for each of the type lambdas and
// the scalac linter will cause a compile error due to shadowing, so we
// construct it manually here
type StdoutLogging[A] = StdoutLoggingT[IO, A]
type RestClient[A] = RestClientT[StdoutLogging, A]
type CloudFilesRest[A] = CloudFilesRestT[RestClient, A]
type App[A] = CloudFilesLogT[CloudFilesRest, A]
// Running the application chooses to instrument with extra logging, use the
// REST client and to send all logs to stdout.
override def runc =
app[App].run.run.run.run
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment