RaCoCo result: Red::Attr::Relationship

# Red::Attr::Relationship 87.5%

    use Red::AST::Infixes;
    use Red::AST::Value;
    use Red::HiddenFromSQLCommenting;
    use X::Red::Exceptions;
    use Red::Model;

    unit role Red::Attr::Relationship[
    	&rel1,
    	&rel2?,
    	Str         :$model,
    	Str         :$require = $model,
    	Bool        :$optional,
    	Bool        :$no-prefetch,
    	Bool        :$has-one,
        Red::Model  :$model-type,
    ];

    has Mu:U $!type;

    has Bool $.has-lazy-relationship = ?$model;

    has Mu:U $!relationship-model;

    has Bool $!loaded-model = False;

    has Bool $!optional = $optional;

    has Bool $.has-one = $has-one;

    has Bool $.no-prefetch = $!has-one // $no-prefetch;

    has Str $.rel-name is rw;

    has $!model-type = $model-type;

    submethod TWEAK(|) {
        if $!model-type !=== Red::Model {
            $!has-lazy-relationship = True;
            $!relationship-model   := $!model-type;
            $!loaded-model          = True
        }
    }

    method transfer(Mu:U $package) {
        my $attr = Attribute.new: :$package, :$.name, :$.type;
        $attr but Red::Attr::Relationship[&rel1, &rel2, :$model, :$require]
    }

    method rel {
        my $*RED-INTERNAL = True;
        rel1 self.has-one ?? $!relationship-model !! self.package
    }

    method relationship-model(--> Mu:U) is hidden-from-sql-commenting {
        return self.type if !$model.DEFINITE && !$!loaded-model;
        unless $!loaded-model {
            my $t = ::($model);
            if !$t && $t ~~ Failure {
                require ::($require);
                $t = ::($model);
            }
            $!relationship-model := $t;
            $!loaded-model = True;
        }
        $!relationship-model
    }

    method set-data(\instance, Mu $value) is hidden-from-sql-commenting {
        do given $.rel {
            my $attr = .attr;
            my $ref  = .ref;
            $attr.set_value: instance, $ref.attr.get_value: $value;
            instance.^set-dirty: $attr;
        }
    }

    method build-relationship(\instance) is hidden-from-sql-commenting {
        my \type = self.type;
        my \attr = self;
        my \rel-model = $model ?? self.relationship-model !! type ~~ Positional ?? type.of !! type;
        use nqp;
        nqp::bindattr(nqp::decont(instance), $.package, $.name, Proxy.new:
            FETCH => method () {
                my $*RED-INTERNAL = True;
                my \ret = do if type ~~ Positional || attr.has-one {
                    rel-model.^rs.where: rel1(rel-model).map(-> $rel {
                        X::Red::RelationshipNotColumn.new(:relationship(attr), :points-to($rel)).throw unless $rel ~~ Red::Column;
                        my $ref = $rel.ref;
                        X::Red::RelationshipNotRelated.new(:relationship(attr), :points-to($rel)).throw unless $ref.DEFINITE;
                        my $val = do given $ref.attr but role :: {
                            method package {
                                instance.WHAT
                            }
                        } {
                            instance.^get-attr: .name.substr: 2
                        }
                        my \value = ast-value $val;
                        Red::AST::Eq.new: $rel, value, :bind-right
                    }).reduce: -> $left, $right {
                        Red::AST::AND.new: $left, $right
                    }
                } else {
                    my @models = rel1(instance.WHAT).map(-> $rel {
                        my $val = $rel.attr.get_value: instance;
                        do with $val {
                            my \value = ast-value $val;
                            Red::AST::Eq.new: $rel.ref, value, :bind-right
                        }
                    }).grep(*.defined);
                    return rel-model unless @models;
                    rel-model.^rs.where(@models.reduce(-> $left, $right {
                        Red::AST::AND.new: $left, $right
                    }))
                }
    	    return ret.head if type !~~ Positional || attr.has-one;
    	    ret
            },
            STORE => method ($value where type) {
                my $*RED-INTERNAL = True;
                die X::Assignment::RO.new(value => attr.type) unless attr.rw;
                if type !~~ Positional {
                    attr.set-data: instance, $value
                } else {
                    die "NYI Couldnt set value"
                }
            }
        );
        return
    }

    method relationship-argument-type {
        do if self.type ~~ Positional || self.has-one {
            $model ?? self.relationship-model !! self.type ~~ Positional ?? self.type.of !! self.type
        } else {
            self.package
        }
    }

    method relationship-ast($type = Nil) is hidden-from-sql-commenting {
        my $*RED-INTERNAL = True;
        my \type = self.relationship-argument-type;
        my @col1 = |rel1 type;
        @col1.map({
            Red::AST::Eq.new: $_, .ref: $type
        }).reduce: -> $agg, $i {
            Red::AST::AND.new: $agg, $i
        }
    }

    method join-type {
        my $*RED-INTERNAL = True;
        with $!optional {
            return $!optional
                    ?? :left
                    !! :inner
        }
        do given rel1 self.relationship-argument-type {
            when .?nullable {
                :left
            }
            default {
                :inner
            }
        }
    }