Generalised KTuple POC

TupleK.scala

//> using lib "org.typelevel::cats-core:2.7.0"
import cats.Applicative
import cats.syntax.all._
import cats.ContravariantMonoidal
import cats.InvariantMonoidal
import cats.InvariantSemigroupal
import cats.Show
import cats.~>
import cats.arrow.FunctionK
import cats.kernel.Monoid
import scala.annotation.implicitNotFound
import cats.Functor
import cats.Semigroupal

type Id = [A] =>> A
type Const[C] = [A] =>> C

@implicitNotFound("Cannot prove ${T} is homogenous in ${A}")
trait Homogenous[T <: Tuple, A]

given [T <: Tuple, A]: Homogenous[Tuple.Map[T, Const[A]], A] = new Homogenous[Tuple.Map[T, Const[A]], A]{}

type Existential[+F[_]] <: (Any { type T })

extension [T <: Tuple](t: T)
  def liftK[F[_]](using Tuple.IsMappedBy[F][T]): KTuple[F, Tuple.InverseMap[T, F]] = KTuple.lift[F](t)

@implicitNotFound("Cannot prove that ${F} and ${G} are the same ")
sealed trait HKEqual[F[_], G[_]]{
  def to[A](fa: F[A]) : G[A]
}

given [F[_]]: HKEqual[F, F] = new HKEqual[F, F]{
  def to[A](fa: F[A]) : F[A] = fa
}


class KTuple[F[_], T <: Tuple](private val elements: List[F[Any]]){

  type Output = Tuple.Map[T, F]

  def mapK[G[_]](fk : [A] => F[A] => G[A]) : KTuple[G, T] =
    new KTuple(elements.map(fk(_)))

  def mapK[G[_]](fk : F ~> G) : KTuple[G, T]=
    new KTuple(elements.map(fk(_)))

  def mapN[A](f : T => A)(using Functor[F], InvariantMonoidal[F]) : F[A] =
    combineK.map(f)

  def zip[G[_]](other: KTuple[G, T]) : KTuple[[A] =>> (F[A], G[A]), T] =
    new KTuple(elements.zip(other.elements))

  def summonZip[TC[_]](using other: KTuple[TC, T]) :  KTuple[[A] =>> (F[A], TC[A]), T] =
    new KTuple(elements.zip(other.elements))

  def encodeUsing[TC[_], A](f: [a] => (TC[a], a) => A)(using other: KTuple[TC, T], ev : HKEqual[F, Id]) : KTuple[Const[A], T] =
    summon[KTuple[TC, T]].zip(this).mapK[Const[A]]([a] => (tca : (TC[a], F[a])) => f(tca._1, ev.to(tca._2)))

  def standardise[A](using ev: HKEqual[F, Const[A]]) : KTuple[Id, Tuple.Map[T, [a] =>> A]] =
    this.asInstanceOf[KTuple[Id, Tuple.Map[T, [a] =>> A]]]

  def concat[T2 <: Tuple](other: KTuple[F, T2]) : KTuple[F, Tuple.Concat[T, T2]] =
    new KTuple(elements ++ other.elements)

  def prepend[H](fh: F[H]) : KTuple[F, H *: T] =
    new KTuple(fh.asInstanceOf[F[Any]] :: elements)

  inline def ++[T2 <: Tuple](other: KTuple[F, T2]) : KTuple[F, Tuple.Concat[T, T2]] =
    concat(other)

  def reduceK(using NonEmptyFolder[F], T <:< NonEmptyTuple) : F[T] = {
    val F = summon[NonEmptyFolder[F]]
    val rev = elements.reverse
    val head = rev.head
    val tail = rev.tail
    val result = tail.foldLeft[F[Tuple]](F.first(head).asInstanceOf[F[Tuple]])((fTup, fa) => F.combine(fa, fTup).asInstanceOf[F[Tuple]])
    result.asInstanceOf[F[T]]
  }

  def reduceMapK[G[_]](fk : [A] => F[A] => G[A])(using NonEmptyFolder[G], T <:< NonEmptyTuple) : G[T] =
    mapK(fk).reduceK

  def combineK[G[_]](using F: Folder[F]) : F[T] = {
    val rev = elements.reverse
    val result = rev.foldLeft[F[Tuple]](F.empty.asInstanceOf[F[Tuple]])((fTup, fa) => F.combine(fa, fTup).asInstanceOf[F[Tuple]])
    result.asInstanceOf[F[T]]
  }

