#!/usr/bin/perl

package Perl6::Declare::Meta::Trait::cached;
use Moose::Role;

use Scalar::Util qw(refaddr);

use Hash::Util::FieldHash::Compat;

Hash::Util::FieldHash::Compat::idhashes \( our ( %metas, %caches ) );

our $last_binding;

sub BUILD {
    my $self = shift;
    $metas{$self} = $self;
}

sub cache {
    my $self = shift;
    $caches{$self} ||= {};
}

around prelude_do_binding => sub {
    my ( $next, $self, $sig_exp, $binding_exp ) = @_;

    my $id = refaddr($self);

    return (
        'my $meta_method = $' . __PACKAGE__ . "::metas{$id};",
        'my $cache_key = $meta_method->cache_key_for_binding('.$binding_exp.'); my $cache = $meta_method->cache;',
        'if ( exists $cache->{$cache_key} ) { return $cache->{$cache_key} } else { $'. __PACKAGE__ .'::last_binding = $cache_key }',
        $self->$next( $sig_exp, $binding_exp ),
    );
};
around set_body => sub {
    my $next = shift;
    my ( $self, $body ) = @_;

    $self->$next(sub {
        local $last_binding;
        my $rv = $body->(@_); # FIXME context
        if ( defined $last_binding ) {
            $self->cache->{$last_binding} = $rv;
        }
        return $rv;
    });
};

sub cache_key_for_binding {
    my ( $self, $binding ) = @_;

    my $key = join ",", map { $_ . "=" . overload::StrVal(${ $binding->{$_}[1] }) } sort keys %$binding;

    $key;
}
__PACKAGE__

__END__

=pod

=head1 NAME

Perl6::Declare::Meta::Trait::cached - 

=head1 SYNOPSIS

	use Perl6::Declare::Meta::Trait::cached;

=head1 DESCRIPTION

=cut


