RaCoCo result: Red::Column

# Red::Column 88.2%

    use Red::Utils;
    use Red::Model;
    use Red::AST;
    use Red::AST::Unary;
    use Red::AST::IsDefined;
    use Red::Formatter;

    =head2 Red::Column

    #| Represents a database column
    unit class Red::Column does Red::AST;
    also does Red::Formatter;

    sub inflator($attr) {
        do with $attr.type.?inflator {
            $_
        } else {
            do if $attr.type ~~ Enumeration {
                -> $value, $type { $type.($value) }
            } else {
                -> $_ { .?"{ $attr.type.^name }"() // .self }
            }
        }
    }
    sub deflator($_) {
        do with .type.?deflator {
            $_
        } else {
            do if .type ~~ Enumeration {
                *.value
            } else {
                *.self
            }
        }
    }

    has Attribute   $.attr is required;
    has             $.model            = $!attr.package;
    has Str         $.attr-name        = $!attr.name.substr: 2;
    has Bool        $.id               = False;
    has Bool        $.auto-increment   = False;
    has             &.references;
    has             &!actual-references;
    has             $!ref;
    has Bool        $.nullable         = $!attr.package.HOW.?default-nullable($!attr.package) // False;
    has Str         $.name             = ::?CLASS.column-formatter: self.attr.name.substr: 2;
    has Str         $.name-alias       = $!name;
    has Str         $.type;
    has             &.inflate          = $!attr.&inflator;
    has             &.deflate          = $!attr.&deflator;
    has             $.computation;
    has Str         $.model-name;
    has Red::Model  $.model-type;
    has Str         $.column-name;
    has Str         $.require          = $!model-name;
    has Mu          $.class            = $!attr.package;
    has             @.unique-groups;

    #multi method WHICH(::?CLASS:D:) {
    #    ValueObjAt.new: self.^name ~ "|" ~ self.migration-hash.pairs.sort.map(-> (:$key, :$value) {
    #        "$key|$value"
    #    }).join: "|"
    #}

    multi method WHICH(::?CLASS:D:) {
        ValueObjAt.new: self.gist
    }

    multi method perl(::?CLASS:D:) {
        "{ self.^name }.new({
            self.Hash.pairs.sort.map(-> (:$key, :$value) {
                next if $key eq <inflate deflate>.one;
                "$key.Str() => $value.perl()"
            }).join: ", "
        })"
    }

    method Hash(--> Hash()) {
        %(
            |(:attr($_)                 with $!attr             ),
            |(:attr-name($_)            with $!attr-name        ),
            |(:id($_)                   with $!id               ),
            |(:auto-increment($_)       with $!auto-increment   ),
            |(:references($_)           with &!references       ),
            |(:actual-references($_)    with &!actual-references),
            |(:ref($_)                  with $!ref              ),
            |(:nullable($_)             with $!nullable         ),
            |(:name($_)                 with $!name             ),
            |(:name-alias($_)           with $!name-alias       ),
            |(:type($_)                 with $!type             ),
            |(:inflate($_)              with &!inflate          ),
            |(:deflate($_)              with &!deflate          ),
            |(:computation($_)          with $!computation      ),
            |(:model-name($_)           with $!model-name       ),
            |(:column-name($_)          with $!column-name      ),
            |(:require($_)              with $!require          ),
        )
    }

    #| Returns a Hash that represents the column for migration purposes
    method migration-hash(--> Hash()) {
        |(:name($_)                                 with $!name             ),
        |(:type(.type.^name)                        with $!attr             ),
        |(:references-table(.attr.package.^table)   with $.ref              ),
        |(:references-column(.column-name)          with $.ref              ),
        |(:is-id($_)                                with $!id               ),
        |(:is-auto-increment($_)                    with $!auto-increment   ),
        |(:is-nullable($_)                          with $!nullable         ),
    }

    #| Subclass used to lazy evaluation of parameter types
    class ReferencesProxy does Callable {
        has Str     $.model-name    is required;
        has Str     $.column-name;
        has Str     $.require       = $!model-name;
        has         $.model;
        has         &.references;
        has Bool    $!tried-model   = False;

        method model($alias = Nil --> Mu:U) {
            if !$!tried-model {
                my $model = ::($!model-name);
                if !$model && $model ~~ Failure {
                    require ::($!require);
                    $model = ::($!model-name);
                }
                $!model = $model;
                $!tried-model = True;
            }
            do if $alias !=== Nil {
                do if $alias.^table eq $!model.^table {
                    $alias
                } else {
                    die "$alias.^name() isn't an alias for the table $!model.^table()"
                }
            } else {
                $!model
            }
        }

        method CALL-ME($alias = Nil) {
            my $*RED-INTERNAL = True;
            if &!references {
                my $model = self.model($alias);
                my $ret = &!references.($model);
                if $ret ~~ Red::Column && $ret.class.^name eq '$?CLASS' {
                    $ret .= clone: :class($model)
                }
                $ret
            }
            else {
                self.model($alias).^columns.first(*.column.attr-name eq $!column-name).column
            }
        }
    }

    #| Returns the class that column is part of.
    #method class { self.attr.package }

    #| Method that returns the comment for the column
    method comment { .Str with self.attr.WHY }

    #| Returns a function that will return a column that is referenced by this column
    method references(--> Callable) is rw {
        &!actual-references //= do {
            if &!references {
                if $!model-name {
                    ReferencesProxy.new(:&!references, :$!model-name, :$!require, :$!model-type);
                }
                else {
                    &!references;
                }
            }
            elsif $!model-name && $!column-name {
                ReferencesProxy.new(:$!model-name, :$!column-name, :$!require, :$!model-type);
            }
            else {
                Callable
            }
        }
    }

    #| Returns the column that is referenced by this one.
    method ref($model = $!model-type !=== Red::Model ?? $!model-type !! Nil) {
        my $*RED-INTERNAL = True;
        .($model) with self.references
    }

    #| Required by the Red::AST role
    method returns { $!attr.type }

    method transpose(&func) { func self }

    method gist { "{$!attr.package.HOW.^can("as") ?? $!attr.package.^as !! "({ $!attr.package.^name })"}.{$!name-alias}" }

    method cast(Str $type) {
        Red::AST::Cast.new: self, $type
    }

    method find-column-name {
        $!attr-name
    }

    #| Returns an alias of that column
    method alias(Str $name) {
        self.clone: name-alias => $name
    }

    #| Returns a clone using a different name
    method as(Str $name, :$nullable = True) {
        self.clone: attr-name => $name, :$name, id => False, :$nullable, attr => Attribute
    }

    submethod TWEAK(:$unique) {
        with $unique {
            when Bool {
                $!attr.package.^add-unique-constraint: { self }
            }
            when Positional {
                self.unique-groups.append: |$unique
            }
            default {
                self.unique-groups.push: $unique
            }
        }
    }

    #| Do not test definedness, but returns a new Red::AST::IsDefined.
    #| It's used to test `IS NULL` on the given column. It's also used
    #| by any construction that naturally uses `.defined`.

    method defined {
        Red::AST::IsDefined.new: self
    }

    method args {}

    method not { Red::AST::Not.new: self }