Using monads to enforce programming style your Boss likes

trait Service[M[_]] {

  def repo: Repository[M]
  def doSth(request: Request)(implicit ev: Monad[M]): M[Either[Error, Result]] =
    EitherT
      .fromOptionF(repo.findSomeData(request.computeCondition), ifNone = NotFound: Error)
      .ensure(onFailure = NotValid)(_.isValid)
      .flatMapF(dto => updateDto(dto.update(request.computeNewValue)))
      .semiflatMap(dto => inspectData(request, dto).tupleLeft(dto))
      .map {
        case (dto, (Some(x), xs)) if xs.contains(x) => EvenBetter(dto, x)
        case (dto, _)                               => Ok(dto)
      }
      .value

  private def inspectData(request: Request, dto: DTO)(implicit ev: Applicative[M]) =
    (repo.findSomeRelatedData(dto), 
     repo.filterSomething(dto, request.computeAnotherCondition)).tupled
  private def updateDto(dto: DTO)(implicit ev: Functor[M]) =
    repo.update(dto).map(updated => Either.cond(updated == 1, dto, StarsAreNotRight: Error))

}

But EitherT is nice. Look ...

trait Service[M[_]] {

  def repo: Repository[M]
  def doSth(request: Request)(implicit ev: Monad[M]): M[Either[Error, Result]] =
    EitherT
      .fromOptionF(repo.findSomeData(request.computeCondition), ifNone = NotFound: Error)
      .ensure(onFailure = NotValid)(_.isValid)
      .flatMapF(dto => updateDto(dto.update(request.computeNewValue)))
      .semiflatMap(dto => inspectData(request, dto).tupleLeft(dto))
      .map {
        case (dto, (Some(x), xs)) if xs.contains(x) => EvenBetter(dto, x)
        case (dto, _)                               => Ok(dto)
      }
      .value

  private def inspectData(request: Request, dto: DTO)(implicit ev: Applicative[M]) =
    (repo.findSomeRelatedData(dto), 
     repo.filterSomething(dto, request.computeAnotherCondition)).tupled
  private def updateDto(dto: DTO)(implicit ev: Functor[M]) =
    repo.update(dto).map(updated => Either.cond(updated == 1, dto, StarsAreNotRight: Error))

}

But EitherT is nice. Look ...

All the nice combinators

All the nice combinators are there for smooth "integration":

flatMapF - with a piece of code that may "throw"
semiflatMap - with a piece of code that never "throws"
subflatMap/ensure/ensureOr - validations
recover / transform - error recovery
mapK - for switching effects

But EitherT is nice. Look ...

What's not to like?

