arm monad

arm.scala

import scalaz._
import Scalaz._
import scala.util.control.Exception._

package com.github.akihiro4chawon.arm {

// Resource から 最終製品までの供給網
trait SupplyChain[+A] {
  def backorder[S](f: A => S): S
  
  def produce: A = backorder(identity)
  def either: Either[Throwable, A] = allCatch either produce
  def opt: Option[A] = allCatch opt produce
}

// 開け閉めが必要な Resource の供給
class ResourceSupply[+A: Resource](open: => A) extends SupplyChain[A] {
  override def backorder[S](f: A => S): S = {
    val h = open
    try { f(h) } finally { implicitly[Resource[A]].close(h) }
  }
}

// 右から来たものを左へ受け流すでござる
class Plant[+A, +R](supplier: SupplyChain[R], assemble: R => A) extends SupplyChain[A] {
  override def backorder[S](f: A => S): S = supplier.backorder(f compose assemble)
}

// 下請け孫請け join でござる
class Tier[+A, +R](supplier: SupplyChain[R], tier2: R => SupplyChain[A]) extends SupplyChain[A] {
  override def backorder[S](f: A => S): S = supplier.backorder(r => tier2(r).backorder(f))
}

// 天下の往来は無尽蔵の倉庫でござる
class PureSupply[+A](res: A) extends SupplyChain[A] {
  override def backorder[S](f: A => S): S = f(res)
}

// Scalaz 向け型クラス
trait SupplyChains {
  implicit def SupplyChainBind: Bind[SupplyChain] = new Bind[SupplyChain] {
    def bind[A, B](a: SupplyChain[A], f: A => SupplyChain[B]) = new Tier(a, f)
  }
  
  implicit def SupplyChainFunctor = new Functor[SupplyChain] { 
    def fmap[A, B](a: SupplyChain[A], f: A => B ) = new Plant(a, f)
  }

  implicit def SupplyChainEach: Each[SupplyChain] = new Each[SupplyChain] {
    def each[A](a: SupplyChain[A], f: A => Unit) = a backorder f
  }
  
  implicit def SupplyChainPure: Pure[SupplyChain] = new Pure[SupplyChain] {
    def pure[A](a: => A) = new PureSupply(a)
  }
}

}

package com.github.akihiro4chawon {
  package object arm extends SupplyChains {
    def managed[A: Resource](res: => A): SupplyChain[A] = new ResourceSupply(res)
  }
}

Main.scala

import com.github.akihiro4chawon.arm._
import scalaz._
import Scalaz._

object Main extends App {
  import java.io._

  // なんの変哲もない部分
  def copyStream(is: InputStream, os: OutputStream, buffSize: Int) {
    val buff = new Array[Byte](buffSize)
    var readSize = 0
    while ({readSize = is.read(buff); readSize != -1})
      os.write(buff, 0, readSize)
  }
  
  // imperative for-comprehension ができるでござる
  for {
    is <- managed(new FileInputStream("input.txt"): InputStream)
    os <- managed(new FileOutputStream("output-imperative.txt"): OutputStream)
  } copyStream(is, os, 512)
  
  // 遅延評価の monadic for-comprehension もできるでござる
  val copyFileRoutineMonadic = for {
    is <- managed(new FileInputStream("input.txt"): InputStream)
    os <- managed(new FileOutputStream("output-monadic.txt"): OutputStream)
  } yield copyStream(is, os, 512)
  
  // ここで実際に発動する
  copyFileRoutineMonadic.produce
  
  // applicative-style でスッキリ(?)すると思いきや。。。
  val copyFileRoutineApplic =
  managed(new FileInputStream("input.txt"): InputStream) |@|
  managed(new FileOutputStream("output-applic.txt"): OutputStream) |@|
  512.pure apply copyStream

  // ここで実際に発動する
  copyFileRoutineApplic.produce

  // Arrow のほうが本質的じゃねーの？（文法上はごちゃごちゃしているけれど）
  val openInputStream = ☆((file: String) => managed(new FileInputStream(file): InputStream))
  val openOutputStream = ☆((file: String) => managed(new FileOutputStream(file): OutputStream))
  val copyFileFunc = (copyStream(_: InputStream, _: OutputStream, 512)).tupled
  val copyFileArrow = (openInputStream *** openOutputStream) >>^ copyFileFunc

  // ここで実際に発動する
  copyFileArrow("input.txt" -> "output-arrow.txt").produce
  
  // ToDo: Monad とは別個に ARM Arrow 自体を 導出する
  // (Kleisli で Arrow を導出すると、Monad であるという要請が制限過多なのでつまらない。)
}