Doobie Cofree

build.sbt

enablePlugins(JavaAppPackaging)

val AttoVersion            = "0.7.0"
val Http4sVersion          = "0.21.15"
val CirceVersion           = "0.13.0"
val DoobieVersion          = "0.9.0"
val MunitVersion           = "0.7.20"
val MariaDBVersion         = "2.7.1"
val MySQLVersion           = "8.0.22"
val LogbackVersion         = "1.2.3"
val MunitCatsEffectVersion = "0.12.0"
val PureConfigVersion      = "0.14.0"
val SvmSubsVersion         = "20.2.0"
val CatsEffectTimerVersion = "0.1.2"
val MeowMTLEffectsVersion  = "0.4.1"
val LogBack4CatVersion     = "1.1.1"

lazy val root = (project in file("."))
  .settings(
    organization := "org.teckhooi",
    name := "apis-energy",
    version := "1.0.0-SNAPSHOT",
    scalaVersion := "2.13.8",
    libraryDependencies ++= Seq(
      "ch.qos.logback"         % "logback-classic"      % LogbackVersion,
      "com.github.pureconfig" %% "pureconfig"           % PureConfigVersion,
      "com.olegpy"            %% "meow-mtl-core"        % MeowMTLEffectsVersion,
      "io.chrisdavenport"     %% "cats-effect-time"     % CatsEffectTimerVersion,
      "io.chrisdavenport"     %% "log4cats-slf4j"       % LogBack4CatVersion,
      "io.circe"              %% "circe-generic"        % CirceVersion,
      "io.circe"              %% "circe-literal"        % CirceVersion,
      "io.circe"              %% "circe-parser"         % CirceVersion,
      "mysql"                  % "mysql-connector-java" % MySQLVersion,
      "org.mariadb.jdbc"       % "mariadb-java-client"  % MariaDBVersion,
      "org.http4s"            %% "http4s-ember-server"  % Http4sVersion,
      "org.http4s"            %% "http4s-ember-client"  % Http4sVersion,
      "org.http4s"            %% "http4s-circe"         % Http4sVersion,
      "org.http4s"            %% "http4s-dsl"           % Http4sVersion,
      "org.scalameta"         %% "svm-subs"             % SvmSubsVersion,
      "org.scalameta"         %% "munit"                % MunitVersion           % Test,
      "org.tpolecat"          %% "doobie-core"          % DoobieVersion,
      "org.tpolecat"          %% "doobie-hikari"        % DoobieVersion,
      "org.tpolecat"          %% "atto-core"            % AttoVersion,
      "org.typelevel"         %% "munit-cats-effect-2"  % MunitCatsEffectVersion % Test
    ),
    addCompilerPlugin("org.typelevel" %% "kind-projector"     % "0.13.2" cross CrossVersion.full),
    addCompilerPlugin("com.olegpy"    %% "better-monadic-for" % "0.3.1"),
    testFrameworks += new TestFramework("munit.Framework")
  )

scalacOptions ++= Seq("-target:11", "-deprecation")

reStart / mainClass := Some("org.teckhooi.apis.Main")

reStart / javaOptions += "-Xmx1g"

console / initialCommands += """import cats._
                                |import cats.effect._
                                |import cats.implicits._
                                |import doobie.util.ExecutionContexts
                                |import doobie.Read
                                |import doobie.implicits._
                                |import doobie._
                                |import doobie.util.fragment
                                |import doobie.implicits.javatime._
                                |import doobie.util.transactor.Transactor
                                |import java.time.LocalDateTime
                                |import org.teckhooi.apis.domain._
                                |import  org.teckhooi.apis.repositories._
                                |implicit val cs = IO.contextShift(ExecutionContexts.synchronous)
                                """.stripMargin

CofreeExample.scala

package org.teckhooi

import atto.Atto._
import atto._
import cats._
import cats.data.Kleisli
import cats.effect._
import cats.free.Cofree
import cats.implicits._
import doobie._
import doobie.free.KleisliInterpreter
import doobie.implicits._

import java.sql.Connection
import java.util.Objects
import java.util.concurrent.Executors
import scala.concurrent.ExecutionContext

object CofreeExample extends IOApp {
  case class Fix[F[_]](unfix: F[Fix[F]])

  /** A data type for professors and their Ph.D. students. */
  case class ProfF[A](name: String, uni: String, year: Int, students: List[A]) {
    override def toString = s"ProfF($name, $uni, $year, «${students.length}»)"
  }

  object ProfF {

    // It is a traversable functor. For more on applicative and traversable functors see the
    // original paper by Conor McBride (http://strictlypositive.org/Idiom.pdf) and Scala examples
    // in the Cats documentation (http://typelevel.org/cats/tut/traverse.html).
    implicit val ProfFTraverse: Traverse[ProfF] =
      new Traverse[ProfF] {
        override def foldLeft[A, B](fa: ProfF[A], b: B)(f: (B, A) => B): B = ???

        override def foldRight[A, B](fa: ProfF[A], lb: Eval[B])(
            f: (A, Eval[B]) => Eval[B]
        ): Eval[B] = ???

        override def traverse[G[_]: Applicative, A, B](fa: ProfF[A])(f: A => G[B]): G[ProfF[B]] =
          fa.students.map(f).sequence.map(ss => fa.copy(students = ss))
      }
  }

