frees-io · andyscott · Feb 11, 2018 · Feb 9, 2018
@@ -0,0 +1,74 @@
+package iota  //#=cats
+package iotaz //#=scalaz
+
+import cats.~>   //#=cats
+import scalaz.~> //#=scalaz
+
+final class CopH[LL <: TListH, F[_]] private(
+  val index: Int,
+  val value: Any
+) {
+  type L = LL
+
+  override def equals(anyOther: Any): Boolean = anyOther match {
+    case other: CopH[LL, F] => (index == other.index) && (value == other.value)
+    case _                  => false
+  }
+
+  override def toString: String =
+    s"CopH($value @ $index)"
+}
+
+object CopH {
+
+  def unsafeApply[L <: TListH, H[_[_]], F[_]](index: Int, hf: H[F]): CopH[L, F] =
+    new CopH[L, F](index, hf)
+
+  sealed abstract class Inject[H[_[_]], J[F[_]]  <: CopH[_, F]] {
+    def inj[F[_]](hf: H[F]): J[F]
+    def prj[F[_]](jf: J[F]): Option[H[F]]
+    final def apply[F[_]](hf: H[F]): J[F] = inj(hf)
+    final def unapply[F[_]](jf: J[F]): Option[H[F]] = prj(jf)
+  }
+
+  object Inject {
+    def apply[H[_[_]], J[F[_]] <: CopH[_, F]](implicit ev: Inject[H, J]): Inject[H, J] = ev
+
+    implicit def injectFromInjectL[H[_[_]], L <: TListH](
+      implicit ev: InjectL[H, L]
+    ): Inject[H, CopH[L, ?[_]]] = new Inject[H, CopH[L, ?[_]]] {
+      def inj[F[_]](hf: H[F]): CopH[L, F] = ev.inj(hf)
+      def prj[F[_]](jf: CopH[L, F]): Option[H[F]] = ev.proj(jf)
+    }
+  }
+
+  final class InjectL[H[_[_]], L <: TListH] private[InjectL](index: Int) {
+    def inj[F[_]](hf: H[F]): CopH[L, F] = new CopH[L, F](index, hf)
+    def proj[F[_]](cf: CopH[L, F]): Option[H[F]] =
+      if (cf.index == index) Some(cf.value.asInstanceOf[H[F]])
+      else None
+    def apply[F[_]](hf: H[F]): CopH[L, F] = inj(hf)
+    def unapply[F[_]](cf: CopH[L, F]): Option[H[F]] = proj(cf)
+  }
+
+  object InjectL {
+    def apply[H[_[_]], L <: TListH](implicit ev: InjectL[H, L]): InjectL[H, L] = ev
+    implicit def makeInjectL[H[_[_]], L <: TListH](implicit ev: TListH.Pos[L, H]): InjectL[H, L] =
+      new InjectL[H, L](ev.index)
+  }
+
+  final class RemoveL[H[_[_]], L <: TListH] private[RemoveL](index: Int) {
+    def apply[F[_]](c: CopH[L, F]): Either[CopH[TListH.Op.Remove[H, L], F], H[F]] =
+      Either.cond(
+        c.index == index,
+        c.value.asInstanceOf[H[F]],
+        new CopH(if (c.index < index) c.index else c.index - 1, c.value))
+  }
+
+  object RemoveL {
+    def apply[H[_[_]], L <: TListH](implicit ev: RemoveL[H, L]): RemoveL[H, L] = ev
+    implicit def makeRemoveL[H[_[_]], L <: TListH](implicit ev: TListH.Pos[L, H]): RemoveL[H, L] =
+      new RemoveL[H, L](ev.index)
+  }
+
+}
@@ -30,3 +30,12 @@ object FirstK {
     macro internal.EvidenceMacros.materializeFirstK[L, A]
 
 }
