Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- package com.rr.sinks
- package util
- import language._
- import scala.concurrent.duration.Duration
- import scalaz._
- import scalaz.effect._
- import scalaz.syntax.monad._
- // note that F[A] === F[TimeoutT[Identity, A]]
- final class TimeoutT[F[_], A] private[util] (private[util] val fa: F[A], private[util] val delay: Duration, private[util] val transform: A => TimeoutT[F, A]) {
- private[this] val init = System.currentTimeMillis
- def run(implicit FL: LiftIO[F], F: Monad[F]): F[A] = {
- val back = if (delay.isFinite) {
- val check = FL.liftIO(IO { System.currentTimeMillis < init + delay.toMillis })
- check flatMap { flag =>
- if (flag)
- fa
- else
- fa flatMap { transform(_).run }
- }
- } else {
- fa
- }
- back
- }
- def flatMap[B](f: A => TimeoutT[F, B])(implicit FL: LiftIO[F], F: Monad[F]): TimeoutT[F, B] = {
- val fa = run flatMap { fa =>
- f(fa).run
- }
- TimeoutT(fa)
- }
- def map[B](f: A => B)(implicit FL: LiftIO[F], F: Monad[F]): TimeoutT[F, B] = TimeoutT(run map f)
- }
- object TimeoutT extends TimeoutTInstances {
- def apply[F[_], A](fa: F[A]): TimeoutT[F, A] =
- new TimeoutT(fa, Duration.Inf, { _: A => sys.error("assertion error") }) // definitional failure if we hit this case
- def setTimeout[F[_], A](a: F[A], delay: Duration)(transform: A => TimeoutT[F, A]): TimeoutT[F, A] =
- new TimeoutT(a, delay, transform)
- }
- sealed abstract class TimeoutTInstances1 {
- implicit def timeoutTFunctor[F[_], A](implicit FL0: LiftIO[F], F0: Monad[F]): Functor[({ type λ[α] = TimeoutT[F, α] })#λ] = new TimeoutTFunctor[F] {
- def FL = FL0
- def F = F0
- }
- }
- sealed abstract class TimeoutTInstances0 extends TimeoutTInstances1 {
- implicit def timeoutTMonad[F[_], A](implicit FL0: LiftIO[F], F0: Monad[F]): Monad[({ type λ[α] = TimeoutT[F, α] })#λ] = new TimeoutTMonad[F] {
- def FL = FL0
- def F = F0
- }
- }
- sealed abstract class TimeoutTInstances extends TimeoutTInstances0 {
- implicit val timeoutTMonadTrans: Hoist[TimeoutT] = new TimeoutTHoist {}
- }
- private trait TimeoutTFunctor[F[_]] extends Functor[({ type λ[α] = TimeoutT[F, α] })#λ] {
- implicit def FL: LiftIO[F]
- implicit def F: Monad[F]
- override def map[A, B](fa: TimeoutT[F, A])(f: A => B): TimeoutT[F, B] = fa map f
- }
- private trait TimeoutTMonad[F[_]] extends Monad[({ type λ[α] = TimeoutT[F, α] })#λ] {
- implicit def FL: LiftIO[F]
- implicit def F: Monad[F]
- def point[A](a: => A): TimeoutT[F, A] = TimeoutT(F point a)
- def bind[A, B](fa: TimeoutT[F, A])(f: A => TimeoutT[F, B]): TimeoutT[F, B] = fa flatMap f
- }
- private trait TimeoutTHoist extends Hoist[TimeoutT] {
- // monad constraint is actually unnecessary here except to preserve signature
- def liftM[G[_]: Monad, A](a: G[A]): TimeoutT[G, A] = TimeoutT(a)
- def hoist[M[_]: Monad, N[_]](f: M ~> N) = new (({ type λ[α] = TimeoutT[M, α] })#λ ~> ({ type λ[α] = TimeoutT[N, α] })#λ) {
- def apply[A](fa: TimeoutT[M, A]): TimeoutT[N, A] = {
- new TimeoutT(f(fa.fa), fa.delay, fa.transform andThen apply)
- }
- }
- def apply[G[_]: Monad]: Monad[({ type λ[α] = TimeoutT[G, α] })#λ] = ???
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement