{"body":"use v6.d.PREVIEW;\nuse Red::Model;\nuse Red::AttrColumn;\nuse Red::Column;\nuse Red::Utils;\nuse Red::ResultSet;\nuse Red::DefaultResultSet;\nuse Red::AttrReferencedBy;\nuse Red::AttrQuery;\nuse Red::Filter;\n\nclass MetamodelX::Model is Metamodel::ClassHOW {\n    has %!columns{Attribute};\n    has %!attr-to-column;\n    has %.dirty-cols is rw;\n    has $.rs-class;\n\n    method table(Mu \\type) { camel-to-snake-case type.^name }\n    method rs-class-name(Mu \\type) { \"{type.^name}::ResultSet\" }\n    method columns(|) is rw {\n        %!columns\n    }\n\n    method id(Mu \\type) {\n        %!columns.keys.grep(*.column.id).list\n    }\n\n    method id-values(Red::Model:D $model) {\n        self.id($model).map({ .get_value: $model }).list\n    }\n\n    method attr-to-column(|) is rw {\n        %!attr-to-column\n    }\n\n    method compose(Mu \\type) {\n        if $.rs-class === Any {\n            my $rs-class-name = $.rs-class-name(type);\n            if try ::($rs-class-name) !~~ Nil {\n                $!rs-class = ::($rs-class-name)\n            } else {\n                $!rs-class = Metamodel::ClassHOW.new_type: :name($rs-class-name);\n                $!rs-class.^add_parent: Red::DefaultResultSet;\n                $!rs-class.^compose;\n                ::($rs-class-name) = $!rs-class\n            }\n        }\n        die \"{$.rs-class.^name} should do the Red::ResultSet role\" unless $.rs-class ~~ Red::ResultSet;\n        self.add_role: type, Red::Model;\n        type.^compose-columns;\n        self.add_role: type, role :: {\n            method TWEAK(|) {\n                self.^set-dirty: self.^columns\n            }\n        }\n        self.Metamodel::ClassHOW::compose(type);\n        for type.^attributes -> $attr {\n            %!attr-to-column{$attr.name} = $attr.column.name if $attr ~~ Red::AttrColumn:D;\n        }\n    }\n\n    method add-column(Red::Model:U \\type, Red::AttrColumn $attr) {\n        %!columns ∪= $attr;\n        my $name = $attr.name.substr: 2;\n        type.^add_multi_method: $name, method (Red::Model:U:) {\n            $attr.column\n        }\n        if $attr.has_accessor {\n            if $attr.rw {\n                type.^add_multi_method: $name, method () is rw {\n                    my \\obj = self;\n                    Proxy.new:\n                        FETCH => method {\n                            $attr.get_value: obj\n                        },\n                        STORE => method (\\value) {\n                            return if value === $attr.get_value: obj;\n                            obj.^set-dirty: $attr;\n                            $attr.set_value: obj, value;\n                        }\n                    ;\n                }\n            } else {\n                type.^add_multi_method: $name, method () {\n                    $attr.get_value: self\n                }\n            }\n        }\n    }\n\n    method compose-columns(Red::Model:U \\type) {\n        for type.^attributes.grep: Red::AttrColumn -> Red::AttrColumn $attr {\n            type.^add-column: $attr\n        }\n    }\n\n    method set-dirty($, $attr) {\n        self.dirty-cols ∪= $attr;\n    }\n    method is-dirty(Any:D \\obj) { so self.dirty-cols }\n    method clean-up(Any:D \\obj) { self.dirty-cols = set() }\n    method dirty-columns(|)     { self.dirty-cols }\n    method rs($)                { $.rs-class.new }\n}\n\nmy package EXPORTHOW {\n    package DECLARE {\n        constant model = MetamodelX::Model;\n    }\n}\n\nmulti trait_mod:<is>(Mu:U $model, Str:D :$rs-class!) {\n    trait_mod:<is>($model, :rs-class(::($rs-class)))\n}\n\nmulti trait_mod:<is>(Mu:U $model, Mu:U :$rs-class!) {\n    die \"{$rs-class.^name} should do the Red::ResultSet role\" unless $rs-class ~~ Red::ResultSet;\n    $model.HOW does role :: { method rs-class(|) { $rs-class<> } }\n}\n\nmulti trait_mod:<is>(Attribute $attr, Bool :$column!) is export {\n    trait_mod:<is>($attr, :column{}) if $column\n}\n\nmulti trait_mod:<is>(Attribute $attr, :%column!) is export {\n    $attr does Red::AttrColumn;\n    my $class = $attr.package;\n    my $obj = Red::Column.new: |%column, :$attr, :$class;\n    my \\at = $attr.^attributes.first({ .name ~~ '$!column' });\n    at.set_value: $attr, $obj;\n}\n\nmulti trait_mod:<is>(Mu:U $model, Str :$table! where .chars > 0) {\n    $model.HOW does role :: {\n        method table(|) { $table<> }\n    }\n}\n\nmulti trait_mod:<is>(Attribute $attr, :&referenced-by!) is export {\n    $attr does Red::AttrReferencedBy;\n    $attr.wrap-data: &referenced-by\n}\n\nmulti trait_mod:<is>(Attribute $attr, Str :$query!) is export {\n    #TODO\n    $attr does Red::AttrQuery;\n    $attr.wrap-data: $query\n}\n\nmulti infix:<==>(Red::Column $a, $b is rw)          is export { Red::Filter.new: :op(Red::Op::eq), :args[$a, * ], :bind[$b] }\nmulti infix:<==>(Red::Column $a, $b is readonly)    is export { Red::Filter.new: :op(Red::Op::eq), :args[$a, $b], :bind[  ] }\nmulti infix:<==>($a is rw, Red::Column $b)          is export { Red::Filter.new: :op(Red::Op::eq), :args[* , $b], :bind[$a] }\nmulti infix:<==>($a is readonly, Red::Column $b)    is export { Red::Filter.new: :op(Red::Op::eq), :args[$a, $b], :bind[  ] }\n\nmulti infix:<!=>(Red::Column $a, $b is rw)          is export { Red::Filter.new: :op(Red::Op::ne), :args[$a, * ], :bind[$b] }\nmulti infix:<!=>(Red::Column $a, $b is readonly)    is export { Red::Filter.new: :op(Red::Op::ne), :args[$a, $b], :bind[  ] }\nmulti infix:<!=>($a is rw, Red::Column $b)          is export { Red::Filter.new: :op(Red::Op::ne), :args[* , $b], :bind[$a] }\nmulti infix:<!=>($a is readonly, Red::Column $b)    is export { Red::Filter.new: :op(Red::Op::ne), :args[$a, $b], :bind[  ] }\n","name":"","extension":"txt","url":"https://www.irccloud.com/pastebin/L65rpi0b","modified":1533771992,"id":"L65rpi0b","size":5542,"lines":158,"own_paste":false,"theme":"","date":1533771992}