package MooseX::AttributeHelpers::MethodProvider;

use strict;
use warnings;

our $VERSION   = '0.01';
our $AUTHORITY = 'cpan:STEVAN';

use Carp qw(confess);
use Exporter qw(import);
our @EXPORT = qw(get_provider_methods add_method_provider get_provider_type);

my %REGISTRY;

sub get_provider_type {
    my $name = shift;
    return $REGISTRY{$name}->{type} || confess "No provider named $name";
}

sub get_provider_methods {
    my ($name, $how) = @_;
    $how ||= q();

    my $methods = $REGISTRY{$name}->{provides}
        || confess "No provider named $name";

    if ($how eq ':all') {
        return $methods;
    }

    if (ref $how eq 'ARRAY') {
        return { 
            map { 
                $_ => $methods->{$_} || confess "No factory named $_" 
            } (@$how) 
        };
    }

    if (ref $how eq 'HASH') {
        return { 
            map { 
                my ($old, $new) = ($_, $how->{$_});
                $new => $methods->{$old} || confess "No factory named $old"
            } (keys %$how)
        };
    }

    confess "Don't know to get provider methods by $how";
}

sub add_method_provider ($;%) {
    my ($name, %options) = @_;

    confess "Already a method provider named $name" 
        if exists $REGISTRY{$name};

    my $method_map = $options{provides} or confess "No factories provided";

    my $consumes = $options{consumes};
    foreach my $provider (keys %$consumes) {
        my $methods = get_provider_methods($provider, $consumes->{$provider});
        foreach (keys %$methods) {
            confess "Method $_ already provided" if exists $method_map->{$_};
            $method_map->{$_} = $methods->{$_};
        };
    }

    $REGISTRY{$name} = {
        type     => $options{type} || 'Any',
        provides => $method_map,
    };
}

1;

__END__

=pod

=head1 NAME

MooseX::AttributeHelpers::MethodProvider

=head1 SYNOPSIS

    package MooseX::AttributeHelpers::MethodProvider::Counter;
    use MooseX::AttributeHelpers::MethodProvider;
    
    add_method_provider 'Counter' => (
        type => 'Int',
        provides => {
            reset => sub {
                my ($attr, $reader, $writer) = @_;
                return sub { $writer->($_[0], $attr->default($_[0])) };
            },
    
            inc => sub {
                my ($attr, $reader, $writer) = @_;
                return sub { $writer->($_[0], $reader->($_[0]) + 1) };
            },
    
            dec => sub {
                my ($attr, $reader, $writer) = @_;
                return sub { $writer->($_[0], $reader->($_[0]) - 1) };
            },
        },
    );
    
    1;
    
=head1 DESCRIPTION

MethodProvider is the interface for new functionality to be added to
L<MooseX::AttributeHelpers>.  The provided metaclasses get their method
factories from the repository defined by this package.  Composite's methods
are also drawn from here.  The package by itself provides no methods, but
rather functions for creating new entries in the repository - clients are
encouraged to define new method providers in individual modules (such as
L<MooseX::AttributeHelpers::MethodProvider::String>) and L<use|perlfunc/use>
them as desired.

=head1 METHOD SPECIFICATIONS

In add_method_provider as well as get_provider_methods, you can specify a set
of providers to extract.  This can be one of the following:

=over 4

=item ':all'

Causes all methods to be extracted.

=item ArrayRef

Causes the methods named in the ArrayRef to be extracted.

=item HashRef

Causes the methods named by the keys of the hashref to be extracted with the
names specified by their corresponding value, e.g. C<{inc =&gt; 'my_inc'}>

=back

=head1 EXPORTED FUNCTIONS

=over 4

=item add_method_provider

This is how to define a new method provider.  It takes one positional argument
(the name of the MethodProvider) and three keyword arguments:

=over 4

=item type

A Moose type (such as Maybe[Str]).  Validation will be done when applying to
an attribute to make sure it is this type or a subtype.

=item consumes 

A hashref of other method providers (which must be defined, so 
L<use|perlfunc/use> the modules that define them first), of the form 
C<{ProviderName =&gt; Specification}>.  

=item provides

A hashref of method names to provide to subrefs.  The subs take three
arguments (an attribute, the attribute's reader, and the attribute's writer)
and return a new sub that does some action to the attribute.

=back

=item get_provider_methods I<provide_name, specification>

Returns the methods for $provider_name as indicated by $specification.

=item get_provider_type

Returns the type of a method provider.

=back

=head1 BUGS

All complex software has bugs lurking in it, and this module is no
exception. If you find a bug please either email me, or add the bug
to cpan-RT.

=head1 AUTHOR

Paul Driver E<lt>frodwith@cpan.orgE<gt>

=cut
