Implemented List::sort and Array::sort_in_place. Added basic tests and pod.

diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm
index 6d314ff..fb228f6 100644 (file)
--- a/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm
+++ b/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm
@@ -136,6 +136,18 @@ sub splice : method {
     }    
 }
 
+sub sort_in_place : method {
+   my ($attr, $reader, $writer) = @_;
+   return sub {
+      my ($instance, $predicate) = @_;
+      die "Argument must be a code reference" 
+         unless ref $predicate eq "CODE";
+      my @sorted = 
+         CORE::sort { $predicate->($a, $b) } @{$reader->($instance)};
+      $writer->($instance, \@sorted); 
+   }
+}
+
 1;
 
 __END__
@@ -186,6 +198,11 @@ see those provied methods, refer to that documentation.
 
 =item B<splice>
 
+=item B<sort_in_place>
+Sorts the array using the comparison subroutine given as argument.
+Instead of returning the sorted list, it modifies the order of the
+items in the ArrayRef attribute.
+
 =back
 
 =head1 BUGS

diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/List.pm b/lib/MooseX/AttributeHelpers/MethodProvider/List.pm
index 95648cc..5fa24fe 100644 (file)
--- a/lib/MooseX/AttributeHelpers/MethodProvider/List.pm
+++ b/lib/MooseX/AttributeHelpers/MethodProvider/List.pm
@@ -38,6 +38,16 @@ sub map : method {
     };
 }
 
+sub sort : method {
+    my ($attr, $reader, $writer) = @_;
+    return sub {
+        my ($instance, $predicate) = @_;
+        die "Argument must be a code reference" 
+            unless ref $predicate eq "CODE";
+        CORE::sort { $predicate->($a, $b) } @{$reader->($instance)};
+    };
+}
+
 sub grep : method {
     my ($attr, $reader, $writer) = @_;
     return sub {
@@ -93,7 +103,7 @@ __END__
 
 MooseX::AttributeHelpers::MethodProvider::List
 
-=SYNOPSIS
+=head1 SYNOPSIS
     
    package Stuff;
    use Moose;
@@ -115,6 +125,7 @@ MooseX::AttributeHelpers::MethodProvider::List
          join  => 'join_options',
          count => 'count_options',
          empty => 'do_i_have_options',
+         sort  => 'sort_options',
 
       }
    );
@@ -171,8 +182,19 @@ subroutine passed as argument.
 Executes the anonymous subroutine given as argument sequentially
 for each element of the list.
 
-my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } );
-print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag"
+   my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } );
+   print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag"
+
+=item B<sort>
+Returns a sorted list of the elements, using the anonymous subroutine
+given as argument. 
+
+This subroutine should perform a comparison between the two arguments passed
+to it, and return a numeric list with the results of such comparison:
+
+   # Descending alphabetical order
+   my @sorted_options = $stuff->sort_options( sub { $_[1] cmp $_[0] } );
+   print "@sorted_options\n"; # prints "foo boo baz bar"
 
 =item B<elements>
 Returns an element of the list by its index.

diff --git a/t/002_basic_array.t b/t/002_basic_array.t
index 1153247..ad988e2 100644 (file)
--- a/t/002_basic_array.t
+++ b/t/002_basic_array.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 55;
+use Test::More tests => 60;
 use Test::Exception;
 
 BEGIN {
@@ -29,6 +29,7 @@ BEGIN {
             'count'   => 'num_options',
             'empty'   => 'has_options',        
             'clear'   => 'clear_options',        
+            'sort_in_place' => 'sort_in_place_options',
         },
         curries   => {
             'push'    => {
@@ -36,7 +37,9 @@ BEGIN {
             },
             'unshift'  => {
                 prepend_prerequisites_along_with => ['first', 'second']
-            }
+            },
+            'sort_in_place' => { ascending_options => [ sub { $_[0] <=> $_[1] } ],
+            },
         }
     );
 }
@@ -54,6 +57,7 @@ can_ok($stuff, $_) for qw[
     num_options
     clear_options
     has_options
+    sort_in_place_options
 ];
 
 is_deeply($stuff->options, [10, 12], '... got options');
@@ -120,6 +124,18 @@ is($stuff->get_option_at(0), 20, '... get option at index 0');
 $stuff->clear_options;
 is_deeply( $stuff->options, [], "... clear options" );
 