it doesn't yield (pun intended) itself easily to for-comprehension style. (So what, I'm asking? But, people tend to feel really comfortable writing fors)
You need to annotate types quite a lot (You're writing Scala, get used to it)

What's not to like, boss?

I forgot to mention. This won't compile. (Easily fixable)

What's not to like, boss?

sealed trait Error
object Error {
  case object NotFound         extends Error
  case object NotValid         extends Error
  case object StarsAreNotRight extends Error
}

type mismatch;
found   : M[Either[A$A4.this.Error,Product with Serializable with A$A4.this.Result]]
required: M[Either[A$A4.this.Error,A$A4.this.Result]]
Note: Either[A$A4.this.Error,Product with Serializable with A$A4.this.Result] <: Either[A$A4.this.Error,A$A4.this.Result], but type M is invariant in type _.
You may wish to define _ as +_ instead. (SLS 4.5)

What's not to like, boss?

sealed trait ComposedErrors

sealed trait Module1Errors extends ComposedErrors
sealed trait Module2Errors extends ComposedErrors

trait Service1[M[_]] {
  def doSth: M[Either[Module1Errors, Result]]
}

trait Service2[M[_]] {
  def doSth: M[Either[Module2Errors, Result]]
}


def composition[M[_]: Monad](implicit service1: Service1[M], service2: Service2[M]) =
  for {
    r1 <- EitherT(service1.doSth)
    r2 <- EitherT(service2.doSth)
  } yield (r1, r2)

What's not to like, boss?


def composition[M[_]: Monad](implicit service1: Service1[M], service2: Service2[M]) =
  for {
    r1 <- EitherT[M, ComposedErrors, Result](service1.doSth)
    r2 <- EitherT[M, ComposedErrors, Result](service2.doSth)
  } yield (r1, r2)

What's not to like, boss?


def composition[M[_]: Monad](implicit service1: Service1[M], service2: Service2[M]) =
  for {
    r1 <- EitherT(service1.doSth).leftMap(identity[ComposedErrors])
    r2 <- EitherT(service2.doSth)
  } yield (r1, r2)

What's not to like, boss?


def composition[M[_]: Monad](implicit service1: Service1[M], service2: Service2[M]) =
  for {
    r1 <- EitherT(service1.doSth)
    r2 <- EitherT(service2.doSth).leftMap(identity[ComposedErrors])
  } yield (r1, r2)

It's a bit ironic that problems with OOP is solved by dead-simple FP (leftMap with identity)

from https://www.benjamin.pizza/posts/2019-01-11-the-fourth-type-of-variance.html

What's not to like, boss?

Haskell doesn't have much better story in this regard :-(

type (+) = Either
infixr + 5

l :: l -> Either l r
l = Left

r :: r -> Either l r
r = Right

foo :: String
    -> Either
        (HeadError + LookupError + ParseError)
        Integer
foo str = do
    c <- mapLeft l (head str)
    r <- mapLeft (r . l) (lookup str strMap)
    mapLeft (r . r) (parse (c : r))

From Matt Parsons blog https://www.parsonsmatt.org/2018/11/03/trouble_with_typed_errors.html

What's not to like, boss?

Haskell doesn't have much better story in this regard :-(

But at least type inference works there! It'd be awesome to have a sum type with order independence and easy composition ("open")

x :: Either (HeadError + LookupError) Int
y :: Either (LookupError + HeadError) Int

What's not to like, boss?

So Haskellers admittedly adopt prisms to solve this. Check Matt's blog!

module Parser : sig
  type error = [
    | `ParserSyntaxError of int
    | `ParserGrammarError of int * string
  ]

  val parse : string -> (tree, [> error]) result
end

module Validation : sig
  type error = [
    | `ValidationLengthError of int
    | `ValidationHeightError of int
  ]

  val perform : tree -> (tree, [> error]) result
end

module Display : sig
  type error = [
    | `DisplayError of string
  ]

  val render : tree -> (string, [> error]) result
end

What's not to like, boss?

Example by Vladimir Keleshev

let main source =
  let open Result.Let_syntax in
  let%bind tree = Parser.parse source in
  let%bind tree = Validation.perform tree in
  Display.render tree

val main : string -> (tree, [>
  | `ParserSyntaxError of int
  | `ParserGrammarError of int * string
  | `ValidationLengthError of int
  | `ValidationHeightError of int
  | `DisplayError of string
]) result

What's not to like, boss?

Example by Vladimir Keleshev

IMO OCaml has the best solution with its polymorphic variants. Let's move on to ...

MonadError is also nice. Look ...

MonadError abstract over monads that can handle errors. For instance, MonadError[M, E] exists for:

<M={Future, DBIO}, E = Throwable> (because both Future and DBIO can handle Throwables)
<M = M', E = Either[E', ?]> (because any monad can handle Either as error)
<M = EitherT[M', E', ?], E = E'> (as above)

Technically, MonadError extends Monad by adding new combinators for error handling, such as: recover, ensure, adapt, raiseError

trait Service[M[_]] {
//...

  def doSth(request: Request)(implicit ME: MonadError[M, Error]): M[Result] =
    for {
      maybeDto <- repo.findSomeData(request.computeCondition)
      dto      <- ME.fromOption(maybeDto, ifEmpty = NotFound)
                    .ensure(error = NotValid)(_.isValid)
      updatedDto = dto.update(request.computeNewValue)
      _   <- updateDto(updatedDto).rethrow
      res <- inspectData(request, updatedDto)
    } yield
      res match {
        case (Some(x), xs) if xs.contains(x) => EvenBetter(updatedDto, x)
        case _                               => Ok(updatedDto)
      }

//...
}

MonadError is also nice. Look ...

What's not to like?

it does yield (pun intended) itself easily to for-comprehension style!
Error type is explicit in MonadError (good for inference in flatMap)

What's not to like, boss?

What's not to like?

this technique is very invasive (and as such not really suitable to be applied incrementally to an old code-base) as it changes all the signatures (all the methods that returned M[X], start to return eg. EitherT[M, E, X]).

