obsidiansystems/vessel in Scala 2

Vessel.scala

package example

import example.Has.Has0
import example.Eq.{GEQ, Y}
import example.Vessel.{FlipAp, FlipAp0, VSum}

import scala.language.implicitConversions

final case class LS[F[_]](l: List[F[String]])
final case class LI[F[_]](l: List[F[Int]])

sealed trait ExampleGADT[c[f[_]]]
object ExampleGADT {
  case object S extends ExampleGADT[LS]
  case object I extends ExampleGADT[LI]
}

final case class ExampleValue[c[f[_]]](get: c[Option])

// hs:GCompare
trait Eq[K[c[f[_]]]] {
  def isEq[A[_[_]], B[_[_]]](k: K[A], k2: K[B]): GEQ[K, A, B]
}
object Eq {
  sealed trait GEQ[K[c[f[_]]], A[_[_]], B[_[_]]]
  final case class Y[K[c[f[_]]], A[_[_]]](res: K[A]) extends GEQ[K, A, A]
  final case class N[K[c[f[_]]], A[_[_]], B[_[_]]]() extends GEQ[K, A, B]

  implicit val eqExampleGADT: Eq[ExampleGADT] = new Eq[ExampleGADT] {
    override def isEq[A[_[_]], B[_[_]]](k: ExampleGADT[A], k2: ExampleGADT[B]): GEQ[ExampleGADT, A, B] = k match {
      case ExampleGADT.S =>
        k2 match {
          case ExampleGADT.S => Y(ExampleGADT.S)
          case ExampleGADT.I => N()
        }
      case ExampleGADT.I =>
        k2 match {
          case ExampleGADT.S => N()
          case ExampleGADT.I => Y(ExampleGADT.I)
        }
    }
  }
}

sealed trait DPair[K[c[f[_]]], V[c[f[_]]]] {
  type A[_[_]]
  val key: K[A]
  val value: V[A]
  final def extract[B[_[_]]](k: K[B])(implicit eq: Eq[K]): Option[V[B]] = eq.isEq(key, k) match {
    // case y: Y[K, c] => Some(value) // below artifact appears only for HKT indices
    case y: GEQ[K, A, A] if (y match { case Y(_) => true; case _ => false}) => Some(value)
    case _ => None
  }
}
object DPair {
  implicit def convertFromTuple[K[c[f[_]]], V[c[f[_]]], C[f[_]]](tup: (K[C], V[C])): DPair[K, V] = {
    final case class dpair(key: K[C], value: V[C]) extends DPair[K, V] {
      override type A[f[_]] = C[f]
    }
    dpair(tup._1, tup._2)
  }
}

sealed trait DMap[K[c[f[_]]], V[c[f[_]]]] {
  def get[A[_[_]]](k: K[A])(implicit eq: Eq[K]): Option[V[A]]
  def set(kv: DPair[K, V])(implicit eq: Eq[K]): DMap[K, V]
  // right-biased of course
  def ++(that: DMap[K, V])(implicit eq: Eq[K]): DMap[K, V]
  def --(that: DMap[K, V])(implicit eq: Eq[K]): DMap[K, V]
  def toList: List[DPair[K, V]]
}
object DMap {
  def empty[K[c[f[_]]], V[c[f[_]]]]: DMap[K, V] = apply()
  def apply[K[c[f[_]]], V[c[f[_]]]](elems: DPair[K, V]*): DMap[K, V] = {
    final case class dmap(elems: Seq[DPair[K, V]]) extends DMap[K, V] {
      override def get[A[_[_]]](k: K[A])(implicit eq: Eq[K]): Option[V[A]] = {
        elems.collectFirst(Function.unlift((_: DPair[K, V]).extract(k)))
      }
      override def ++(that: DMap[K, V])(implicit eq: Eq[K]): DMap[K, V] = {
        dmap((this -- that).toList ++ that.toList)
      }
      override def --(that: DMap[K, V])(implicit eq: Eq[K]): DMap[K, V] = {
        dmap(elems.filter(e => that.get(e.key).isEmpty))
      }
      override def set(kv: DPair[K, V])(implicit eq: Eq[K]): DMap[K, V] = this ++ DMap(kv)
      override def toList: List[DPair[K, V]]                            = elems.toList
    }
    dmap(elems)
  }
}

