#!/usr/bin/perl

package Perl6::Declare::Meta::Code;
use Moose;
use Sub::Name;

with 'MooseX::Role::TraitConstructor';

use Scalar::Util qw(refaddr);

has body => (
    isa => "CodeRef",
    is  => "rw",
    predicate => "has_body",
    required => 0,
);

sub set_body {
    my ( $self, $body ) = @_;
    $self->body($body);
}

has db_sig => (
    isa => "Data::Bind::SigCollection",
    is  => "ro",
    required => 1,
);

has p6_sig => (
    isa => "Perl6::Signature::Val::Sig",
    is  => "ro",
    required => 1,
    handles => qr/.*/,
);

sub constructor_extract_trait_param {
    my ( $class, $params ) = @_;

    my %traits = %{ $class->MooseX::Role::TraitConstructor::constructor_extract_trait_param($params) || {} };

    @{ $params }{map { "trait_$_" } keys %traits} = values %traits;

    return [ keys %traits ];
};

sub process_trait_name {
    my ( $class, $trait, $params, $root ) = @_;

    return join "::", "Perl6::Declare::Meta::Trait", $trait;
}

sub install {
    my ( $self, %args ) = @_;

    my $name = $args{name};
    no strict 'refs';
    subname $name, $self->body;
    *{$name} = $self->body;
}

use constant prelude_parts => qw(prelude_binding);

sub compile_prelude {
    my $self = shift;
    return join "", map { $self->$_ } $self->prelude_parts;
}

sub prelude_binding {
    my $self = shift;

    my $db_sig = $self->db_sig;

    my @var_names = $db_sig->all_variable_names or return;

    return join( "; ",
        $self->prelude_declare_vars(@var_names),
        $self->prelude_bind($db_sig)
    );

    return;
}

sub prelude_declare_vars {
    my ( $self, @var_names ) = @_;
    return 'my (' . join( ',', @var_names ) . ")";
}

sub prelude_locate_sig {
    my ($self, $sig_id) = @_;
    return "\$Perl6::Declare::signatures{$sig_id}"; 
}

sub prelude_prepare_binding {
    my ( $self, $sig_exp, $arg_exp ) = @_;

    $arg_exp ||= '@_';

    return "$sig_exp->prepare_binding(Perl6::Declare::rephormalize($arg_exp))";
}

sub prelude_do_binding {
    my ( $self, $sig_exp, $binding_exp ) = @_;
    return "$sig_exp->finalize_binding($binding_exp)";
}

use constant prelude_binding_parts => qw(prelude_locate_sig prelude_prepare_binding prelude_do_binding);

sub prelude_bind {
    my ( $self, $sig ) = @_;

    my $sig_id = refaddr $sig;

    # FIXME find a way to make this a closure variable
    $Perl6::Declare::signatures{$sig_id} = $sig;

    return join ( " ",
        "{",
        join( "; ",
            'my $__p6d_sig = ' . $self->prelude_locate_sig($sig_id),
            'my $__p6d_binding = ' . $self->prelude_prepare_binding('$__p6d_sig'),
            $self->prelude_do_binding('$__p6d_sig', '$__p6d_binding'),
        ),
        "}",
    );

}
__PACKAGE__

__END__

=pod

=head1 NAME

Perl6::Declare::Code - Base class for method and sub meta objects

=head1 SYNOPSIS

	use Perl6::Declare::Code;

=head1 DESCRIPTION

=cut