+
+final class FirstH[L <: TListH, F[_]](val underlying: CopH[L, F]) extends AnyVal
+
+object FirstH {
+  def apply[L <: TListH, F[_]](implicit ev: FirstH[L, F]): FirstH[L, F] = ev
+
+  implicit def materializeFirstH[L <: TListH, F[_]]: FirstH[L, F] =
+    macro internal.EvidenceMacros.materializeFirstH[L, F]
+}
@@ -66,6 +66,32 @@ final class EvidenceMacros(val c: Context) {
       q"new ${tb.iotaPackage}.evidence.FirstK[$L, $A](${makeCopK(L, _F, A, index, fa)})")
   }
 
+  def materializeFirstH[L <: TListH, F[_]](
+    implicit
+      evL: c.WeakTypeTag[L],
+      evF: c.WeakTypeTag[F[Nothing]]
+  ): c.Expr[FirstH[L, F]] = {
+
+    val L = evL.tpe
+    val F = evF.tpe
+
+    type Acc = Either[List[String], (Type, Int, Tree)]
+
+    tb.foldAbort(for {
+      tpes <- tb.memoizedTListHTypes(L).leftMap(List(_))
+      tup3 <- tpes.foldLeft(Left(Nil): Acc)((acc, H) =>
+        acc match {
+          case Left(e) =>
+            summonEvidence(appliedType(H, F))
+              .leftMap(_ :: e)
+              .map(hf => (H, e.length, hf))
+          case other => other
+        })
+      (_H, index, hf) = tup3
+    } yield
+        q"new ${tb.iotaPackage}.evidence.FirstH[$L, $F](${makeCopH(L, _H, F, index, hf)})")
+  }
+
   private[this] def makeProd(
     L: Type,
     values: List[Tree]
@@ -81,6 +107,15 @@ final class EvidenceMacros(val c: Context) {
   ): Tree =
     q"${tb.iotaPackage}.CopK.unsafeApply[$L, $F, $A]($index, $fa)"
 
+  private[this] def makeCopH(
+    L: Type,
+    H: Type,
+    F: Type,
+    index: Int,
+    hf: Tree
+  ): Tree =
+    q"${tb.iotaPackage}.CopH.unsafeApply[$L, $H, $F]($index, $hf)"
+
   private[this] def summonEvidence(T: Type): Either[String, Tree] =
     Avowal
       .catching[TypecheckException](

@@ -0,0 +1,58 @@
+package iotatests
+
+import iota._             //#=cats
+import iota.scalacheck._  //#=cats
+import iotaz._            //#=scalaz
+import iotaz.scalacheck._ //#=scalaz
+
+import TListH.::
+import evidence.FirstH
+
+import cats._            //#=cats
+import cats.implicits._  //#=cats
+import cats.data._       //#=cats
+import scalaz._          //#=scalaz
+import Scalaz._          //#=scalaz
+
+object Evidence extends App {
+
+  // TODO: implement an easy to use fold method so that these
+  // extractors don't need to be defined
+  val EvMonad = CopH.InjectL[Monad, Monad :: Applicative :: TNilH]
+  val EvApplicative = CopH.InjectL[Applicative, Monad :: Applicative :: TNilH]
+
+  //#+cats
+  // TODO: this works for Scalaz, just need to sort out the right
+  // imports and types to demonstrate the same functionality
+
+  def mash[F[_], A: Monoid](fx: F[A], fy: F[A])(
+    implicit ev: FirstH[Monad :: Applicative :: TNilH, F]
+  ): F[A] = ev.underlying match {
+    case EvMonad(evF) =>
+      println("using monad evidence")
+      implicit val F: Monad[F] = evF
+      for {
+        x <- fx
+        y <- fy
+      } yield Monoid[A].combine(x, y)
+    case EvApplicative(evF) =>
+      println("using applicative evidence")
+      implicit val F: Applicative[F] = evF
+      (fx, fy) mapN Monoid[A].combine
+  }
+
+  // will use applicative evidence
+  println(mash[Validated[String, ?], Int](
+    Validated.valid(1),
+    Validated.valid(10)
+  ))
+
+  // will use monad evidence
+  println(mash[Either[String, ?], Int](
+    Right(1),
+    Right(10)
+  ))
+
+  //#-cats
+
+}