// hs:ArgDict, Has
trait Has[TC[c[f[_]]], GADT[c[f[_]]]] {
  def constraintsFor[A[_[_]]](gadt: GADT[A]): TC[A]
}
object Has {
  // hs:Has'
  type Has0[TC[_], V[c[f[_]]], GADT[c[f[_]]]] = Has[Lambda[`A[_[_]]` => TC[V[A]]], GADT]

  implicit def argDictExampleGADT[TC[c[f[_]]]](implicit tcInt: TC[LI], tcString: TC[LS]): Has[TC, ExampleGADT] = new Has[TC, ExampleGADT] {
    override def constraintsFor[A[_[_]]](gadt: ExampleGADT[A]): TC[A] = gadt match {
      case ExampleGADT.S => tcString
      case ExampleGADT.I => tcInt
    }
  }
}

trait Semigroup[A] {
  def <+>(a: A, b: A): A
}
object Semigroup {
  implicit val semigroupInt: Semigroup[Int]             = _ + _
  implicit val semigroupString: Semigroup[String]       = _ + _
  implicit def semigroupList[A]: Semigroup[List[A]]     = _ ++ _
  implicit def semigroupOption[A]: Semigroup[Option[A]] = _ orElse _
  implicit def semigroupExampleValue[c[f[_]]](implicit s: Semigroup[c[Option]]): Semigroup[ExampleValue[c]] =
    (a, b) => ExampleValue[c](s.<+>(a.get, b.get))
  implicit def semigroupLI[F[_]](implicit s: Semigroup[List[F[Int]]]): Semigroup[LI[F]]    = (a, b) => LI(s.<+>(a.l, b.l))
  implicit def semigroupLS[F[_]](implicit s: Semigroup[List[F[String]]]): Semigroup[LS[F]] = (a, b) => LS(s.<+>(a.l, b.l))
}

final case class MonoidalDMap[K[c[f[_]]], V[c[f[_]]]] private[MonoidalDMap] (private val dmap: DMap[K, V]) extends AnyVal {
  def ++(that: MonoidalDMap[K, V])(implicit eq: Eq[K], semigroup: Has0[Semigroup, V, K]): MonoidalDMap[K, V] = {
    val luniq = this -- that
    val runiq = that -- this
    val intersection: List[DPair[K, V]] = dmap.toList.flatMap {
      e =>
        that.get(e.key).map {
          v2 =>
            val v1 = e.value
            val sg = semigroup.constraintsFor(e.key)
            e.key -> sg.<+>(v1, v2)
        }
    }
    MonoidalDMap(luniq.toList ++ runiq.toList ++ intersection: _*)
  }

  def get[A[_[_]]](k: K[A])(implicit eq: Eq[K]): Option[V[A]]              = dmap.get(k)
  def set(kv: DPair[K, V])(implicit eq: Eq[K]): MonoidalDMap[K, V]         = MonoidalDMap(dmap.set(kv))
  def --(that: MonoidalDMap[K, V])(implicit eq: Eq[K]): MonoidalDMap[K, V] = MonoidalDMap(dmap -- that.dmap)
  def toList: List[DPair[K, V]]                                            = dmap.toList
}
object MonoidalDMap {
  def empty[K[c[f[_]]], V[c[f[_]]]]: MonoidalDMap[K, V]                      = MonoidalDMap(DMap.empty[K, V])
  def apply[K[c[f[_]]], V[c[f[_]]]](elems: DPair[K, V]*): MonoidalDMap[K, V] = MonoidalDMap(DMap(elems: _*))
}

