From 686a089178c1db183c93023d71d1e6987d4c1b40 Mon Sep 17 00:00:00 2001 From: Andrzej Sliwa Date: Sun, 23 Feb 2020 12:05:24 +0100 Subject: [PATCH] proof of concept for implementing strict, keyword based union types following the ideas from F# --- lib/monadt/adt.rb | 126 ++++++++++++++++++++++++++++++++++++++-- lib/monadt/either.rb | 4 +- lib/monadt/maybe.rb | 4 +- spec/monadt/adt_spec.rb | 59 +++++++++++-------- 4 files changed, 160 insertions(+), 33 deletions(-) diff --git a/lib/monadt/adt.rb b/lib/monadt/adt.rb index 7c9ea36..a95c042 100644 --- a/lib/monadt/adt.rb +++ b/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 diff --git a/lib/monadt/either.rb b/lib/monadt/either.rb index c648f73..ab0419c 100644 --- a/lib/monadt/either.rb +++ b/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 diff --git a/lib/monadt/maybe.rb b/lib/monadt/maybe.rb index 797dc6a..b06f335 100644 --- a/lib/monadt/maybe.rb +++ b/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 diff --git a/spec/monadt/adt_spec.rb b/spec/monadt/adt_spec.rb index 2563bdd..dd5257a 100644 --- a/spec/monadt/adt_spec.rb +++ b/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