Whip up macro to lift to FunctionK

core/src/main/scala/cats/arrow/FunctionK.scala

@@ -1,7 +1,9 @@
 package cats
 package arrow
 
-import cats.data. Coproduct
+import cats.data.Coproduct
+
+import reflect.macros.blackbox.Context
 
 trait FunctionK[F[_], G[_]] extends Serializable { self =>
   def apply[A](fa: F[A]): G[A]
@@ -24,8 +26,75 @@ trait FunctionK[F[_], G[_]] extends Serializable { self =>
 }
 
 object FunctionK {
+
   def id[F[_]]: FunctionK[F, F] =
     new FunctionK[F, F] {
       def apply[A](fa: F[A]): F[A] = fa
     }
+
+  def lift[F[_], G[_]](f: (F[α] ⇒ G[α]) forSome { type α }): FunctionK[F, G] =
+    macro FunctionKMacros.lift[F, G]
+
+}
+
+object FunctionKMacros {
+
+  def lift[
+    F[_]: λ[α[_] ⇒ c.WeakTypeTag[α[_]]],
+    G[_]: λ[α[_] ⇒ c.WeakTypeTag[α[_]]]
+  ](c: Context)(
+    f: c.Expr[F[α] ⇒ G[α]] forSome { type α }
+  ): c.Expr[FunctionK[F, G]] = {
+    import c.universe._
+
+    def unblock(tree: Tree): Tree = tree match {
+      case Block(Nil, expr) ⇒ expr
+      case _                ⇒ tree
+    }
+
+    def punchHole(tpe: Type): Tree = tpe match {
+      case PolyType(undet :: Nil, underlying: TypeRef) ⇒
+        val α = TypeName("α")
+        def rebind(typeRef: TypeRef): Tree =
+          if (typeRef.sym == undet) tq"$α"
+          else {
+            val args = typeRef.args.map {
+              case ref: TypeRef => rebind(ref)
+              case arg => tq"$arg"
+            }
+            tq"${typeRef.sym}[..$args]"
+          }
+        val rebound = rebind(underlying)
+        tq"""({type λ[$α] = $rebound})#λ"""
+      case TypeRef(pre, sym, Nil) ⇒
+        tq"$sym"
+      case _ =>
+        c.abort(c.enclosingPosition, s"Unexpected type $tpe when lifting to FunctionK")
+    }
+
+    val tree = unblock(f.tree) match {
+      case q"""($param) => $trans[..$typeArgs](${ arg: Ident })""" if param.name == arg.name ⇒
+
+        typeArgs
+          .collect { case tt: TypeTree => tt }
+          .find(_.original != null)
+          .foreach { param => c.abort(param.pos,
+            s"type parameter $param must not be supplied when lifting function $trans to FunctionK")
+          }
+
+        val F = punchHole(weakTypeTag[F[_]].tpe)
+        val G = punchHole(weakTypeTag[G[_]].tpe)
+
+        q"""
+          new FunctionK[$F, $G] {
+            def apply[A](fa: $F[A]): $G[A] = $trans(fa)
+          }
+         """
+      case other ⇒
+        c.abort(other.pos, s"Unexpected tree $other when lifting to FunctionK")
+    }
+
+    c.Expr[FunctionK[F, G]](tree)
+  }
+
 }

tests/src/test/scala/cats/tests/FunctionKTests.scala

@@ -3,7 +3,8 @@ package tests
 
 import cats.arrow.FunctionK
 import cats.data.Coproduct
-
+import cats.data.NonEmptyList
+import cats.laws.discipline.arbitrary._
 
 class FunctionKTests extends CatsSuite {
   val listToOption =
@@ -65,4 +66,34 @@ class FunctionKTests extends CatsSuite {
       combinedInterpreter(Coproduct.right(Test2(b))) should === (b)
     }
   }
+
+  test("lift simple unary") {
+    def optionToList[A](option: Option[A]): List[A] = option.toList
+    val fOptionToList = FunctionK.lift(optionToList)
+    forAll { (a: Option[Int]) =>
+      fOptionToList(a) should === (optionToList(a))
+    }
+
+    val fO2I: FunctionK[Option, Iterable] = FunctionK.lift(Option.option2Iterable)
+    forAll { (a: Option[String]) =>
+      fO2I(a).toList should === (Option.option2Iterable(a).toList)
+    }
+
+    val fNelFromListUnsafe = FunctionK.lift(NonEmptyList.fromListUnsafe)
+    forAll { (a: NonEmptyList[Int]) =>
+      fNelFromListUnsafe(a.toList) should === (NonEmptyList.fromListUnsafe(a.toList))
+    }
+  }
+
+  test("lift compound unary") {
+    val fNelFromList = FunctionK.lift[List, λ[α ⇒ Option[NonEmptyList[α]]]](NonEmptyList.fromList)
+    forAll { (a: List[String]) =>
+      fNelFromList(a) should === (NonEmptyList.fromList(a))
+    }
+  }
+
+  // lifting concrete types should fail to compile
+  assertTypeError("FunctionK.lift(sample[String])")
+  assertTypeError("FunctionK.lift(sample[Nothing])")
+
 }