trait View[c[f[_]]] {
  def nullV[F[_]](container: c[F]): Boolean
  final def collapseNullV[F[_]](container: c[F]): Option[c[F]] = if (nullV(container)) None else Some(container)
}
object View {
  implicit def viewLS: View[LS] = new View[LS] {
    override def nullV[F[_]](container: LS[F]): Boolean = container.l.isEmpty
  }
  implicit def viewLI: View[LI] = new View[LI] {
    override def nullV[F[_]](container: LI[F]): Boolean = container.l.isEmpty
  }
}

final case class Vessel[K[c[f[_]]], G[_]](map: MonoidalDMap[K, FlipAp0[G]#l]) {
  // hs:lookupV
  def get[c[f[_]]](key: K[c])(implicit eq: Eq[K]): Option[c[G]] =
    map.get(key).map(_.get)
  def set(vsum: VSum[K, G])(implicit eq: Eq[K], semigroup: Has0[Semigroup, FlipAp0[G]#l, K], view: Has[View, K]): Vessel[K, G] =
    this ++ Vessel(vsum)
  // hs:Semigroup (but right-biased of course)
  def ++(that: Vessel[K, G])(implicit eq: Eq[K], semigroup: Has0[Semigroup, FlipAp0[G]#l, K], view: Has[View, K]): Vessel[K, G] =
    Vessel(filterNullFlipAps(map ++ that.map))
  def toList: List[VSum[K, G]] =
    map.toList.map(e => e.key -> e.value.get)

  private[this] def filterNullFlipAps(map: MonoidalDMap[K, FlipAp0[G]#l])(implicit view: Has[View, K]): MonoidalDMap[K, FlipAp0[G]#l] =
    MonoidalDMap(map.toList.flatMap {
      e => view.constraintsFor(e.key).collapseNullV(e.value.get).map(e.key -> FlipAp(_): DPair[K, FlipAp0[G]#l])
    }: _*)
}
object Vessel {
  // hs:fromListV
  def apply[K[c[f[_]]], G[_]](elems: VSum[K, G]*)(implicit view: Has[View, K]): Vessel[K, G] = {
    new Vessel[K, G](MonoidalDMap(elems.flatMap {
      vsum =>
        if (view.constraintsFor(vsum.key).nullV(vsum.value)) None
        else Some(vsum.toDPair)
    }: _*))
  }

  type FlipAp0[G[_]] = { type l[c[f[_]]] = FlipAp[G, c] }
  final case class FlipAp[G[_], c[f[_]]](get: c[G])
  object FlipAp {
    implicit def semigroup[G[_], c[f[_]]](implicit s: Semigroup[c[G]]): Semigroup[FlipAp[G, c]] =
      (a, b) => FlipAp(s.<+>(a.get, b.get))
  }
  sealed trait VSum[K[c[f[_]]], G[_]] {
    type A[_[_]]
    val key: K[A]
    val value: A[G]
    final def toDPair: DPair[K, FlipAp0[G]#l] = key -> FlipAp[G, A](value)
  }
  object VSum {
    implicit def convertFromTuple[K[c[f[_]]], V[f[_]], G[_]](tup: (K[V], V[G])): VSum[K, G] =
      new VSum[K, G] { type A[f[_]] = V[f]; val key = tup._1; val value = tup._2 }
  }

  implicit def viewVessel[K[c[f[_]]]: Eq](implicit view: Has[View, K]): View[Vessel[K, *[_]]] = new View[Vessel[K, *[_]]] {
    override def nullV[F[_]](container: Vessel[K, F]): Boolean = container.map.toList.isEmpty
  }
}

object App extends App {
  val monoidalDMap =
    MonoidalDMap(ExampleGADT.S -> ExampleValue[LS](LS(List(Option("str"))))) ++
      MonoidalDMap(ExampleGADT.I -> ExampleValue[LI](LI(List(Option(1)))))

  val vessel =
    Vessel(ExampleGADT.S -> LS[Option](List(Option("str")))) ++
    Vessel(ExampleGADT.I -> LI[Option](List(Option(1))))

  println(monoidalDMap: MonoidalDMap[ExampleGADT, ExampleValue])
  println(vessel: Vessel[ExampleGADT, Option])
}