+$stuff->add_options(1..3);
+$stuff->sort_in_place_options( sub { $_[1] <=> $_[0] } );
+is_deeply( $stuff->options, [3, 2, 1], "... sort options in place" );
+
+lives_ok { 
+   $stuff->ascending_options();
+} '... add descending options okay';
+
+is_deeply( $stuff->options, [1, 2, 3], "... sort currying" );
+
+$stuff->clear_options;
+
 lives_ok {
     $stuff->add_options('tree');
 } '... set the options okay';
@@ -163,6 +179,11 @@ dies_ok {
     $stuff->set_option_at( 0, undef );
 } '... rejects set of an invalid type';
 
+dies_ok {
+    my $stuff = Stuff->new();
+    $stuff->sort_in_place_options( undef );
+} '... sort rejects arg of invalid type';
+
 ## test the meta
 
 my $options = $stuff->meta->get_attribute('options');
@@ -178,6 +199,7 @@ is_deeply($options->provides, {
     'count'   => 'num_options',
     'empty'   => 'has_options',    
     'clear'   => 'clear_options',    
+    'sort_in_place' => 'sort_in_place_options',
 }, '... got the right provies mapping');
 
 is($options->type_constraint->type_parameter, 'Str', '... got the right container type');

diff --git a/t/005_basic_list.t b/t/005_basic_list.t
index d4a49b7..e295fdf 100644 (file)
--- a/t/005_basic_list.t
+++ b/t/005_basic_list.t
@@ -7,7 +7,7 @@ use Test::More;
 use Test::Exception;
 
 BEGIN {
-    plan tests => 29;
+   plan tests => 33;
 }
 
 BEGIN {
@@ -35,11 +35,13 @@ BEGIN {
             'get'      => 'get_option_at',
             'first'    => 'get_first_option',
             'last'     => 'get_last_option',
+            'sort' => 'sort_options',
         },
         curries   => {
             'grep'     => {less_than_five => [ sub { $_ < 5 } ]},
             'map'      => {up_by_one      => [ sub { $_ + 1 } ]},
-            'join'     => {dashify        => [ '-' ]}
+            'join'     => {dashify        => [ '-' ]},
+            'sort'     => {ascending      => [ sub { $_[0] <=> $_[1] } ]},
         }
     );
 
@@ -72,6 +74,7 @@ can_ok($stuff, $_) for qw[
     options
     join_options
     get_option_at
+    sort_options
 ];
 
 is_deeply($stuff->_options, [1 .. 10], '... got options');
@@ -80,7 +83,7 @@ ok($stuff->has_options, '... we have options');
 is($stuff->num_options, 10, '... got 2 options');
 cmp_ok($stuff->get_option_at(0), '==', 1, '... get option 0');
 cmp_ok($stuff->get_first_option, '==', 1, '... get first');
-cmp_ok($stuff->get_last_option, '==', 10, '... get first');
+cmp_ok($stuff->get_last_option, '==', 10, '... get last');
 
 is_deeply(
 [ $stuff->filter_options(sub { $_[0] % 2 == 0 }) ],
@@ -100,6 +103,8 @@ is_deeply([ $stuff->options ], [1 .. 10], '... got the list of options');
 
 is($stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10', '... joined the list of options by :');
 
+is_deeply([ $stuff->sort_options( sub { $_[1] <=> $_[0] } ) ], [sort { $b <=> $a } (1..10)], '... got sorted options');
+
 # test the currying
 is_deeply([ $stuff->less_than_five() ], [1 .. 4]);
 
@@ -116,6 +121,8 @@ is_deeply(
         'returns all elements with double length of string "fish"'
 );
 
+is_deeply([$stuff->ascending], [1 .. 10]);
+
 ## test the meta
 
 my $options = $stuff->meta->get_attribute('_options');
@@ -131,7 +138,13 @@ is_deeply($options->provides, {
     'join'     => 'join_options',
     'get'      => 'get_option_at',
     'first'    => 'get_first_option',
-    'last'     => 'get_last_option'
+    'last'     => 'get_last_option',
+    'sort' => 'sort_options',
 }, '... got the right provies mapping');
 
 is($options->type_constraint->type_parameter, 'Int', '... got the right container type');
+
+dies_ok {
+    $stuff->sort_in_place_options( undef );
+} '... sort rejects arg of invalid type';
+