ugly proof of concept for implementing strict, keyword based union types following the ideas from F#

lib/monadt/adt.rb

@@ -2,9 +2,116 @@
 
 AdtPattern = Struct.new :klass, :lambda
 
-def data(*fields)
+module KeyStruct
+  def self.reader(*keys)
+    fetch_key_struct(:reader, keys)
+  end
+
+  def self.accessor(*keys)
+    fetch_key_struct(:accessor, keys)
+  end
+
+  instance_eval do
+    alias :[] :accessor
+  end
+
+  private
+
+  # for anonymous superclasses, such as
+  #
+  #    class Foo < KeyStruct[:a, :b]
+  #    end
+  #
+  #  we want to be sure that if the code gets re-executed (e.g. the file
+  #  gets loaded twice) the superclass will be the same object otherwise
+  #  ruby will raise a TypeError: superclass mismatch.  So keep a cache of
+  #  anonymous KeyStructs
+  #
+  #  But don't reuse the class if it has a name, i.e. if it was assigned to
+  #  a constant.  If somebody does
+  #
+  #     Foo = KeyStruct[:a, :b]
+  #     Bar = KeyStruct[:a, :b]
+  #
+  #  they should get different class definitions, in particular because the
+  #  classname is used in #to_s and #inspect
+  #
+  def self.fetch_key_struct(access, keys)
+    @cache ||= {}
+    signature = [access, keys]
+    @cache.delete(signature) if @cache[signature] and @cache[signature].name
+    @cache[signature] ||= define_key_struct(access, keys)
+  end
+
+  def self.define_key_struct(access, keys)
+    keys = keys.dup
+    defaults = (Hash === keys.last) ? keys.pop.dup : {}
+    keys += defaults.keys
+
+    Class.new.tap do |klass|
+      klass.class_eval do
+        include Comparable
+
+        send "attr_#{access}", *keys
+
+        define_singleton_method(:keys) { keys }
+        define_singleton_method(:defaults) { defaults }
+        define_singleton_method(:access) { access }
+        define_singleton_method(:display_name) { self.name || "KeyStruct.#{access}" }
+
+        define_method(:initialize) do | args={} |
+          args = defaults.merge(args)
+          errors = []
+          keys.each do |key|
+            value = args.delete(key)
+            instance_variable_set("@#{key}".to_sym, value)
+            errors << "#{key.to_s}:" unless value
+          end
+          raise ArgumentError, "Invalid argument(s): #{errors.join(", ")} can't be nil" unless errors.size.zero?
+          raise ArgumentError, "Invalid argument(s): #{args.keys.map(&:inspect).join(' ')} -- KeyStruct accepts #{keys.map(&:inspect).join(' ')}" if args.any?
+        end
+
+        define_method(:to_s) do
+          "[#{self.class.display_name} #{keys.map{|key| "#{key}:#{self.send(key)}"}.join(' ')}]"
+        end
+
+        define_method(:inspect) do
+          "<#{self.class.display_name}:0x#{self.object_id.to_s(16)} #{keys.map{|key| "#{key}:#{self.send(key).inspect}"}.join(' ')}>"
+        end
+
+        define_method(:to_hash) do
+          Hash[*keys.map{ |key| [key, self.send(key)]}.flatten(1)]
+        end
+
+        define_method(:values) do
+          to_hash.values
+        end
+
+        define_method(:==) do |other|
+          self.class.keys.all?{|key| other.respond_to?(key) and self.send(key) == other.send(key)}
+        end
+
+        define_method(:<=>) do |other|
+          keys.each do |key|
+            cmp = (self.send(key) <=> other.send(key))
+            return cmp unless cmp == 0
+          end
+          0
+        end
+      end
+    end
+  end
+end
+
+AdtPattern = KeyStruct[:klass, :lambda]
+
+def data(*fields, key_struct: true)
   base = if fields.size > 0
-           Struct.new(*fields)
+           if key_struct
+             KeyStruct[*fields]
+           else
+             Struct.new(*fields)
+           end
          else
            Object
          end
@@ -44,17 +151,26 @@ def match(o, *cases)
     m = cases.find do |tpl|
       tpl.klass == o.class || tpl.klass == Default
     end
-    params =
+    if o.respond_to?(:to_hash)
+      if m.lambda.arity == 1
+        params = o.to_hash.slice(*m.lambda.parameters.map { |p| p.last})
+        m.lambda.call(**params)
+      else
+        m.lambda.call
+      end
+    else
+      params =
       if m.lambda.arity > 0
         o.values.take(m.lambda.arity)
       else
         []
       end
