gistfile1.txt

import scala.language.higherKinds
import scalaz.Coproduct
import scalaz.Functor
import scalaz.Applicative
import scalaz.Free
import scalaz.Free.Return
import scalaz.Free.Suspend
import scalaz.State.modify
import scalaz.State
import scalaz.Monad
import scalaz.Inject
import scalaz.Inject.inject
import scalaz._
import Scalaz._
import scala.annotation.tailrec


object Main {
  // Domain Model.
  case class Account (number:String, balance:Int) {
    
    def this(number:String) {
      this(number, 0)
    }
  
    def withdraw(amount:Int):Account = {
        require (amount > 0, "It is only possible to withdraw a positive amount")
        require (balance - amount >= 0, "The amount requisted excese the balance")
        
        copy(balance = balance - amount)
    }
    
    def deposit(amount:Int):Account = {
        require (amount > 0, "It is only possible to deposit a positive amount")
        
        copy(balance = balance + amount)
    }
  }

  type AccountMap = Map[String,Account]
  

  
  // Domain Specific Language for Repository Functions 
  sealed abstract trait ROp[+A]
  final case class Save[A](account:Account,next:A) extends ROp[A]
  final case class Get[A](number:String,f:Account => A) extends ROp[A]
    
  implicit def ROpFunctor = new Functor[ROp] {
    def map[A, B](x: ROp[A])(f: A => B) = x match {
      case Save(account,next)         => Save(account,f(next))
      case Get(number,g)              => Get(number,f.compose(g))
    }
  }
  
  def get[F[_]: Functor](number:String)(implicit I: Inject[ROp,F]):Free[F,Account] = 
    inject[F,ROp,Account](Get(number, Return(_))) 
  
  def save[F[_]: Functor](account:Account)(implicit I: Inject[ROp,F]):Free[F,Unit] = 
    inject[F,ROp,Unit](Save(account, Return()))   
    
 
    
    
  // Domain Specific Language for Domain Functions
  sealed trait Op[+A]
  case class Balance[A](account:Account,f:Int => A) extends Op[A]
  case class Deposit[A](amount:Int,account:Account,f:Account => A) extends Op[A]
  case class Withdraw[A](amount:Int,account:Account,f:Account => A) extends Op[A]
    
  implicit def OpFunctor = new Functor[Op] {
    def map[A, B](x: Op[A])(f: A => B) = x match {
      case Balance(account,g)         => Balance(account,f.compose(g))
      case Deposit(amount,account,g)  => Deposit(amount,account,f.compose(g)) 
      case Withdraw(amount,account,g) => Withdraw(amount,account,f.compose(g))
    }
  }
  
  def balance[F[_]:Functor](account:Account)(implicit I: Inject[Op,F]) = 
    inject[F,Op,Int](Balance(account,Return(_)))
  def deposit[F[_]:Functor](amount:Int)(account:Account)(implicit I: Inject[Op,F]) =
    inject[F,Op,Account](Deposit(amount,account,Return(_)))
  def withdraw[F[_]:Functor](amount:Int)(account:Account)(implicit I: Inject[Op,F]) =
    inject[F,Op,Account](Withdraw(amount,account,Return(_)))
  
  
  // Create a composition of two domain specific languages
  type Al[A] = Coproduct[ROp,Op,A]
  type Program[A] = Free[Al,A]
  
  
  // Service layer
  def getBalance(number:String):Program[Int] = 
    get[Al](number) >>= balance[Al]
  
  def doTransfer(dest:String,source:String,amount:Int):Program[Unit] = 
    (get[Al](dest) >>= deposit[Al](amount) >>= save[Al]) >> 
    (get[Al](source) >>= withdraw[Al](amount) >>= save[Al])
  
    
  // Monad stack used by the interpreters
  type ST[A] = State[AccountMap,A]  
  
  object ST {
    def apply[A](a: A):ST[A] = a.point[ST]
  }
  