  val data: String =
    """|Simeon Denis Poisson, École Polytechnique, 1800
       |  Gustav Peter Lejeune Dirichlet, Rheinische Friedrich-Wilhelms-Universität Bonn, 1827
       |    Rudolf Otto Sigismund Lipschitz, Universität Berlin, 1853
       |      C. Felix (Christian) Klein, Rheinische Friedrich-Wilhelms-Universität Bonn, 1868
       |        William Edward Story, Universität Leipzig, 1875
       |          Solomon Lefschetz, Clark University, 1911
       |            Albert William Tucker, Princeton University, 1932
       |              Marvin Lee Minsky, Princeton University, 1954
       |                Gerald Jay Sussman, Massachusetts Institute of Technology, 1973
       |                  Guy Lewis Steele, Massachusetts Institute of Technology, 1980
       |                    Philip Lee Wadler, Carnegie Mellon University, 1984
       |        C. L. Ferdinand (Carl Louis) Lindemann, Friedrich-Alexander-Universität Erlangen-Nürnberg, 1873
       |          David Hilbert, Universität Königsberg, 1885
       |            Wilhelm Ackermann, Georg-August-Universität Göttingen, 1925
       |            Haskell Curry, Georg-August-Universität Göttingen, 1930
       |            Hermann Weyl, Georg-August-Universität Göttingen, 1908
       |              Saunders Mac Lane, Georg-August-Universität Göttingen, 1934
       |                Steven Awodey, The University of Chicago, 1997
       |                William Howard, The University of Chicago, 1956
       |  Michel Chasles, École Polytechnique, 1814
       |    H. A. (Hubert Anson) Newton, Yale University, 1850
       |      E. H. (Eliakim Hastings) Moore, Yale University, 1885
       |        Oswald Veblen, The University of Chicago, 1903
       |          Alonzo Church, Princeton University, 1927
       |            Alan Mathison Turing, Princeton University, 1938
       |            Stephen Cole Kleene, Princeton University, 1934
       |              Robert Lee Constable, University of Wisconsin-Madison, 1968
       |                Robert William Harper, Cornell University, 1985
       |                  Benjamin Crawford Pierce, Carnegie Mellon University, 1991
       |""".stripMargin

  val ctString: Parser[String] =
    takeWhile(_ != ',') <* token(char(','))

  /** Parser for un-annotated ProfF. */
  def prof(n: Int): Parser[Fix[ProfF]] =
    for {
      _    <- char(' ').replicateA(n)
      name <- ctString
      uni  <- ctString
      year <- int <* string(System.lineSeparator())
      ss   <- many(prof(n + 2))
    } yield Fix(ProfF(name, uni, year, ss))

  /** Parser for parse-position-annotated ProfF. */
  def posProf(n: Int): Parser[Cofree[ProfF, (Int, Int)]] =
    for {
      p0   <- pos
      _    <- char(' ').replicateA(n)
      name <- ctString
      uni  <- ctString
      year <- int <* string(System.lineSeparator())
      ss   <- many(posProf(n + 2))
      p1   <- pos
    } yield Cofree((p0, p1), Eval.later(ProfF(name, uni, year, ss)))

  ///
  /// INSERT
  ///

  /** Insert a node with the given parent, disregarding children, yielding the generated Id. */
  def insertNode(parent: Option[Int], p: ProfF[_]): ConnectionIO[Int] =
    sql"""
      INSERT INTO prof_node (parent, name, uni, year)
      VALUES ($parent, ${p.name}, ${p.uni}, ${p.year})
      RETURNING id
    """.update.withUniqueGeneratedKeys("id")

  /** Insert a tree rooted at `p` with an optional parent, yielding an equivalent tree annotated
    * with generated Ids.
    */
  def insertTree(fp: Fix[ProfF], parent: Option[Int] = None): ConnectionIO[Cofree[ProfF, Int]] =
    for {
      h <- insertNode(parent, fp.unfix)
      t <- fp.unfix.traverse(insertTree(_, Some(h)))
    } yield Cofree(h, Eval.now(t))

  override def run(args: List[String]): IO[ExitCode] = {

    val xa = Transactor.fromDriverManager[IO](
      "org.mariadb.jdbc.Driver",
      "jdbc:mariadb://192.168.10.101:3306/cofree",
      "appadmin",
      "1@mappadmin"
    )

    val psqlXA = Transactor.fromDriverManager[IO](
      "org.postgresql.Driver",
      "jdbc:postgresql:world",
      "appdev",
      "1@mappdev"
    )

    /*
    val program1: ConnectionIO[List[String]] = for {
      name <- sql"select name from prof_node".query[String].to[List]
    } yield name
     */
    val p: Fix[ProfF] =
      (prof(0) <~ endOfInput).parseOnly(data).option.get

    //        insertTree(p).transact(psqlXA) *> IO.pure(ExitCode.Success)

    val posData: Cofree[ProfF, (Int, Int)] =
      (posProf(0) <~ endOfInput).parseOnly(data).option.get

    def draw[F[_]: Traverse, A](fa: Cofree[F, A], indent: Int = 0): ConnectionIO[Unit] =
      for {
        _ <- HC.delay(print(" " * indent))
        _ <- HC.delay(println(fa.head + " :< " + fa.tail.value))
        _ <- fa.tail.value.traverse(draw(_, indent + 1))
      } yield ()

    val interpreter = KleisliInterpreter[IO](
      Blocker.liftExecutionContext(
        ExecutionContext.fromExecutorService(Executors.newSingleThreadExecutor)
      )
    ).ConnectionInterpreter
    val kleisli: Kleisli[IO, Connection, Unit] = draw(posData).foldMap(interpreter)

    (if (java.lang.Boolean.getBoolean("with-db") || Objects.nonNull(System.getProperty("with-db")))
       draw(posData).transact(psqlXA)
     else
       kleisli.run(null: java.sql.Connection)) *> IO.pure(ExitCode.Success)
  }
}