freealt.scala

sealed abstract class FreeAlt[F[_], A] extends Product with Serializable { self =>
  import FreeAlt._

  def map[B](f: A => B): FA[F, B] = self match {
    case Pure(a) => FreeAlt.pure(f(a))
    case Ap(pivot, fn) => FreeAlt.ap(pivot)(fn.map(f compose _))
    case Alt(pivot, fn) => FreeAlt.alt(pivot)(fn.map(f compose _))
  }

  final def ap[B](b: FA[F, A => B]): FA[F, B] =
    b match {
      case Pure(f) => this.map(f)
      case Ap(pivot, fn) =>
        FreeAlt.ap(pivot)(self.ap(fn.map(fx => a => p => fx(p)(a))))
      case Alt(pivot, fn) =>
        FreeAlt.alt(pivot)(self.ap(fn.map(fx => a => p => fx(p)(a))))
    }

  final def or(that: FA[F, A]): FA[F, A] =
    FreeAlt.Alt[F, A, A](List(this, that), FreeAlt.pure(identity))

  final def opt: FA[F, Option[A]] =
    self.map(Option.apply).or(pure(None))

  def <*[B](fb: FA[F, B]): FA[F, A] = self.ap(fb.map(b => a => a))
  def *>[B](fb: FA[F, B]): FA[F, B] = self.ap(fb.map(b => a => b))

  def <*>[B](fb: FA[F, B])(implicit A: Curry[A, B]): FA[F, A.Result] =
    self.ap(fb.map(b => a => A.apply(a)(b)))

  def <|>(fb: FA[F, A]): FA[F, A] = or(fb)

  /** Interprets/Runs the sequence of operations using the semantics of Alternative G
    * Tail recursive only if G provides tail recursive interpretation (ie G is FreeMonad)
    */
  final def foldMap[G[_]](f: FunctionK[F, G])(implicit G: Alternative[G]): G[A] =
    this match {
      case Pure(a) => G.pure(a)
      case Ap(pivot, fn) => G.map2(f(pivot), fn.foldMap(f))((a, g) => g(a))
      case fa: Alt[F, p, A] =>
        val gp = fa.pivot.map(_.foldMap(f)(G))
        G.ap(fa.fn.foldMap(f)(G))(gp.foldLeft(G.empty[p])(G.combineK[p]))
    }

  /** Interpret/run the operations using the semantics of `Alternative[F]`.
    * Tail recursive only if `F` provides tail recursive interpretation.
    */
  final def fold(implicit F: Alternative[F]): F[A] =
    foldMap(FunctionK.id[F])

  /** Interpret this algebra into another FreeAlt */
  final def compile[G[_]](f: FunctionK[F, G]): FA[G, A] =
    foldMap[FA[G, ?]] {
      new FunctionK[F, FA[G, ?]] {
        def apply[B](fa: F[B]): FA[G, B] = lift(f(fa))
      }
    }

  override def toString: String = "FreeAlt(...)"
}

object FreeAlt {
  type FA[F[_], A] = FreeAlt[F, A]

  private final case class Pure[F[_], A](a: A) extends FA[F, A]
  private final case class Ap[F[_], P, A](pivot: F[P], fn: FA[F, P => A]) extends FA[F, A]
  private final case class Alt[F[_], P, A](pivot: List[FA[F, P]], fn: FA[F, P => A]) extends FA[F, A]

  final def pure[F[_], A](a: A): FA[F, A] = Pure(a)
  final def ap[F[_], P, A](fp: F[P])(f: FA[F, P => A]): FA[F, A] = Ap[F, P, A](fp, f)
  final def alt[F[_], P, A](a: List[FA[F, P]])(fn: FA[F, P => A]): FA[F, A] = Alt[F, P, A](a, fn)

  final def some[F[_], A](fa: FA[F, A]): FA[F, NonEmptyList[A]] =
    fa.ap(many(fa).map(l => a => NonEmptyList(a, l)))
  final def many[F[_], A](fa: FA[F, A]): FA[F, List[A]] =
    some(fa).map(_.toList).or(pure(Nil))

  final def lift[F[_], A](fa: F[A]): FA[F, A] =
    ap(fa)(Pure(a => a))

  implicit final def alternative[S[_]]: Alternative[FA[S, ?]] = {
    new Alternative[FA[S, ?]] {
      override def empty[A]: FA[S, A] =
        alt(Nil)(pure(identity[A] _))
      override def combineK[A](x: FA[S, A], y: FA[S, A]): FA[S, A] =
        alt(List(x, y))(pure(identity))

      override def pure[A](a: A): FA[S, A] = Pure(a)
      override def map[A, B](fa: FA[S, A])(f: A => B): FA[S, B] =
        fa.map(f)

      override def product[A, B](fa: FA[S, A], fb: FA[S, B]): FA[S, (A, B)] =
        ap(fa.map((a: A) => (b: B) => (a, b)))(fb)
      override def ap[A, B](f: FA[S, A => B])(fa: FA[S, A]): FA[S, B] =
        fa.ap(f)
    }
  }
}