  def foldMapK[G[_]](fk : [A] => F[A] => G[A])(using Folder[G]) : G[T] = {
    mapK(fk).combineK
  }

  def foldMap[A](fk: [a] => F[a] => A)(using Monoid[A]) : A = {
    mapK[Const[A]]([A] => (fa : F[A]) => fk(fa)).combineAll
  }

  def combineAll[A](using Homogenous[Output, A], Monoid[A]): A =
    elements.asInstanceOf[List[A]].combineAll

  def toList[A](using Homogenous[Output, A]) : List[A] =
    elements.asInstanceOf[List[A]]

  def toExistentialList : List[Existential[F]] =
    elements.asInstanceOf[List[Existential[F]]]

  def value : Tuple.Map[T, F] = Tuple.fromIArray(IArray.from(elements)).asInstanceOf[Tuple.Map[T, F]]

}

object KTuple {

  def summonAll[F[_], T <: Tuple](using T : KTuple[F, T]) : KTuple[F, T] = T

  def apply[T <: Tuple](t: T) : KTuple[Id, T] =
    new KTuple(t.toArray.asInstanceOf[Array[Id[Any]]].toList)

  def lift[F[_]] = PartiallyAppliedLift[F]

  // TODO There's probably a more idiomatic way to do this in Scala 3
  class PartiallyAppliedLift[F[_]]{
    def apply[T <: Tuple](t: T)(using Tuple.IsMappedBy[F][T]): KTuple[F, Tuple.InverseMap[T, F]] =
    new KTuple(t.toArray.asInstanceOf[Array[F[Any]]].toList)
  }

  given[F[_], A](using fa: F[A]): KTuple[F, A *: EmptyTuple] =
    new KTuple(List(fa).asInstanceOf[List[F[Any]]])

  given[F[_], H, T <: Tuple](using fh: F[H], ft : KTuple[F, T]): KTuple[F, H *: T] =
    ft.prepend(fh)
}

trait NonEmptyFolder[F[_]]{
  def first[A](fa: F[A]) : F[A *: EmptyTuple]
  def combine[A, B <: Tuple](fa: F[A], fb: F[B]) : F[A *: B]
}

trait Folder[F[_]] extends NonEmptyFolder[F]{
  def empty : F[EmptyTuple]
  final def first[A](fa: F[A]) : F[A *: EmptyTuple] = combine(fa, empty)
}

given[F[_]](using InvariantSemigroupal[F]) : NonEmptyFolder[F] with
  def first[A](fa: F[A]) = fa.imap(_ *: EmptyTuple)(_.head)
  def combine[A, B <: Tuple](fa: F[A], fb: F[B]) = fa.product(fb).imap(_ *: _)(t => (t.head, t.tail))

given[F[_]](using F : InvariantMonoidal[F]) : Folder[F] with
  def empty : F[EmptyTuple] = F.imap(F.unit)(_ => EmptyTuple)(_ => ())
  def combine[A, B <: Tuple](fa: F[A], fb: F[B]) = fa.product(fb).imap(_ *: _)(t => (t.head, t.tail))


@main
def main() = {
  val t1 = KTuple(1, 2)
  val t2 = KTuple(3, 4)
  val t3 : KTuple[Id, (Int, Int, Int, Int)] = t1 ++ t2
  val optionOfTuples = t3.foldMapK([A] => Option(_: A))

  type With[F[_]] = [A] =>> (Id[A], Show[A])

  println(optionOfTuples)

  val result = t3.summonZip[Show].mapK[Const[String]]([A] => (ws: With[Show][A]) => ws._2.show(ws._1))

  println(result.combineAll)
  println(result.toList)

  val result2 = t3.summonZip[Show].foldMap[String]([A] => (ws: (Id[A], Show[A])) => ws._2.show(ws._1))
  println(result2)

  val result3 = KTuple(1, "2", false, List(1,2,3))
    .encodeUsing[Show, String]([A] => (show: Show[A], a: A) => show.show(a))
    .toList[String]

  println(result3)


  val result4 =  (1.some, 3.some).liftK[Option].mapN(_ + _)
  println(result4)
}