-    m.lambda.call(*params)
+      m.lambda.call(*params)
+    end
   end
 
   def with(klass, prc=nil, &blk)
-    AdtPattern.new klass, prc || blk
+    AdtPattern.new klass: klass, lambda: prc || blk
   end
 end
 

lib/monadt/either.rb

@@ -2,8 +2,8 @@
 
 module Monadt
   class Either
-    Left = data :left
-    Right = data :right
+    Left = data :left, key_struct: false
+    Right = data :right, key_struct: false
 
     class << self
       include Adt

lib/monadt/maybe.rb

@@ -2,8 +2,8 @@
 
 module Monadt
   class Maybe
-    Just = data :value
-    Nothing = data
+    Just = data :value, key_struct: false
+    Nothing = data key_struct: false
 
     class << self
       include Adt

spec/monadt/adt_spec.rb

@@ -1,35 +1,46 @@
 require 'monadt/adt'
 
-class TestAdt
-  One = data :foo, :bar
-  Two = data :foo
-  AndThree = data
+# Proof of concept for modeling Business Domain with Nil/Null or Optional based on F# union types
+#
+# type RegistrationFlow =
+#   | Accepted of confirmation_number: int
+#   | CourseFull
+#   | WaitingList if spot: int
+#
+# Example contract of method which depends on this type:
+#
+# let registerForCourse (course: Course) : RegistrationFlow = ...
+
+class RegistrationFlow
+  Accepted = data :confirmation_number, :full_name
+  CourseFull = data
+  WaitingList = data :spot
 end
 
-decorate_adt TestAdt
+decorate_adt RegistrationFlow
 
 class UseAdts
   include Adt
 
   def adt_func(o)
     match o,
-      with(TestAdt::One, ->(foo, bar) { foo.to_s + bar.to_s }),
-      with(TestAdt::AndThree, ->() { 10 }),
+      with(RegistrationFlow::Accepted, ->(confirmation_number:, full_name:) { confirmation_number.to_s + full_name.to_s }),
+      with(RegistrationFlow::CourseFull, ->() { 10 }),
       with(Default, ->() { "default" })
   end
 
   def adt_func2(o)
     match o,
-      with(TestAdt::One) { |foo, bar| foo.to_s + bar.to_s },
-      with(TestAdt::AndThree) { 10 },
+      with(RegistrationFlow::Accepted) { |confirmation_number:, full_name:| confirmation_number.to_s + full_name.to_s },
+      with(RegistrationFlow::CourseFull) { 10 },
       with(Default) { "default" }
   end
 end
 
 describe 'Algebraic Data Types' do
-  let(:v1) { TestAdt.one 1, :five }
-  let(:v2) { TestAdt.two "hoi" }
-  let(:v3) { TestAdt.and_three }
+  let(:v1) { RegistrationFlow.accepted confirmation_number: 1, full_name: :five }
+  let(:v2) { RegistrationFlow.waiting_list spot: "hoi" }
+  let(:v3) { RegistrationFlow.course_full }
   let(:subject) { UseAdts.new }
 
   describe 'proc/block based ADTs' do
@@ -49,20 +60,20 @@ def adt_func2(o)
 
   describe "decorate ADTs" do
     it 'supports blocks' do
-      expect(v1.is_one?).to be true
-      expect(v1.is_two?).to be false
-      expect(v1.is_and_three?).to be false
-      expect(v1.to_s).to eq("One(1, five)")
+      expect(v1.is_accepted?).to be true
+      expect(v1.is_waiting_list?).to be false
+      expect(v1.is_course_full?).to be false
+      expect(v1.to_s).to eq("Accepted(1, five)")
 
-      expect(v2.is_one?).to be false
-      expect(v2.is_two?).to be true
-      expect(v2.is_and_three?).to be false
-      expect(v2.to_s).to eq("Two(hoi)")
+      expect(v2.is_accepted?).to be false
+      expect(v2.is_waiting_list?).to be true
+      expect(v2.is_course_full?).to be false
+      expect(v2.to_s).to eq("WaitingList(hoi)")
 
-      expect(v3.is_one?).to be false
-      expect(v3.is_two?).to be false
-      expect(v3.is_and_three?).to be true
-      expect(v3.to_s).to eq("AndThree")
+      expect(v3.is_accepted?).to be false
+      expect(v3.is_waiting_list?).to be false
+      expect(v3.is_course_full?).to be true
+      expect(v3.to_s).to eq("CourseFull")
     end
   end
 end