// old
def doSth(request: Request)(implicit ev: Monad[M]): M[Either[Error, Result]]

// new 
def doSth(request: Request)(implicit ME: MonadError[M, Error]): M[Result]

What's not to like, boss?

What's not to like?

Luka Jacobowitz's critique "Rethinking MonadError" (very instructive and recommended read)

What's not to like, boss?

trait MonadError[F[_], E] extends Monad[F] {
  //...
  def attempt[A](fa: F[A]): F[Either[E, A]]
  /*  there is no way the outer F still has any errors, 
      so why does it have the same type? 
  */

  def handleErrorWith[A](fa: F[A])(f: E => F[A]): F[A] 
  /*  if the errors are handled, why does it return the exact same type?
      what happens if I have errors in the E => F[A] function?
  */
  
}

What's not to like?

MonadError is not composable at all wrt to error type
Existence of MonadError[M, E1 | E2] does not imply that MonadError[M, E{1,2}] exists!
I tried to "fix" that in this issue but there were some serious concerns and it never got merged
The idea is that it should be possible to derive an instance of MonadError[M, E1] from MonadError[M, E] if we can prove that E1<~< E, where <~< is Liskov relationship (substitutability). It holds whenever E1 could be used in any negative context that expects an E

What's not to like, boss?


implicit def liskovMonadError[M[_], E1, E](implicit ME: MonadError[M, E],
                                                     liskov: Liskov[E1, E],
                                                     E1: ClassTag[E1]): MonadError[M, E1] =
    new MonadError[M, E1]{
  override def raiseError[A](e1: E1) = ME.raiseError(liskov.coerce(e1))

  override def handleErrorWith[A](fa: M[A])(f: E1 => M[A]) = ME.recoverWith(fa) {
    case e1: E1 => f(e1)
  }
  override def pure[A](x: A)                                 = ME.pure(x)
  override def flatMap[A, B](fa: M[A])(f: A => M[B])         = ME.flatMap(fa)(f)
  override def tailRecM[A, B](a: A)(f: A => M[Either[A, B]]) = ME.tailRecM(a)(f)
}

What's not to like, boss?


implicit def liskovMonadError[M[_], E1, E](implicit ME: MonadError[M, E],
                                                     liskov: Liskov[E1, E],
                                                     E1: ClassTag[E1]): MonadError[M, E1] =
    new MonadError[M, E1]{
  override def raiseError[A](e1: E1) = ME.raiseError(liskov.coerce(e1))

  override def handleErrorWith[A](fa: M[A])(f: E1 => M[A]) = ME.recoverWith(fa) {
    case e1: E1 => f(e1)
  }
  override def pure[A](x: A)                                 = ME.pure(x)
  override def flatMap[A, B](fa: M[A])(f: A => M[B])         = ME.flatMap(fa)(f)
  override def tailRecM[A, B](a: A)(f: A => M[Either[A, B]]) = ME.tailRecM(a)(f)
}

Shady parts

Issues with Liskov:

any E that is not an E1 cannot be recovered (OTOH, you cannot raise such an error either)

MonadError[F, E1.type].handleErrorWith(Left(new E))(_ => Right(10)) ?

Whether or not this is the right thing is debatable - after all MonadError[M, E1] promises to handle only E1 errors in the context of M.

What's not to like, boss?

object dto {
  case class EmailPasswordLoginRequest(email: String, password: String)

  sealed trait LoginResponse
  object LoginResponse {
    final case class LoggedIn(token: String)                     extends LoginResponse
    final case class AccountNeedsConfirmation(weakToken: String) extends LoginResponse
    case object UserNotFound                                     extends LoginResponse
    case object AuthMethodFailure                                extends LoginResponse
    case object InvalidCredentials                               extends LoginResponse
    case object Deleted                                          extends LoginResponse
  }
}

A new hope

This style (single ADT for all responses) precludes usage of MonadError and is a bit awkward to use with Either.


