
use v6;
module Perl::MetaProperty-0.0.1;

use Hack::Instances; 

sub Perl::MetaProperty::new(Str $type, Any +$default, Str +$visibility) returns Str is export {
    my $id = make_instance("Perl::MetaProperty", { 
        'type'       => $type,
        'default'    => undef,
        'visibility' => 'public',
        'class'      => undef,
    });
    $id.propDefault($default)       if $default.defined;
    $id.propVisibility($visibility) if $visibility.defined;    
    return $id;
}

sub propType(Str $inv: Str ?$type) returns Str {
    my %self := get_instance($inv, "Perl::MetaProperty");
    if $type.defined {
        # NOTE:
        # if the type is changed, then the default value
        # is invalidated since it the default and type
        # may not match anymore. Not doing this would
        # destabilize the model
        if %self<type> ne $type {
            %self<default> = undef;
        }
        %self<type> = $type;         
    }
    return %self<type>;
}

sub propDefault(Str $inv: Any ?$default) returns Any {
    my %self := get_instance($inv, "Perl::MetaProperty");
    if $default.defined {
        # NOTE:
        # we check regular .isa() to account for 
        # builtin types, and we check our Hack::Instance
        # .instance_isa() and .clsName() as well. 
        # XXX - We should also have something which can 
        # climb the class isa() tree as well.
        my $prop_type = $inv.propType();
        die "Incorrect Type value for property default (got: '{ $default } -> { ref($default) }', expected: '$prop_type')"
            unless $default.isa($prop_type) || 
                        ($default.instance_isa('Perl::MetaClass') && $default.clsName() eq $prop_type);
        %self<default> = $default;
    }
    return %self<default>;
}

sub propVisibility(Str $inv: Str ?$visibility) returns Str {
    my %self := get_instance($inv, "Perl::MetaProperty");
    if $visibility.defined {
        ($visibility ~~ rx:perl5:i/(private|public)/)
            || die "Visibility must be either 'private' or 'public' (got: '$visibility')";
        %self<visibility> = lc($visibility);
    }
    return %self<visibility>;
}

sub propClassAssociatedWith(Str $inv: Str ?$class) returns Str {
    my %self := get_instance($inv, "Perl::MetaProperty");
    if $class.defined {
        ($class.instance_isa('Perl::MetaClass'))
            || die "The class argument must be a Perl::MetaClass instance";
        (!%self<class>)
            || die "This property has already be associated with a class";            
        %self<class> = $class;
    }
    return %self<class>;
}

=pod

=head1 NAME

Perl::MetaProperty - A meta-model for Perl Classes

=head1 SYNOPSIS

  use Perl::MetaProperty;

=head1 DESCRIPTION

=head1 FUNCTIONS

=over 4

=item B<Perl::MetaProperty::new(Str $type, Any ?$default)>

=item B<propType($inv: ?$type)>

=item B<propDefault($inv: ?$default)>

=item B<propVisibility($inv: ?$visibility)>

=back

=head1 AUTHORS

Sam Vilain

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=cut

