Derive

Derive.kt

package arrow.derive

/**
 * An Algebraic data type [Type] can derive behaviors
 * for its members
 */
sealed class Derive<in Type> {
  /**
   * Derived instances associated to [Type]
   */
  abstract fun instances(): List<*>

  /**
   * Specific instances of T
   */
  inline fun <reified T> instancesOf(): List<T> =
    instances().filterIsInstance<T>()
}

/**
 * A [Type] is a product when it's behavior is defined by its
 * properties
 */
abstract class Product<in Type> : Derive<Type>() {

  /**
   * The property values conforming the Product [Type]
   */
  abstract fun product(value: Type): List<Any?>
}

/**
 * A [Type] is a sum when it's behavior is defined by one of its cases
 */
abstract class Sum<in Type> : Derive<Type>() {

  /**
   * The ordinal case this [Type] belongs to in the sum
   */
  abstract fun indexOf(value: Type): Int
}

DerivedTypeClass.kt

package arrow.derive

/**
 * An algebraic data [Type] can derive a [TypeClass]
 */
interface DerivedTypeClass<out Type, out TypeClass> {

  /**
   * A product data [Type] can derive [TypeClass]
   * from its properties and instances associated to them
   */
  fun Product<Type>.deriveProduct(): TypeClass

  /**
   * A sum data [Type] can derive [TypeClass]
   * from its cases and instances associated to them
   */
  fun Sum<Type>.deriveSum(): TypeClass

  /**
   * An algebraic data [Type] can derive a [TypeClass]
   * from its [Product] and [Sum] parts
   */
  fun Derive<Type>.derive(): TypeClass =
    when (this) {
      is Product -> deriveProduct()
      is Sum -> deriveSum()
    }
}

Deriving.kt

package arrow.derive

import kotlin.reflect.KClass

/**
 * An Algebraic data type can be annotated
 * with [Deriving] in which cases it will generate at compile time only
 * the types necessary to create a [DerivedTypeClass] that third party instance can adapt to.
 *
 * The optional [types] arguments denotes a list of Type classes whose companion
 * implement `deriving`
 * ```kotlin
 * fun <A> deriving(): DerivedTypeClass<A, TypeClass<A>>
 * ```
 */
@Retention(AnnotationRetention.SOURCE)
@Target(
  AnnotationTarget.CLASS
)
@MustBeDocumented
annotation class Deriving(val types: Array<KClass<*>> = [])

Eq.kt

package library

import arrow.derive.DerivedTypeClass
import arrow.derive.Product
import arrow.derive.Sum

/**
 * An example type class that provides a manual derivation mechanism
 * to handle the structure of [A] for cases where [A] is an algebraic
 * data type.
 */
fun interface Eq<A> {
  fun eq(left: A, right: A): Boolean

  companion object {

    val int: Eq<Int> = Eq { a, b -> a == b }

    val string: Eq<String> = Eq { a, b -> a == b }

    /**
     * The presence of this method allows [Eq] as
     * argument to [arrow.derive.Deriving] when placed at compile time
     */
    fun <A> deriving(): DerivedTypeClass<A, Eq<A>> =
      object : DerivedTypeClass<A, Eq<A>> {

        override fun Product<A>.deriveProduct(): Eq<A> =
          Eq { x, y ->
            /* retrieve the product of x */
            product(x)
              .zip(product(y))
              .zip(instancesOf<Eq<Any?>>())
              .all { (xy, eq) ->
                val (xt, yt) = xy
                eq.eq(xt, yt)
              }
          }

        override fun Sum<A>.deriveSum(): Eq<A> =
          Eq { x, y ->
            val ordx = indexOf(x)
            val ordy = indexOf(y)
            (ordx == ordy) && instancesOf<Eq<A>>()[ordx].eq(x, y)
          }
      }
  }
}

Tree.Derive.Eq.kt

package user

import library.Eq

/**
 * Compile time generated from `@Deriving([Eq::class]) sealed class Tree`
 */
fun <A> Eq.Companion.tree(eq: Eq<A>): Eq<Tree<A>> =
  deriving<Tree<A>>().run {
    DeriveTree<A, Eq<A>, Eq<out Tree<A>>>(
      eq,
      deriving(),
      deriving(),
      deriving()
    ).derive()
  }

/**
 * Compile time generated from `@Deriving([Eq::class]) sealed class Tree`
 * Being the [Branch] case of [Tree]
 */
fun <A> Eq.Companion.branch(eq: Eq<A>): Eq<Branch<A>> =
  deriving<Branch<A>>().run {
    DeriveBranch<A, Eq<A>, Eq<out Tree<A>>>(
      eq,
      deriving(),
      deriving(),
      deriving()
    ).derive()
  }

/**
 * Compile time generated from `@Deriving([Eq::class]) sealed class Tree`
 * Being the [Leaf] case of [Tree]
 */
fun <A> Eq.Companion.leaf(eq: Eq<A>): Eq<Leaf<A>> =
  deriving<Leaf<A>>().run {
    DeriveLeaf<A, Eq<A>>(
      eq
    ).derive()
  }

Tree.Derive.kt

package user

import arrow.derive.DerivedTypeClass
import arrow.derive.Product
import arrow.derive.Sum