userRepository.find(email).flatMap {
  case None                                    => M.pure(LoginResponse.InvalidCredentials)
  case Some(user) if user.archivedAt.isDefined => M.pure(LoginResponse.Deleted)
  case Some(user) =>
    val authMethod = authMethodFromUserIdF(user.id)
    val actionT = OptionT(authMethodRepository.find(user.id, authMethod.provider))
      .map(checkAuthMethodAction(_))
    actionT.value flatMap {
      case Some(true)  => M.pure(LoginResponse.LoggedIn(issueTokenFor(user)))
      case Some(false) => M.pure(LoginResponse.InvalidCredentials)
      case None        => authMethod.mailToken match {
          case Some(token) =>
            sendConfirmationEmail(token, request.loginUrl, request.email)
               .map(_ => LoginResponse.AccountsMergeRequested)
          case None => M.pure(LoginResponse.InvalidCredentials)
        }
    }
}

A new hope


userRepository.find(email).flatMap {


  case None                                    =>    M.pure(LoginResponse.InvalidCredentials)

  case Some(user) if user.archivedAt.isDefined =>    M.pure(LoginResponse.Deleted)

  case Some(user) =>
    val authMethod = authMethodFromUserIdF(user.id)
    val actionT = OptionT(authMethodRepository.find(user.id, authMethod.provider))
      .map(checkAuthMethodAction(_))

    actionT.value flatMap {
      case Some(true)  =>     M.pure(LoginResponse.LoggedIn(issueTokenFor(user)))
      case Some(false) =>     M.pure(LoginResponse.InvalidCredentials)
      case None        =>     authMethod.mailToken match {
          case Some(token) =>
            sendConfirmationEmail(token, request.loginUrl, request.email)
               .map(_ => 
                              LoginResponse.AccountsMergeRequested)
          case None => M.pure(LoginResponse.InvalidCredentials)
        }
    }
}

A new hope


val userT = for {
   method <- EitherT.fromOptionF(findAuthMethod(token), 
               ifNone = ConfirmResponse.MethodNotFound)
   user   <- EitherT.fromOptionF(findUser(method.userId), 
               ifNone = ConfirmResponse.UserNotFound: ConfirmResponse)
 } yield (method, user)

userT.semiflatMap {
  case (method, user) => upsertAuthMethod(confirmMethod(method))
                          .map(_ => ConfirmResponse.Confirmed(issueTokenFor(user)))
}.merge

A new hope


val userT = for {
   method <- EitherT.fromOptionF(findAuthMethod(token), 

               ifNone = ConfirmResponse.MethodNotFound)

   user   <- EitherT.fromOptionF(findUser(method.userId),
 
               ifNone = ConfirmResponse.UserNotFound: ConfirmResponse)
 } yield (method, user)

userT.semiflatMap {
  case (method, user) => upsertAuthMethod(confirmMethod(method))

                          .map(_ => ConfirmResponse.Confirmed(issueTokenFor(user)))
}.merge

A new hope

Favored style distilled:

Computations form a tree (like FreeMonad)
Leaves (results) - F[ADT]
Nodes (intermediate values) - F[A]
When you reach a leaf, you're done (short-circuit)
flatMap makes a branch
combinators for manipulating nodes (values) - just like EitherT
for added type safety - you HAVE TO prove you have reached ADT to be able to run a computation

Let's call it "Sealed"


sealed abstract class Free[S[_], A] 
final case class Pure[S[_], A](a: A) extends Free[S, A]
final case class Suspend[S[_], A](a: S[A]) extends Free[S, A]
final case class FlatMapped[S[_], B, C](c: Free[S, C], f: C => Free[S, B]) extends Free[S, B]

Our computation looks almost like Free[F[_], Either[ADT, A]]. "Almost", because we want structure to be more restricted: "reach ADT or die". Covariance on A would be also nice.

But it sure looks like a good basis

Let's call it "Sealed"


sealed abstract class Sealed[F[_], +A, ADT] {
    def run(implicit ev: A <:< ADT): F[ADT]
    def map[B](f: A => B): Sealed[F, B, ADT]
    def flatMap[B](f: A => Sealed[F, B, ADT]): Sealed[F, B, ADT]
}
final class Result[F[_], ADT](result: F[ADT]) extends Sealed[F, Nothing, ADT]
final class Value[F[_], A, ADT](fa: F[A])     extends Sealed[F, A, ADT]
final class Computation[F[_], A0, A, ADT](fa0: F[A0], 
                                          cont: A0 => Sealed[F, A, ADT]) 
    extends Sealed[F, A, ADT]

Let's call it "Sealed"

