functional.rb

module ArityRange
  def arity_range
    args = parameters.map(&:first)

    req = args.count :req
    keyreq = args.count :keyreq

    opt = args.include?(:rest) ? Float::INFINITY : args.count(:opt)
    keyopt = args.include?(:keyrest) ? Float::INFINITY : args.count(:key)

    { arguments: req..req + opt, keywords: keyreq..keyreq + keyopt }
  end

  refine UnboundMethod do
    include ArityRange
  end

  refine Method do
    include ArityRange
  end
end

module Protocol
  using ArityRange

  class MethodRequirement
    Exception = Class.new(StandardError)

    def initialize(method, arguments: nil)
      @method = method
      @arguments = case arguments
                   when NilClass then nil
                   when Integer then arguments..arguments
                   when Range then arguments
                   else raise ArgumentError
                   end
    end

    def ===(other)
      other.method_defined?(@method) &&
        (!@arguments || @arguments == other.instance_method(@method).arity_range[:arguments])
    end

    def to_s
      "method ##{@method}#{" with arity #{@arguments}" if @arguments}"
    end
  end

  class ClassMethodRequirement < MethodRequirement
    Exception = Class.new(StandardError)

    def ===(other)
      other.respond_to?(@method) &&
        (!@arguments || @arguments == other.method(@method).arity_range[:arguments])
    end

    def to_s
      "class #{super}"
    end
  end

  class AncestorRequirement
    Exception = Class.new(StandardError)

    def initialize(ancestor)
      @ancestor = ancestor
    end

    def ===(other)
      other < @ancestor
    end

    def to_s
      "ancestor #{@ancestor}"
    end
  end

  def self.extended(mod)
    mod.instance_eval do
      @requirements = []
    end
  end

  def requires_ancestor(mod)
    @requirements << AncestorRequirement.new(mod)
  end

  def requires_instance_method(method, **kw)
    @requirements << MethodRequirement.new(method, **kw)
  end

  def requires_class_method(method, **kw)
    @requirements << ClassMethodRequirement.new(method, **kw)
  end

  def included(target)
    @requirements.each do |requirement|
      unless requirement === target
        raise requirement.class::Exception, "protocol #{self} requires #{requirement}"
      end
    end
  end
end

class Module
  alias_method :implements, :include
end

module Functor
  extend Protocol
  requires_instance_method :fmap, arguments: 0..1
end

module Applicative
  extend Protocol
  requires_ancestor Functor
  requires_instance_method :apply, arguments: 1
  requires_class_method :pure, arguments: 1
end

module Monad
  extend Protocol
  requires_ancestor Applicative
  requires_instance_method :bind, arguments: 0..1
  requires_instance_method :join, arguments: 0
  requires_class_method :return, arguments: 1
end

class Maybe
  def initialize(value)
    @value = value
  end

  class << self
    def pure(e)
      new(e)
    end

    def return(e)
      new(e)
    end
  end

  Nothing = new(nil)

  def to_s
    nothing? ?
      "Nothing" :
      "Just #{@value}"
  end

  def join
    nothing? ?
      self :
      @value
  end

  def apply(other)
    nothing? ?
      Nothing :
      other.fmap(@value)
  end

  def bind(func = nil, &blk)
    f = blk || func
    fmap(f).join
  end

  def just?
    self == Nothing
  end

  def nothing?
    self == Nothing
  end

  alias_method :inspect, :to_s

  def fmap(func = nil, &blk)
    f = blk || func
    nothing? ?
      self :
      Maybe.new(f.call(@value))
  end

  def self.Just(e)
    Maybe.new(e)
  end

  alias_method :>=, :bind
end

class Array
  alias_method :fmap, :map
  alias_method :bind, :flat_map
  alias_method :join, :flatten
end

module Kernel
  def fmap(func = nil, &blk)
    f = func || blk
    -> (e) { e.class.instance_method(:fmap).bind(e).call(&f) }
  end
end

class Maybe
  implements Functor
  implements Applicative
  implements Monad
end

def Just(e)
  Maybe::Just(e)
end

Nothing = Maybe::Nothing

halfM = -> (e) { e.even? ? e / 2 : Nothing }
p Just(3) >= halfM >= halfM >= halfM

double = -> (e) { e * 2 }
doubleF = fmap double
p doubleF.([1,2,3,4])
p doubleF.(Nothing)
p doubleF.(Just(3))

maybeAction = Just(halfM)
p Just(double).apply Just(3)
p Nothing.apply Just(3)
p Just(double).apply Nothing
p Nothing.apply Nothing