lib/Moose/Autobox/Array.pm

   1 package Moose::Autobox::Array;
   2 use Moose::Role 'with';
   3 use Perl6::Junction;
   4 use autobox;
   5
   6 our $VERSION = '0.01';
   7
   8 with 'Moose::Autobox::Ref',
   9      'Moose::Autobox::List',
  10      'Moose::Autobox::Indexed';
  11
  12 ## Array Interface
  13
  14 sub pop {
  15     my ($array) = @_;
  16     CORE::pop @$array;
  17 }
  18
  19 sub push {
  20     my ($array, @rest) = @_;
  21     CORE::push @$array, @rest;
  22     $array;
  23 }
  24
  25 sub unshift {
  26     my ($array, @rest) = @_;
  27     CORE::unshift @$array, @rest;
  28     $array;
  29 }
  30
  31 sub delete {
  32     my ($array, $index) = @_;
  33     CORE::delete $array->[$index];
  34 }
  35
  36 sub shift {
  37     my ($array) = @_;
  38     CORE::shift @$array;
  39 }
  40
  41 # NOTE:
  42 # sprintf args need to be reversed,
  43 # because the invocant is the array
  44 sub sprintf { CORE::sprintf $_[1], @{$_[0]} }
  45
  46 ## ::List interface implementation
  47
  48 sub head { $_[0]->[0] }
  49 sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
  50
  51 sub length {
  52     my ($array) = @_;
  53     CORE::scalar @$array;
  54 }
  55
  56 sub grep {
  57     my ($array, $sub) = @_;
  58     [ CORE::grep { $sub->($_) } @$array ];
  59 }
  60
  61 sub map {
  62     my ($array, $sub) = @_;
  63     [ CORE::map { $sub->($_) } @$array ];
  64 }
  65
  66 sub join {
  67     my ($array, $sep) = @_;
  68     $sep ||= '';
  69     CORE::join $sep, @$array;
  70 }
  71
  72 sub reverse {
  73     my ($array) = @_;
  74     [ CORE::reverse @$array ];
  75 }
  76
  77 sub sort {
  78     my ($array, $sub) = @_;
  79     $sub ||= sub { $a cmp $b };
  80     [ CORE::sort { $sub->($a, $b) } @$array ];
  81 }
  82
  83 ## ::Indexed implementation
  84
  85 sub at {
  86     my ($array, $index) = @_;
  87     $array->[$index];
  88 }
  89
  90 sub put {
  91     my ($array, $index, $value) = @_;
  92     $array->[$index] = $value;
  93 }
  94
  95 sub exists {
  96     my ($array, $index) = @_;
  97     CORE::exists $array->[$index];
  98 }
  99
 100 sub keys {
 101     my ($array) = @_;
 102     [ 0 .. $#{$array} ];
 103 }
 104
 105 sub values {
 106     my ($array) = @_;
 107     [ @$array ];
 108 }
 109
 110 sub kv {
 111     my ($array) = @_;
 112     $array->keys->map(sub { [ $_, $array->[$_] ] });
 113 }
 114
 115 ## Junctions
 116
 117 sub all {
 118     my ($array) = @_;
 119     return Perl6::Junction::All->all(@$array);
 120 }
 121
 122 sub any {
 123     my ($array) = @_;
 124     return Perl6::Junction::Any->any(@$array);
 125 }
 126
 127 sub none {
 128     my ($array) = @_;
 129     return Perl6::Junction::None->none(@$array);
 130 }
 131
 132 sub one {
 133     my ($array) = @_;
 134     return Perl6::Junction::One->one(@$array);
 135 }
 136
 137 1;
 138
 139 __END__
 140
 141 =pod
 142
 143 =head1 NAME
 144
 145 Moose::Autobox::Array - the Array role
 146
 147 =head1 SYNOPOSIS
 148
 149   use Moose::Autobox;
 150   use autobox;
 151
 152   [ 1..5 ]->isa('ARRAY'); # true
 153   [ a..z ]->does('Moose::Autobox::Array'); # true
 154   [ 0..2 ]->does('Moose::Autobox::List'); # true
 155
 156   print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', ');
 157
 158   print [ 1, 'number' ]->sprintf('%d is the loneliest %s');
 159
 160 =head1 DESCRIPTION
 161
 162 This is a role to describe operations on the Array type.
 163
 164 =head1 METHODS
 165
 166 =over 4
 167
 168 =item B<pop>
 169
 170 =item B<push ($value)>
 171
 172 =item B<shift>
 173
 174 =item B<unshift ($value)>
 175
 176 =item B<delete ($index)>
 177
 178 =item B<sprintf ($format_string)>
 179
 180 =back
 181
 182 =head2 Indexed implementation
 183
 184 =over 4
 185
 186 =item B<at ($index)>
 187
 188 =item B<put ($index, $value)>
 189
 190 =item B<exists ($index)>
 191
 192 =item B<keys>
 193
 194 =item B<values>
 195
 196 =item B<kv>
 197
 198 =back
 199
 200 =head2 List implementation
 201
 202 =over 4
 203
 204 =item B<head>
 205
 206 =item B<tail>
 207
 208 =item B<join (?$seperator)>
 209
 210 =item B<length>
 211
 212 =item B<map (\&block)>
 213
 214 =item B<grep (\&block)>
 215
 216 =item B<reverse>
 217
 218 =item B<sort (?\&block)>
 219
 220 =back
 221
 222 =head2 Junctions
 223
 224 =over 4
 225
 226 =item B<all>
 227
 228 =item B<any>
 229
 230 =item B<none>
 231
 232 =item B<one>
 233
 234 =back
 235
 236 =over 4
 237
 238 =item B<meta>
 239
 240 =back
 241
 242 =head1 BUGS
 243
 244 All complex software has bugs lurking in it, and this module is no
 245 exception. If you find a bug please either email me, or add the bug
 246 to cpan-RT.
 247
 248 =head1 AUTHOR
 249
 250 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 251
 252 =head1 COPYRIGHT AND LICENSE
 253
 254 Copyright 2006 by Infinity Interactive, Inc.
 255
 256 L<http://www.iinteractive.com>
 257
 258 This library is free software; you can redistribute it and/or modify
 259 it under the same terms as Perl itself.
 260
 261 =cut