Http4s Directive Baseline

Http4sDirective.scala

package io.chrisdavenport.http4s.directive

import cats._
import cats.data._
import org.http4s._
import cats.effect._
import org.http4s._
import org.http4s.implicits._
import cats.syntax.all._
import cats.effect.std._
object Main extends IOApp {

  def run(args: List[String]): IO[ExitCode] = {
    routes(Request[IO](Method.GET)).value.flatTap(Console[IO].println) >>
    routes(Request[IO](Method.POST)).value.flatTap(Console[IO].println) >>
    routes(Request[IO](Method.DELETE)).value.flatTap(Console[IO].println)
  } >> {
    IO(ExitCode.Success)
  }

  def routes : HttpRoutes[IO] = {
    val directives = Directives[IO]; import directives._

    concat(
      (post | get){
        HttpRoutes.of[IO]{
          case _ => Response[IO](Status.Ok).pure[IO]
        }
      },
      delete {
        HttpRoutes.of[IO]{case _ => Response[IO](Status.Accepted).pure[IO]}
      }
    )
  }

}

trait Directive[F[_],L](using F: Monad[F]){
  def apply(f: L => HttpRoutes[F]): HttpRoutes[F]

  def flatMap[R](f: L => Directive[F, R]): Directive[F, R] =
    Directive[F, R] { inner => apply { values => f(values) apply inner } }

  def map[R](f: L => R): Directive[F, R] = 
    Directive[F, R](cont => apply(l => cont(f(l))))


  def or[R >: L](that: => Directive[F, R]): Directive[F, R] = Directive[F, R]{inner => 
    Kleisli{req => 
      apply(inner)(req).orElse(that.apply(inner)(req))
    }
  }

  def |[R >: L](that: => Directive[F, R]): Directive[F, R] = or(that)

  def collect[R](pf: PartialFunction[L, R]) = Directive[F, R]{cont => 
    apply(l => if (pf.isDefinedAt(l)) cont(pf(l)) else Kleisli.liftF(OptionT.none[F, Response[F]]))
  }

  def filter(pred: L => Boolean) = Directive[F, L]{cont => 
    apply(l => if (pred(l)) cont(l) else Kleisli.liftF(OptionT.none[F, Response[F]]))
  }

  def mapFilter[R](f: L => Option[R]) = collect(f.unlift)

}


object Directive {

  type Directive0[F[_]] = Directive[F, Unit]

  /**
   * Constructs a directive from a function literal.
   */
  def apply[F[_]: Monad, T](f: (T => HttpRoutes[F]) => HttpRoutes[F]): Directive[F, T] =
    new Directive[F, T] { def apply(inner: T => HttpRoutes[F]) = f(inner) }


  def Empty[F[_]: Monad]: Directive0[F] = Directive(_(()))


  implicit def addByNameNullaryApply[F[_]](directive: Directive0[F]): (=> HttpRoutes[F]) => HttpRoutes[F] =
    r => directive.apply(_ => r)

  implicit class Directive0Support[F[_]](val underlying: Directive0[F]) extends AnyVal {
    def wrap[R](f: => Directive[F, R]): Directive[F, R] = underlying.flatMap { _ => f}
  }

}

trait Directives[F[_]](using Monad[F])
  extends BasicDirectives[F]
  with MethodDirectives[F]
  with RoutesConcatenation[F]

object Directives{
  def apply[F[_]](using Monad[F]): Directives[F] = new Directives[F]{}
}

trait BasicDirectives[F[_]](using Monad[F]){

  def extract[T](f: Request[F] => T): Directive[F, T] =
    Directive(cont => HttpRoutes{req => 
      val t = f(req)
      cont(t)(req)
    })

  def extractOption[T](f: Request[F] => Option[T]): Directive[F, T] = 
    Directive(cont => HttpRoutes{req => 
      OptionT.fromOption[F](f(req)).flatMap{t => 
        cont(t)(req)
      }
    })

  def request: Directive[F, Request[F]] = extract(identity)

  def method: Directive[F, Method] = extract(_.method)

  def headers: Directive[F, Headers] = extract(_.headers)

  def attributes: Directive[F, org.typelevel.vault.Vault] = extract(_.attributes)

  def httpVersion: Directive[F, HttpVersion] = extract(_.httpVersion)

  def uri: Directive[F, Uri] = extract(_.uri)

  def scheme = uri.mapFilter(_.scheme)

  def authority = uri.mapFilter(_.authority)

  def query = uri.map(_.query)


  def path: Directive[F, Uri.Path] = uri.map(_.path)

  def body: Directive[F, fs2.Stream[F, Byte]] = extract(_.body)

}

trait MethodDirectives[F[_]]()(using Monad[F]){
  self: BasicDirectives[F] => 

  def extractMethod(m: Method)  = method.collect{
    case `m` => ()
  }

  def delete = extractMethod(Method.DELETE)

  def get = extractMethod(Method.GET)

  def post = extractMethod(Method.POST)

  def head = extractMethod(Method.HEAD)

  
}

trait RoutesConcatenation[F[_]](using Monad[F]){
  def concat(routes: HttpRoutes[F]*): HttpRoutes[F] = {
    routes.foldLeft(HttpRoutes.empty[F])(_ <+> _)
  }
}