sealed abstract class Sealed[F[_], +A, ADT] {
    def run(implicit ev: A <:< ADT, F: FlatMap[F]): F[ADT]
    def map[B](f: A => B)(implicit F: Functor[F]): Sealed[F, B, ADT]
    def flatMap[B](f: A => Sealed[F, B, ADT]): Sealed[F, B, ADT]
}
final class Result[F[_], ADT](result: F[ADT]) extends Sealed[F, Nothing, ADT] {
    override def run(implicit ev: Nothing <:< ADT, F: FlatMap[F]) = result
    override def map[B](f: Nothing => B)(implicit F: Functor[F])  = this
    override def flatMap[B](f: Nothing => Sealed[F, B, ADT])      = this
}
final class Value[F[_], A, ADT](fa: F[A]) extends Sealed[F, A, ADT] {
    override def run(implicit ev: A <:< ADT, F: FlatMap[F]): F[ADT] = F.fmap(fa)(ev)
    override def map[B](f: A => B)(implicit F: Functor[F])          = new Value(F.fmap(fa)(f))
    override def flatMap[B](f: A => Sealed[F, B, ADT])              = new Computation(fa, f)
}
final class Computation[F[_], A0, A, ADT](fa0: F[A0], 
                                          cont: A0 => Sealed[F, A, ADT]) 
    extends Sealed[F, A, ADT] {
    override def run(implicit ev: A <:< ADT, F: FlatMap[F]) = 
      F.flatMap(fa0)(a0 => cont(a0).run)
    override def map[B](f: A => B)(implicit F: Functor[F]) = 
      new Computation(fa0, (a0: A0) => cont(a0).map(f))
    override def flatMap[B](f: A => Sealed[F, B, ADT]) =
      new Computation(fa0, (a0: A0) => cont(a0).flatMap(f))
}

Let's call it "Sealed"

val n = 50000

@scala.annotation.tailrec
def loop(s: Sealed[F, Int, Int], i: Int = 0): Sealed[F, Int, Int] =
    if (i < n) loop(s.flatMap(i => new Value(Monad[F].pure(i + 1))), i + 1) else s

val s   = new Value[F, Int, Int](Monad[F].pure(0))
val res = loop(s)
res.run

/*
java.lang.StackOverflowError
	at Computation.$anonfun$flatMap$1(...)
	at Computation.$anonfun$flatMap$1(...)
	at Computation.$anonfun$flatMap$1(...)
...
*/

Oh, ok, I know - we need a trampoline ...

Let's call it "Sealed"

final class Value[F[_], A, ADT](deferred: Eval[F[A]]) extends Sealed[F, A, ADT] {
    override def run(implicit ev: A <:< ADT, F: FlatMap[F]): F[ADT] = 
      F.fmap(deferred.value)(ev)
    override def map[B](f: A => B)(implicit F: Functor[F]) = 
      new Value(deferred.map(fa => F.fmap(fa)(f)))
    override def flatMap[B](f: A => Sealed[F, B, ADT]) = 
      new Computation(deferred, (a: A) => Eval.later(f(a)))
}

final class Computation[F[_], A0, A, ADT](deferred: Eval[F[A0]], 
                                          cont: A0 => Eval[Sealed[F, A, ADT]]) 
    extends Sealed[F, A, ADT] {
    override def run(implicit ev: A <:< ADT, F: FlatMap[F]) = 
      F.flatMap(deferred.value)(a0 => cont(a0).value.run)
    override def map[B](f: A => B)(implicit F: Functor[F]) = 
      new Computation(deferred, (a0: A0) => Eval.defer(cont(a0)).map(_.map(f)))
    override def flatMap[B](f: A => Sealed[F, B, ADT]) =
      new Computation(deferred, (a0: A0) => Eval.defer(cont(a0)).map(_.flatMap(f)))
}

