From: Jason May <jason.a.may@gmail.com>
Date: Sat, 21 Jun 2008 18:02:13 +0000 (+0000)
Subject: allow method => $coderef for a curries parameter
X-Git-Tag: 0.16~50
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=696d4dc77bc66c66248295f3a00e5f7b017a2686;p=gitmo%2FMooseX-AttributeHelpers.git

allow method => $coderef for a curries parameter
---

diff --git a/lib/MooseX/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm
index 7815223..4dad2af 100644
--- a/lib/MooseX/AttributeHelpers.pm
+++ b/lib/MooseX/AttributeHelpers.pm
@@ -49,6 +49,7 @@ MooseX::AttributeHelpers - Extend your attribute interfaces
       }
   );
 
+
   # ...
 
   my $obj = MyClass->new;
@@ -57,6 +58,7 @@ MooseX::AttributeHelpers - Extend your attribute interfaces
   $obj->set_mapping(5, 'bar'); # 5 => 'bar'
   $obj->set_mapping(6, 'baz'); # 6 => 'baz'
 
+
   # prints 'bar'
   print $obj->get_mapping(5) if $obj->exists_in_mapping(5);
 
@@ -83,8 +85,30 @@ the object itself and do what you want.
 =head2 curries
 
 This points to a hashref that uses C<provider> for the keys and
-C<< {method => [ @args ]} >> for the values.  The method will be added to
-the object itself (always using C<@args> as the beginning arguments).
+has two choices for the value:
+
+You can supply C<< {method => [ @args ]} >> for the values.  The method will be
+added to the object itself (always using C<@args> as the beginning arguments).
+
+Another approach to curry a method provider is to supply a coderef instead of an
+arrayref. The code ref takes C<$self>, C<$body>, and any additional arguments
+passed to the final method.
+
+  # ...
+
+  curries => {
+      grep => {
+          times_with_day => sub {
+              my ($self, $body, $datetime) = @_;
+              $body->($self, sub { $_->ymd eq $datetime->ymd });
+          }
+      }
+  }
+
+  # ...
+
+  $obj->times_with_day(DateTime->now); # takes datetime argument, checks day
+
 
 =head1 METHOD PROVIDERS
 
diff --git a/lib/MooseX/AttributeHelpers/Base.pm b/lib/MooseX/AttributeHelpers/Base.pm
index 8fd2d97..b274ee2 100644
--- a/lib/MooseX/AttributeHelpers/Base.pm
+++ b/lib/MooseX/AttributeHelpers/Base.pm
@@ -108,6 +108,16 @@ sub _curry {
     return sub { my $self = shift; $code->($self, @args, @_) };
 }
 
+sub _curry_sub {
+    my $self = shift;
+    my $body = shift;
+    my $code = shift;
+
+    warn "installing sub!";
+
+    return sub { my $self = shift; $code->($self, $body, @_) };
+}
+
 after 'install_accessors' => sub {
     my $attr  = shift;
     my $class = $attr->associated_class;
@@ -130,44 +140,36 @@ after 'install_accessors' => sub {
 
     while (my ($constructor, $constructed) = each %{$attr->curries}) {
         my $method_code;
-        if (ref $constructed eq 'HASH') {
-            while (my ($curried_name, $curried_args) = each(%$constructed)) {
-#                warn "CURRIED_NAME: $curried_name";
-                if ($class->has_method($curried_name)) {
-                    confess
-                        "The method ($curried_name) already ".
-                        "exists in class (" . $class->name . ")";
-                }
-                $method_code = $attr->_curry(
-                    $method_constructors->{$constructor}->(
-                        $attr,
-                        $attr_reader,
-                        $attr_writer,
-                    ), @$curried_args,
-                ),
-                my $method = MooseX::AttributeHelpers::Meta::Method::Curried->wrap(
-                    $method_code,
-                    package_name => $class_name,
-                    name => $curried_name,
-                );
-                
-                $attr->associate_method($method);
-                $class->add_method($curried_name => $method);
+        while (my ($curried_name, $curried_arg) = each(%$constructed)) {
+            if ($class->has_method($curried_name)) {
+                confess
+                    "The method ($curried_name) already ".
+                    "exists in class (" . $class->name . ")";
             }
-        }
-        elsif (ref $constructed eq 'CODE') {
-#            my $method = MooseX::AttributeHelpers::Meta::Method::Curried->wrap(
-#                $attr->_curry($method_constructors->{$key}->(
-#                    $attr,
-#                    $attr_reader,
-#                    $attr_writer,
-#                ), @curried_args),
-#                package_name => $class_name,
-#                name => $curried_name,
-#            );
-        }
-        else {
-            confess "curries parameter must be ref type HASH or CODE";
+            my $body = $method_constructors->{$constructor}->(
+                       $attr,
+                       $attr_reader,
+                       $attr_writer,
+            );
+
+            if (ref $curried_arg eq 'ARRAY') {
+                $method_code = $attr->_curry($body, @$curried_arg);
+            }
+            elsif (ref $curried_arg eq 'CODE') {
+                $method_code = $attr->_curry_sub($body, $curried_arg);
+            }
+            else {
+                confess "curries parameter must be ref type HASH or CODE";
+            }
+
+            my $method = MooseX::AttributeHelpers::Meta::Method::Curried->wrap(
+                $method_code,
+                package_name => $class_name,
+                name => $curried_name,
+            );
+                
+            $attr->associate_method($method);
+            $class->add_method($curried_name => $method);
         }
     }
 
diff --git a/t/005_basic_list.t b/t/005_basic_list.t
index c1754b0..8d16e9a 100644
--- a/t/005_basic_list.t
+++ b/t/005_basic_list.t
@@ -3,8 +3,10 @@
 use strict;
 use warnings;
 
-use Test::More tests => 24;
+use Test::More tests => 25;
 use Test::Exception;
+use DateTime;
+use DateTime::Format::Strptime;
 
 BEGIN {
     use_ok('MooseX::AttributeHelpers');   
@@ -35,6 +37,20 @@ BEGIN {
             'join'     => {dashify        => [ '-' ]}
         }
     );
+
+    has datetimes => (
+        metaclass => 'Collection::List',
+        is => 'rw',
+        isa => 'ArrayRef[DateTime]',
+        curries => {
+            grep => {
+                times_with_day => sub {
+                    my ($self, $body, $datetime) = @_;
+                    $body->($self, sub { $_->ymd eq $datetime->ymd });
+                },
+            },
+        },
+    );
 }
 
 my $stuff = Stuff->new(options => [ 1 .. 10 ]);
@@ -81,6 +97,17 @@ is_deeply([ $stuff->up_by_one() ], [2 .. 11]);
 
 is($stuff->dashify, '1-2-3-4-5-6-7-8-9-10');
 
+$stuff->datetimes([
+    DateTime->now->subtract(days => 1),
+    DateTime->now->subtract(days => 1),
+    DateTime->now,
+    DateTime->now,
+]);
+
+my $my_time = DateTime->now;
+
+is($stuff->times_with_day($my_time), 2, 'check for currying with a coderef');
+
 ## test the meta
 
 my $options = $stuff->meta->get_attribute('_options');