applicativehlists.sc

package utility.functional

import scala.language.{higherKinds, reflectiveCalls}

import cats.Applicative
import shapeless._

/**
  * Given a HList I0::I1:: ... In::HNil and a type Out
  * returns a curried function (I0 => I1 => ... In => Out) => Out
  *
  * @tparam InL
  * @tparam Out
  */
sealed trait HFolder[InL <: HList, Out] {
  type Folder
  def fold: InL => Folder => Out
}

object HFolder {


  implicit def nilHFolder[Out]: HFolder[HNil, Out] {type Folder = Out} = new HFolder[HNil, Out] {
    type Folder = Out

    override def fold: HNil => Out => Out = _ => identity
  }

  implicit def consHFolder[InH, InT <: HList, Out]
  (implicit tailHFolder: HFolder[InT, Out]): HFolder[InH :: InT, Out] {type Folder = InH => tailHFolder.Folder} =
    new HFolder[InH :: InT, Out] {
      override type Folder = InH => tailHFolder.Folder

      override def fold: InH :: InT => (InH => tailHFolder.Folder) => Out = {
        case inH :: inT => folder =>
          tailHFolder.fold(inT)(folder(inH))
      }
    }

  class Callable[-In, +Out](underlying: In => Out) extends (In => Out) {
    def call(in: In): Out = underlying(in)

    override def apply(in: In): Out = underlying(in)
  }


  implicit class HListOps[InL <: HList](inL: InL) {
    def fold[Out](implicit hfolder: HFolder[InL, Out]): Callable[hfolder.Folder, Out] = {
      new Callable(hfolder.fold(inL))
    }

  }

}

/**
  * Given a HList I0::I1::...In::HNil
  * returns a HList Ctx[I0]::Ctx[I1]::...Ctx[In]::HNil
  * ensuring all types in the InL have a context bound Ctx
  *
  * @tparam Ctx
  * @tparam InL
  */
trait HCtxBound[Ctx[_], InL <: HList] {
  type OutL <: HList
  def apply: OutL
}
object HCtxBound {

  implicit def nilCtxBound[Ctx[_]]: HCtxBound[Ctx, HNil] {type OutL = HNil} = new HCtxBound[Ctx, HNil] {
    override type OutL = HNil

    override def apply: HNil = HNil
  }

  implicit def consCtxBound[Ctx[_], InH, InT <: HList](
    implicit
    headCtx: Ctx[InH],
    tailCtxBound: HCtxBound[Ctx, InT]
  )
  : HCtxBound[Ctx, InH :: InT] {type OutL = Ctx[InH] :: tailCtxBound.OutL} = new HCtxBound[Ctx, InH :: InT] {
    override type OutL = Ctx[InH] :: tailCtxBound.OutL

    override def apply: Ctx[InH] :: tailCtxBound.OutL = headCtx :: tailCtxBound.apply
  }

}


/**
  * Takes an HList of effects Eff[I0]::Eff[I1]:: ... Eff[In]::HNil
  * and gets the profuct of its values into the Eff:
  * Eff[I0::I1::... In::HNil]
  *
  * @tparam Eff The effect
  * @tparam InL the input HList
  */
trait HApplicative[Eff[_], InL <: HList] extends {
  type OutL <: HList
  def product: InL => Eff[OutL]
}


object HApplicative {


  case class HAppAux[Eff[_], InL <: HList, OutL0 <: HList](zipper: InL => Eff[OutL0]) extends HApplicative[Eff, InL] {
    type OutL = OutL0

    override def product: InL => Eff[OutL0] = zipper
  }

  implicit def nilHApp[Eff[_]](implicit app: Applicative[Eff]): HApplicative[Eff, HNil] {type OutL = HNil} =
    HAppAux[Eff, HNil, HNil](_ => app.pure(HNil))


  implicit def consHApp[Eff[_], InH, InT <: HList](
    implicit tailHApp: HApplicative[Eff, InT],
    app: Applicative[Eff]
  ): HApplicative[Eff, Eff[InH] :: InT] {type OutL = InH :: tailHApp.OutL} = HAppAux[Eff, Eff[InH] :: InT, InH :: tailHApp.OutL] {
    case (inH: Eff[InH]) :: inT => app.map2(inH, tailHApp.product(inT)) {
      case (head, tail) => head :: tail
    }
  }


  trait Wirer[Eff[_], InL <: HList] {
    def to[T](mapper: InL => T): Eff[T]
  }

  def wire[Eff[_], InL <: HList](someList: InL)
    (
      implicit hApp: HApplicative[Eff, InL],
      app: Applicative[Eff]
    ): Wirer[Eff, hApp.OutL] = new Wirer[Eff, hApp.OutL] {
    override def to[T](mapper: hApp.OutL => T): Eff[T] = app.map(hApp.product(someList))(mapper)
  }
}