
package T2::Perl6;

use T2::Schema;
use Perl6::MetaModel;

use base qw(Class::Tangram);

our $VERSION = 0.01;

# an example of a Tangram schema structure
our $schema =
    { fields =>
      { ref =>
	{ schema => { class => "T2::Schema" }
	},
      },
      methods => { map { $_ => \&$_ }
		   qw( generate_p6mm generate_attribute )
		 },
    };

sub generate_p6mm {
    my $self = shift;

    my $schema = $self->schema;

    for my $class ( $schema->classes ) {

	class($class->name =>
	      { instance =>
		{ methods => { map { $_->name => $_->code }
			       $class->methods->members
			     },

		  # Perl 6 has no concept of associative attributes,
		  # so we represent them all as attributes
		  attrs => [ map { $self->generate_attribute($_) }
			     $class->attributes->members,
			     $class->associations->members,
			     # 2-way associations won't work without
			     # MM support (or proxy accessors)
			     # $self->rev_assocs->members,
			   ],
		},
	      });
    }
}

# ok, so Class::Tangram doesn't have a real type system :-P
# there are more types ... but this will do for now
our %types
    = ( int => "Int",
	real => "Num",
	string => "Str",
	flat_hash => "Hash",   # of Scalar
	flat_array => "Array", # ditto
	ref => "Object",   # for now
	set => "Set", iset => "Set",         # also for now
	hash => "Hash", ihash => "Hash",     #  └── "" ──┘
	array => "Array", iarray => "Array", #  └── "" ──┘
      );

our %sigils
    = ( (map { $_ => '%' } qw(flat_hash hash ihash)),
	(map { $_ => '@' } qw(flat_array array iarray)),
      );

sub generate_attribute {
    my $self = shift;
    my $attr = shift;

    # $attr may be a T2::Attribute or a T2::Association, but as they
    # both respond to ->type and ->name in the same way, we can use
    # them here.

    my $sigil = $sigils{$attr->type} || '$';

    my $name = $sigil.".".$attr->name;

    if ( my $perl6_type = $type_lookup{$attr->type} ) {
	return [ $name => { type => $perl6_type,
			    access => "rw",
			  } ];
    }
    else {
	return $name;
    }
}

1;
