free monad language for a key-value store

journal.scala

package Journal

import cats._
import cats.data.State
import cats.implicits._
import com.github.nscala_time.time.Imports._
import cats.free.Free
import cats.free.Free.liftF

import cats.arrow.FunctionK
import cats.{Id, ~>}

sealed trait DataType
case class DString(s:String) extends DataType
case class DDate(d:DateTime) extends DataType
case class DLong(l:Long) extends DataType
case class DDouble(d:Double) extends DataType
case class DBoolean(b:Boolean) extends DataType

sealed trait DataOpA[A]
case class Set(s:String, d:DataType) extends DataOpA[Unit]
case class Get(s:String) extends DataOpA[Option[DataType]]
case class Remove(s:String) extends DataOpA[Unit]
case class Update(s:String, f: DataType => DataType) extends DataOpA[Unit]

object Run extends App {


type Model = Map[String,DataType]

type DataOp[A] = Free[DataOpA,A]

def set(key:String, value:DataType) : DataOp[Unit] =
  liftF[DataOpA,Unit](Set(key,value))

def get(key:String) : DataOp[Option[DataType]] =
  liftF[DataOpA,Option[DataType]](Get(key))

def remove(key:String) : DataOp[Unit] =
  liftF[DataOpA,Unit](Remove(key))

//update composes get and set
def update(key : String, f : DataType => DataType) : DataOp[Unit] =
  for {
     vm <- get(key)
     _ <- vm.map(v => set(key, f(v))).getOrElse( Free.pure())
  } yield ()


type DataOpState[A] = State[Map[String,DataType], A]

val pureCompiler : DataOpA ~> DataOpState = new (DataOpA ~> DataOpState) {

  def apply[A](fa : DataOpA[A]) : DataOpState[A] =
    fa match {
      case Set(k,v) => State.modify( st => st.updated(k,v))
      case Get(k) => State.inspect(st => st.get(k) )
      case Remove(key) => State.modify( (st:Map[String,DataType]) => st-key )
      case Update(key,f) => State.modify{  (st:Map[String,DataType]) =>
        st
        .get(key)
        .map( v => st.updated(key,f(v)))
        .getOrElse(st) }
    }
}

  def program: Free[DataOpA, Unit] = {
    for {
      _ <- set("name", DString("Jim"))
      _ <- set("age", DLong(41))
      _ <- set("work", DString("Coder"))
    } yield ()
  }

  val (st,result) = program.foldMap(pureCompiler).run(Map.empty).value

  print(st)
}