  // Interpreters are natural transformations
  trait Interpreter[F[_]] {
    def interpreter:F ~> ST
  }
  
  // Interpreter for repository operations defined as a natural transformation
  implicit def interpreterOnROp = new Interpreter[ROp] {
    def interpreter:ROp ~> ST = new (ROp ~> ST) {
      def apply[A](op:ROp[A]):ST[A] = op match {
        case Save(account,next) => for {
          _ <- modify[AccountMap] { map => map + (account.number -> account) }
        } yield next
      
        case Get(number,f) => for {
          map  <- scalaz.State.get[AccountMap]
          next <- (map get number) match {
            case None          => throw new Error ("Unknown account number")
            case Some(account) => ST(f(account))
          }
        } yield next
      }
    }
  }
      
  // Interpreter for domain operations defined as a natural transformation
  implicit def interpreterOnOp = new Interpreter[Op] {
    def interpreter:Op ~> ST = new (Op ~> ST) {
      def apply[A](op:Op[A]):ST[A] = op match {
        case Balance(account,f)         => ST(f(account.balance))
        case Deposit(amount,account,f)  => ST(f(account.deposit(amount)))
        case Withdraw(amount,account,f) => ST(f(account.withdraw(amount)))
      }
    }
  }  
  
  
  /*
   * Here I define two instances of the type class Interpreter. One instance is 
   * for Al[A] (Coproduct ROp Op A), which is specific form this application:
   *
   * instance Interpreter (Coproduct ROp Op) where
   * 
   * The other one is more generic:
   * 
   * instance (Interpreter f, Interpreter g) => Interpreter (Coproduct f g) where
   *  
   * I would like the application to work with only the generic version, but instead
   * my code only works with the specific version... 
   */  
  
  // Interpreter for co-products
  /*
  implicit def interpreterOnCoproduct[A,F[_]: Interpreter, G[_]: Interpreter] = {
    type H[A] = Coproduct[F,G,A]   
    new Interpreter[H] {
      def interpreter:H ~> ST = new (H ~> ST) {
        def apply[A](h:H[A]):ST[A] = h.run match {
          case -\/(x) => implicitly[Interpreter[F]].interpreter(x)
          case \/-(x) => implicitly[Interpreter[G]].interpreter(x)
        }
      }
    }
  }
  */
  
  // Should not really be necessary since Al is a coproduct for which we defined an instance above 
  implicit def interpreterOnAl = new Interpreter[Al] {
    def interpreter:Al ~> ST = new (Al ~> ST) {
      def apply[A](algebra:Al[A]):ST[A] = algebra.run match {
        case -\/(x) => implicitly[Interpreter[ROp]].interpreter(x)
        case \/-(x) => implicitly[Interpreter[Op]].interpreter(x)
      }
    }
  }
  
  // Convert a program written in the DSL to a program using the ST monad and run this monad with the 
  // supplied state.
  def execute[A,F[_]:Functor](p:Free[F,A], state:AccountMap)(implicit e:Interpreter[F]) = {
    def go(p:Free[ST,A]):ST[A] = p.resume match {
      case \/-(r) => Monad[ST].pure(r)
      case -\/(s) => Monad[ST].bind(s)(go)
    }
    go(p.mapSuspension(e.interpreter)).run(state)
  } 

  
  def main(args:Array[String]):Unit = {
    // Initial state
    val s0 = Map("1" -> Account("1", 100),"2" -> Account("2", 50))
    println(s0)
    
    // Query the balance of account 1
    val (s1,r1) = execute(getBalance("1"), s0)
    println("The initial balance at account 1 is: " + r1)
    
    // Transfer 25 to account 1 from account 2
    val (s2,r2) = execute(doTransfer("1","2",25),s1)
    
    // Query the balance of account 1
    val (s3,r3) = execute(getBalance("1"),s2)
    println("The new balance at account 1 is: " + r3)
    
    // Print the final application state
    println(s3)
  }
}