/**
 * Compile time generated from `@Deriving sealed class Tree`
 * Being the sum case of [Tree]
 *
 * In this case since [Tree] has a single type argument [A] we generate
 * only `depA: Dep`. For other cases with more type arguments there are as many
 * dependencies as concrete properties or type arguments the type.
 *
 * These additional derivation arguments are all other type classes for values in the
 * type that otherwise would have needed to be passed manually to compose the whole.
 *
 */
class DeriveTree<A, Dep, TypeClass>(
  val depA: Dep,
  val derivingTree: DerivedTypeClass<Tree<A>, TypeClass>,
  val derivingBranch: DerivedTypeClass<Branch<A>, TypeClass>,
  val derivingLeaf: DerivedTypeClass<Leaf<A>, TypeClass>
) : Sum<Tree<A>>() {

  override fun instances(): List<*> =
    listOf(branch(depA, derivingTree, derivingBranch, derivingLeaf), leaf(depA, derivingTree, derivingBranch, derivingLeaf))

  /**
   * Generated fast index lookup for manual derivation control without types
   */
  override fun indexOf(value: Tree<A>): Int =
    when (value) {
      is Branch -> 0
      is Leaf -> 1
    }
}

/**
 * Compile time generated from `@Deriving sealed class Tree`
 * Being the [Branch] case of [Tree]
 */
class DeriveBranch<A, Dep, TypeClass>(
  val dep: Dep,
  val derivingTree: DerivedTypeClass<Tree<A>, TypeClass>,
  val derivingBranch: DerivedTypeClass<Branch<A>, TypeClass>,
  val derivingLeaf: DerivedTypeClass<Leaf<A>, TypeClass>
) : Product<Branch<A>>() {

  override fun instances(): List<*> =
    listOf(
      tree(dep, derivingTree, derivingBranch, derivingLeaf),
      tree(dep, derivingTree, derivingBranch, derivingLeaf)
    )

  override fun product(value: Branch<A>): List<Any?> =
    listOf(value.left, value.right)
}

/**
 * Compile time generated from `@Deriving sealed class Tree`
 * Being the [Leaf] case of [Tree]
 */
class DeriveLeaf<A, Dep>(
  val depA: Dep
) : Product<Leaf<A>>() {

  override fun instances(): List<*> =
    listOf(depA)

  override fun product(value: Leaf<A>): List<Any?> =
    listOf(value.elem)

}

/**
 * Compile time generated from `@Deriving sealed class Tree`
 * An adapter for [Tree] deriving [TypeClass]
 */
fun <A, Dep, TypeClass> tree(
  dep: Dep,
  derivingTree: DerivedTypeClass<Tree<A>, TypeClass>,
  derivingBranch: DerivedTypeClass<Branch<A>, TypeClass>,
  derivingLeaf: DerivedTypeClass<Leaf<A>, TypeClass>,
): TypeClass =
  derivingTree.run { DeriveTree(dep, derivingTree, derivingBranch, derivingLeaf).derive() }

/**
 * Compile time generated from `@Deriving sealed class Tree`
 * An adapter for [Branch] deriving [TypeClass]
 */
fun <A, Dep, TypeClass> branch(
  dep: Dep,
  derivingTree: DerivedTypeClass<Tree<A>, TypeClass>,
  derivingBranch: DerivedTypeClass<Branch<A>, TypeClass>,
  derivingLeaf: DerivedTypeClass<Leaf<A>, TypeClass>,
): TypeClass =
  derivingBranch.run { DeriveBranch(dep, derivingTree, derivingBranch, derivingLeaf).derive() }

/**
 * Compile time generated from `@Deriving sealed class Tree`
 * An adapter for [Leaf] deriving [TypeClass]
 */
fun <A, Dep, TypeClass> leaf(
  dep: Dep,
  /** unused arguments kept for consistency in generation **/
  derivingTree: DerivedTypeClass<Tree<A>, TypeClass>,
  derivingBranch: DerivedTypeClass<Branch<A>, TypeClass>,
  derivingLeaf: DerivedTypeClass<Leaf<A>, TypeClass>
): TypeClass =
  derivingLeaf.run { DeriveLeaf<A, Dep>(dep).derive() }

Tree.kt

package user

import arrow.derive.Deriving
import library.Eq

/**
 * An example recursive ADT some user wrote deriving [Eq]
 * This is a case with a simple argument where all values are part of the ADT except
 * the [Leaf.elem] of type [T] which mean that for deriving [Eq]
 * we will need at the edge an instance of [Eq[T]].
 *
 * Demonstrated in [main]
 */
@Deriving([Eq::class])
sealed interface Tree<out T>
data class Branch<out T>(val left: Tree<T>, val right: Tree<T>) : Tree<T>
data class Leaf<out T>(val elem: T) : Tree<T>

UserProgram.kt

package user

import library.Eq

fun main() {
  /**
   * [Eq] for [Tree] of [Int] is automatically derived provided we have
   * an instance of Eq[Int].
   *
   * With @Given turned on this would instead just look like:
   * val treeEq: Eq<Tree<Int>> = Eq.tree()
   */
  val treeEq: Eq<Tree<Int>> = Eq.tree(Eq.int)
  println(treeEq.run {
    eq(
      Branch(
        Leaf(1),
        Branch(
          Leaf(1),
          Leaf(1)
        )
      ), Branch(
        Leaf(1),
        Branch(
          Leaf(1),
          Leaf(1)
        )
      )
    )
  }) //true
}