We just created Shlemiel the Painter algorithm :-(

Let's call it "Sealed"


sealed abstract class Sealed[F[_], +A, ADT] {
    def run(implicit ev: A <:< ADT, F: FlatMap[F]): F[ADT] = 
      F.fmap(F.tailRecM(this)(_.step))(_.map(ev).merge)
    def step[A1 >: A](implicit F: Functor[F]): F[Either[Sealed[F, A1, ADT], Either[ADT, A1]]]

    def map[B](f: A => B): Sealed[F, B, ADT]
    def flatMap[B](f: A => Sealed[F, B, ADT]): Sealed[F, B, ADT]
}

We have to be smarter ...

Let's call it "Sealed"


final class Computation[F[_], A0, A, ADT](fa0: Eval[F[A0]], 
                                          cont: A0 => Eval[Sealed[F, A, ADT]]) 
  extends Sealed[F, A, ADT] {
  override def step[A1 >: A](implicit F: Functor[F]) = 
    F.fmap(fa0.value)(a0 => Left(cont(a0).value))
  override def map[B](f: A => B)(implicit F: Functor[F]) = 
    new Computation(fa0, (a0: A0) => Eval.defer(cont(a0)).map(_.map(f)))
  override def flatMap[B](f: A => Sealed[F, B, ADT]) = 
    new Computation(fa0, (a0: A0) => Eval.defer(cont(a0)).map(_.flatMap(f)))
}

Yay! Works!

Let's call it "Sealed"

sealed abstract class Sealed[F[_], +A, ADT] {
  // ...
  def semiflatMap[B](f: A => F[B]) = flatMap(a => new Value(Eval.later(f(a))))
  def complete[B](f: A => F[ADT])  = flatMap(a => new Result(f(a)))

  def attempt[B](f: A => Either[ADT, B])(implicit F: Monad[F])     = map(f).rethrow
  def attemptF[B](f: A => F[Either[ADT, B]])(implicit F: Monad[F]) = semiflatMap(f).rethrow

  def rethrow[B](implicit ev: A <:< Either[ADT, B], F: Monad[F]) = flatMap { a =>
    ev(a) match {
      case Right(b)  => new Value(Eval.later(F.pure(b)))
      case Left(adt) => new Result(F.pure(adt))
    }
  }

  def ensure(pred: A => Boolean, orElse: => ADT)(implicit F: Monad[F]) = 
    ensureOr(pred, _ => orElse)
  def ensureOr(pred: A => Boolean, orElse: A => ADT)(implicit F: Monad[F]) =
    attempt(a => Either.cond(pred(a), a, orElse(a)))
}

Add some useful combinators

Let's call it "Sealed"

object Sealed {
  def liftF[F[_], ADT] = new LiftFPartiallyApplied[F, ADT]
  def value[ADT]       = new ValuePartiallyApplied[ADT]

  def valueOr[F[_]: Monad, A, ADT](fa: F[Option[A]], orElse: => ADT) = 
    value[ADT](fa).attempt(Either.fromOption(_, orElse))
  def valueOrF[F[_]: Monad, A, ADT](fa: F[Option[A]], orElse: => F[ADT]) =
    value[ADT](fa).flatMap {
      case Some(a) => liftF[F, ADT](a)
      case None    => resultF(orElse)
    }

  def merge[F[_]: Monad, A, B, ADT](fa: F[Either[A, B]])(f: Either[A, B] => ADT) =
    mergeF(fa)(either => Monad[F].pure(f(either)))
  def mergeF[F[_], A, B, ADT](fa: F[Either[A, B]])(f: Either[A, B] => F[ADT]) = 
    value[ADT](fa).complete(f)
  def handleError[F[_]: Monad, A, B, ADT](fa: F[Either[A, B]])(f: A => ADT) = 
    value[ADT](fa).attempt(_.leftMap(f))
  //...
}

Add some useful constructors

Let's call it "Sealed"

Add syntax
Add laws
Test monad laws (it is a monad as long as F is one)

def resultMapElimination[A, B](fb: F[B], f: A => B) = 
  Sealed.resultF(fb).map(f) <-> Sealed.resultF(fb)
def resultFlatMapElimination[A, B](fb: F[B], f: A => Sealed[F, A, B]) = 
  Sealed.resultF(fb).flatMap(f) <-> Sealed.resultF(fb)
// ...
def resultSemiflatMapElimination[A, B](fb: F[B], f: A => F[B]) = 
  Sealed.resultF(fb).semiflatMap(f) <-> Sealed.resultF(fb)
def valueCompleteIdentity[A, B](fa: F[A], f: A => F[B]) = 
  Sealed.value[B](fa).complete(f) <-> Sealed.resultF(fa >>= f)
def rethrowRightIdentity[A, B](s: Sealed[F, A, B]) = s.map(Right(_)).rethrow <-> s
// ...
def ensureRethrowCoherence[A, B, C](s: Sealed[F, A, C], f: A => Boolean, c: C) =
    s.ensure(f, c) <-> s.map(a => Either.cond(f(a), a, c)).rethrow

... and finally ...

Let's call it "Sealed"

userRepository.find(email).flatMap {
  case None                                    => M.pure(LoginResponse.InvalidCredentials)
  case Some(user) if user.archivedAt.isDefined => M.pure(LoginResponse.Deleted)
  case Some(user) =>
    val authMethod = authMethodFromUserIdF(user.id)
    val actionT = OptionT(authMethodRepository.find(user.id, authMethod.provider))
      .map(checkAuthMethodAction(_))
    actionT.value flatMap {
      case Some(true)  => M.pure(LoginResponse.LoggedIn(issueTokenFor(user)))
      case Some(false) => M.pure(LoginResponse.InvalidCredentials)
      case None        => authMethod.mailToken match {
          case Some(token) =>
            sendConfirmationEmail(token, request.loginUrl, request.email)
               .map(_ => LoginResponse.AccountsMergeRequested)
          case None => M.pure(LoginResponse.InvalidCredentials)
        }
    }
}

val s = for {
  user <- findUser(email)
          .valueOr[LoginResponse](LoginResponse.InvalidCredentials)
          .ensure(!_.archived, LoginResponse.Deleted)
  userAuthMethod = authMethodFromUserIdF(user.id)
  authMethod <- findAuthMethod(user.id, userAuthMethod.provider)
                .valueOrF(mergeAccountsAction(userAuthMethod, user))} 
yield if (checkAuthMethodAction(authMethod)) LoginResponse.LoggedIn(issueTokenFor(user)) 
      else LoginResponse.InvalidCredentials

s.run

Let's call it "Sealed"

val s = for {
  method <- findAuthMethod(token).valueOr[ConfirmResponse](ConfirmResponse.MethodNotFound)
  user   <- findUser(method.userId).valueOr[ConfirmResponse](ConfirmResponse.UserNotFound) ! 
            upsertAuthMethod(confirmMethod(method))
} yield ConfirmResponse.Confirmed(issueTokenFor(user))

s.run

val userT = for {
   method <- EitherT.fromOptionF(findAuthMethod(token), 
               ifNone = ConfirmResponse.MethodNotFound)
   user   <- EitherT.fromOptionF(findUser(method.userId), 
               ifNone = ConfirmResponse.UserNotFound: ConfirmResponse)
 } yield (method, user)

userT.semiflatMap {
  case (method, user) => upsertAuthMethod(confirmMethod(method))
                          .map(_ => ConfirmResponse.Confirmed(issueTokenFor(user)))
}.merge

Not so fast ...

It is slow. One liners are ~ 4x slower than their EitherT equivalents; longer programs are ~ 30% slower. What is the cause?

Digression: Absolutely everyone should use JMH! Use sbt-jmh in your build and install async-profiler for beautiful flame graphs. One-liner for your build.sbt:

addCommandAlias("flame", "benchmarks/jmh:run -p tokens=64 -prof jmh.extras.Async:dir=target/flamegraphs;flameGraphOpts=--width,1900")

Not so fast ...

Blackhole

Eval !!!

Final touch

case class Computation[F[_], A0, A, ADT](current: Sealed[F, A0, ADT], 
                                         cont: A0 => Sealed[F, A, ADT]) 
    extends Sealed[F, A, ADT] {
    override protected def step[A1 >: A](implicit F: Monad[F]) = current match {
      case Result(result)       => F.fmap(result)(adt => Right(Left(adt)))
      case Value(fa0)           => F.fmap(fa0)(a0 => Left(cont(a0)))
      case Computation(prev, g) => F.pure(Left(prev.flatMap(a0 => g(a0).flatMap(cont))))
    }
    // ...
}

Crucial observation: Eval could be replaced with simple pattern match - tailRecM does all the hard work anyway. Performance is now ~ 5-10% worse than EitherT

That's all Folks!

Scala Developer @

iteratorshq.com

medium.com/iterators

slides from this presentation are available here: https://bit.ly/2TliUkI

Thanks for coming

Using monads to enforce programming style your Boss likes

That's all Folks!

Using monads to enforce programming style your Boss likes

More from Marcin Rzeźnicki