|
| 1 | +// scalac: -Ykind-projector:underscores |
| 2 | + |
| 3 | +sealed abstract class Free[+S[_, _], +E, +A] { |
| 4 | + @inline final def flatMap[S1[e, a] >: S[e, a], B, E1 >: E](fun: A => Free[S1, E1, B]): Free[S1, E1, B] = Free.FlatMapped[S1, E, E1, A, B](this, fun) |
| 5 | + @inline final def map[B](fun: A => B): Free[S, E, B] = flatMap(a => Free.pure[S, B](fun(a))) |
| 6 | + @inline final def as[B](as: => B): Free[S, E, B] = map(_ => as) |
| 7 | + @inline final def *>[S1[e, a] >: S[e, a], B, E1 >: E](sc: Free[S1, E1, B]): Free[S1, E1, B] = flatMap(_ => sc) |
| 8 | + @inline final def <*[S1[e, a] >: S[e, a], B, E1 >: E](sc: Free[S1, E1, B]): Free[S1, E1, A] = flatMap(r => sc.as(r)) |
| 9 | + |
| 10 | + @inline final def void: Free[S, E, Unit] = map(_ => ()) |
| 11 | + |
| 12 | + // FIXME: Scala 3.1.4 bug: false unexhaustive match warning |
| 13 | + /// @nowarn("msg=pattern case: Free.FlatMapped") |
| 14 | + @inline final def foldMap[S1[e, a] >: S[e, a], G[+_, +_]](transform: S1 ~>> G)(implicit G: Monad2[G]): G[E, A] = { |
| 15 | + this match { |
| 16 | + case Free.Pure(a) => G.pure(a) |
| 17 | + case Free.Suspend(a) => transform.apply(a) |
| 18 | + case Free.FlatMapped(sub, cont) => |
| 19 | + sub match { |
| 20 | + case Free.FlatMapped(sub2, cont2) => sub2.flatMap(a => cont2(a).flatMap(cont)).foldMap(transform) |
| 21 | + case another => G.flatMap(another.foldMap(transform))(cont(_).foldMap(transform)) |
| 22 | + } |
| 23 | + } |
| 24 | + } |
| 25 | +} |
| 26 | + |
| 27 | +trait ~>>[-F[_, _], +G[_, _]] { |
| 28 | + def apply[E, A](f: F[E, A]): G[E, A] |
| 29 | +} |
| 30 | + |
| 31 | +object Free { |
| 32 | + @inline def pure[S[_, _], A](a: A): Free[S, Nothing, A] = Pure(a) |
| 33 | + @inline def lift[S[_, _], E, A](s: S[E, A]): Free[S, E, A] = Suspend(s) |
| 34 | + |
| 35 | + final case class Pure[S[_, _], A](a: A) extends Free[S, Nothing, A] { |
| 36 | + override def toString: String = s"Pure:[$a]" |
| 37 | + } |
| 38 | + final case class Suspend[S[_, _], E, A](a: S[E, A]) extends Free[S, E, A] { |
| 39 | + override def toString: String = s"Suspend:[$a]" |
| 40 | + } |
| 41 | + final case class FlatMapped[S[_, _], E, E1 >: E, A, B](sub: Free[S, E, A], cont: A => Free[S, E1, B]) extends Free[S, E1, B] { |
| 42 | + override def toString: String = s"FlatMapped:[sub=$sub]" |
| 43 | + } |
| 44 | +} |
| 45 | + |
| 46 | +type Monad2[F[+_, +_]] = Monad3[λ[(`-R`, `+E`, `+A`) => F[E, A]]] |
| 47 | + |
| 48 | +trait Monad3[F[-_, +_, +_]] { |
| 49 | + def flatMap[R, E, A, B](r: F[R, E, A])(f: A => F[R, E, B]): F[R, E, B] |
| 50 | + def flatten[R, E, A](r: F[R, E, F[R, E, A]]): F[R, E, A] = flatMap(r)(identity) |
| 51 | + def pure[A](a: A): F[Any, Nothing, A] |
| 52 | +} |
0 commit comments