Monad in Ruby

monad.rb

class MonadContext

  def initialize(monad_methods)
    @monad = nil
    @monad_methods = monad_methods
  end

  def monad
    @monad || raise("Monad doesn't exist")
  end

  def context(&block)
    context = Context.new do |name, *args, &block|
      ptr = []
      v = Bind.new { ptr.empty? ? raise("Result isn't got yet.") : ptr.first }

      join(@monad_methods.send(name, *args))
      bind {|a| @monad_methods.unit(block.call(a)) } if block
      bind {|a| ptr[0] = a; @monad_methods.unit(a) }
      v
    end

    context.instance_eval(&block)
    self
  end

  def bind(&f)
    @monad = @monad_methods.bind(monad, f)
  end

  def join(m)
    if @monad
      @monad = @monad_methods.join(@monad, m)
    else
      @monad = m
    end
  end


  class Context

    def initialize(&callback)
      @callback = callback
    end

    def method_missing(name, *args, &block)
      @callback.call(name, *args, &block)
    end
  end


  class Bind < BasicObject

    private *instance_methods
    private

    def initialize(&fetch)
      @fetch = fetch
    end

    def method_missing(name, *args, &block)
      @result = @fetch.() unless defined? @result
      @result.send(name, *args, &block)
    end
  end
end

module Monad

  def unit(a)
    fail
  end

  def bind(m, k)
    fail
  end

  def join(m, k)
    bind(m, ->(_) { k })
  end
end

module MonadState
  include Monad

  def get()
    fail
  end

  def put()
    fail
  end

  def modify(f)
    Monad(self) { s = get(); put(f.(s)) }
  end

  def gets(f)
    Monad(self) { s = get(); unit(f.(s)) }
  end
end

class State
  include Monad
  include MonadState

  def unit(a)
    ->(s) { [a, s] }
  end
 
  def bind(m, k)
    ->(s) {
      (a, s_) = m.(s)
      k.(a).(s_)
    }
  end
 
  def get()
    ->(s) { [s, s] }
  end
 
  def put(s)
    ->(_) { [nil, s] }
  end
end

def Monad(*args, &context)
  MonadContext.new(*args).context(&context).monad
end

def State(&context)
  MonadContext.new(State.new).context(&context).monad
end

state = State do
  get { |x| puts x }
  x = get { |x| x ** 2 }
  put x
  get { |x| puts x }
end

state.call(42)

SomeMonad.new { m1; m2; m3 }

で

do { m1; m2; m3 }

と同じことができる

SomeMonad.new do
  m { |a| x }
end

は

m >>= (\a -> return x)

と同じ (ただし、副作用も自由に書ける)

SomeMonad.new do
x = m1
m2 x
end

は

do { x <- m1; m2 x }

と同じ。ただし

SomeMonad.new do
x = m1
m2 x.hoge
end

みたいにメソッドを呼ぶことはできないモナドがある。これは x が実際には Bind オブジェクトで、モナドが実行されてからでないとできないため。
もし SomeMonad.bind(m, k) が即座に k に a を渡すような動作なら可能。
Stateモナドのように、即座に評価せず s -> (a, s) を返すような動作の場合

SomeMonad.new do
hoge = m1 { |x| x.hoge }
m2 hoge
end

のようにする必要がある。

SomeMonad は

class SomeMonad < Monad
  def self.unit a
    a
  end

  def self.bind m, k
    k.(m)
  end

  def m1; 1; end
  def m2; 2; end
  def m3; 3; end
end

こんな感じに定義する

update で変わった。

class SomeMonad
  include Monad

  def monad_methods
    super + [:m1, :m2, :m3]
  end

  def unit a
    a
  end

  def bind m, k
    k.(m)
  end

  def m1; 1; end
  def m2; 2; end
  def m3; 3; end
end

というふうに作って

SomeMonad.new.context { m1; m2; m3 }

のように使う