Arrow Type classes and treatment of Functor hierarchy

either.kt

package demo

sealed class Either<out E, out A> {
  inline fun <B> fold(fe: (E) -> B, fb: (A) -> B): B =
    when (this) {
      is Left -> fe(e)
      is Right -> fb(a)
    }

  inline fun <B> map(f: (A) -> B): Either<E, B> =
    when (this) {
      is Left -> this
      is Right -> Right(f(a))
    }
}

data class Left<out E>(val e: E) : Either<E, Nothing>()
data class Right<out A>(val a: A) : Either<Nothing, A>()

instances.kt

package demo

import arrow.core.Tuple2
import arrow.core.identity

inline fun <E, A, B> Either<E, A>.functor(): Functor<A, B, Either<E, B>> =
  Functor(this::map)

inline fun <E, A, B> Either<E, A>.flatMap(): FlatMap<A, Either<E, B>> =
  FlatMap(this::flatMap)

inline fun <E, A, B> Either<E, A>.foldable(): Foldable<A, B> =
  Foldable(this::foldLeft)

inline fun <E, A, B> Either<E, A>.traversable(): Traversable<A, B, Either<E, B>> =
  Traversable(this::traverse)

inline fun <E, A, B> Either<E, A>.foldMap(MN: Plus<B>, empty: Empty<B>, crossinline f: (A) -> B): B =
  foldable<E, A, B>().foldMap(MN, empty, f)

inline fun <E, A, B> Either<E, A>.flatMap(crossinline f: (A) -> Either<E, B>): Either<E, B> =
  when (this) {
    is Left -> this
    is Right -> f(a)
  }

inline fun <E, A, C> Either<E, A>.foldLeft(empty: C, f: (C, A) -> C): C =
  fold({ empty }, { f(empty, it) })

inline fun <E, A, B> Either<E, A>.fproduct(crossinline f: (A) -> B): Either<E, Tuple2<A, B>> =
  functor<E, A, Tuple2<A, B>>().fproduct(f)

inline fun <E, A> Either<E, A>.unit(): Either<E, Unit> =
  functor<E, A, Unit>().unit()

inline fun <E, A, B> Either<E, A>.traverse(f: (A) -> Iterable<B>): List<Either<E, B>> =
  fold({
    listOf(Left(it))
  }, {
    f(it).map { Right(it) }
  })

inline fun <E, A> Either<E, Iterable<A>>.sequence(): List<Either<E, A>> =
  traverse(::identity)

inline fun <E, A> right(a: A): Either<E, A> =
  Right(a)

fun interface EitherEffect<E, A> : Effect<Either<E, A>> {
  suspend operator fun <B> Either<E, B>.invoke(): B =
    fold({ e -> control().shift { Left(e) }}, ::identity)
}

suspend inline fun <E, A> either(crossinline block: suspend EitherEffect<E, *>.() -> A): Either<E, A> =
  computation(::right, { EitherEffect { it } }, block)

prelude.kt

package demo

import arrow.continuations.Reset
import arrow.continuations.generic.DelimitedScope
import arrow.core.Tuple2

fun interface Associative<A> {
  fun assoc(a: A, B: A): A
}

fun interface Plus<A> : Associative<A> {
  infix operator fun A.plus(other: A): A =
    assoc(this, other)
}

fun interface Mult<A> : Associative<A> {
  infix operator fun A.times(other: A): A =
    assoc(this, other)
}

fun interface Empty<A> {
  fun empty(): A
}

fun interface Just<F, A> {
  fun just(a: A): F
}

fun interface Functor<out A, B, out FB> {
  fun map(f: (A) -> B): FB
}

inline fun <A, B, FB> Functor<A, Tuple2<A, B>, FB>.fproduct(crossinline f: (A) -> B): FB =
  map { Tuple2(it, f(it)) }

inline fun <A, FB> Functor<A, Unit, FB>.unit(): FB =
  map { Unit }

inline fun <FA, A, B, FB> Functor<A, B, FB>.lift(noinline f: (A) -> B): (FA) -> FB =
  { map(f) }

inline fun <A, B, FB> Functor<A, B, FB>.mapConst(b: B): FB =
  map { b }

inline fun <A, B, FB> Functor<A, Tuple2<B, A>, FB>.tupleLeft(b: B): FB =
  map { Tuple2(b, it) }

inline fun <A, B, FB> Functor<A, Tuple2<A, B>, FB>.tupleRight(b: B): FB =
  map { Tuple2(it, b) }

fun interface FlatMap<A, FB> {
  fun flatMap(f: (A) -> FB): FB
}

fun interface Effect<F> {
  fun control(): DelimitedScope<F>
}

suspend inline fun <FA, Eff: Effect<FA>, A> computation(
  just : Just<FA, A>,
  crossinline eff: (DelimitedScope<FA>) -> Eff,
  crossinline block: suspend Eff.() -> A
): FA =
  Reset.single { just.just(block(eff(this))) }

fun interface Foldable<out A, B> {
  fun foldLeft(empty: B, f: (B, A) -> B): B
}

inline fun <A, B> Foldable<A, B>.foldMap(MN: Associative<B>, empty: Empty<B>, crossinline f: (A) -> B): B =
  MN.run { foldLeft(empty.empty()) { b, a -> assoc(b, f(a)) } }

fun interface Traversable<A, B, FB> {
  fun traverse(f: (A) -> Iterable<B>): List<FB>
}

inline fun <A, FA> Traversable<A, A, FA>.sequence(): List<FA> =
  traverse { listOf(it) }