lib/Moose/Autobox/Array.pm

   1 package Moose::Autobox::Array;
   2 use Moose::Role 'with';
   3 use Perl6::Junction;
   4 use Moose::Autobox;
   5
   6 our $VERSION = '0.10';
   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 sub slice {
  42     my ($array, $indicies) = @_;
  43     [ @{$array}[ @{$indicies} ] ];
  44 }
  45
  46 # NOTE:
  47 # sprintf args need to be reversed,
  48 # because the invocant is the array
  49 sub sprintf { CORE::sprintf $_[1], @{$_[0]} }
  50
  51 ## ::List interface implementation
  52
  53 sub head { $_[0]->[0] }
  54 sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
  55
  56 sub length {
  57     my ($array) = @_;
  58     CORE::scalar @$array;
  59 }
  60
  61 sub grep {
  62     my ($array, $sub) = @_;
  63     [ CORE::grep { $sub->($_) } @$array ];
  64 }
  65
  66 sub map {
  67     my ($array, $sub) = @_;
  68     [ CORE::map { $sub->($_) } @$array ];
  69 }
  70
  71 sub join {
  72     my ($array, $sep) = @_;
  73     $sep ||= '';
  74     CORE::join $sep, @$array;
  75 }
  76
  77 sub reverse {
  78     my ($array) = @_;
  79     [ CORE::reverse @$array ];
  80 }
  81
  82 sub sort {
  83     my ($array, $sub) = @_;
  84     $sub ||= sub { $a cmp $b };
  85     [ CORE::sort { $sub->($a, $b) } @$array ];
  86 }
  87
  88 sub first {
  89     $_[0]->[0];
  90 }
  91
  92 sub last {
  93     $_[0]->[$#{$_[0]}];
  94 }
  95
  96 ## ::Indexed implementation
  97
  98 sub at {
  99     my ($array, $index) = @_;
 100     $array->[$index];
 101 }
 102
 103 sub put {
 104     my ($array, $index, $value) = @_;
 105     $array->[$index] = $value;
 106 }
 107
 108 sub exists {
 109     my ($array, $index) = @_;
 110     CORE::exists $array->[$index];
 111 }
 112
 113 sub keys {
 114     my ($array) = @_;
 115     [ 0 .. $#{$array} ];
 116 }
 117
 118 sub values {
 119     my ($array) = @_;
 120     [ @$array ];
 121 }
 122
 123 sub kv {
 124     my ($array) = @_;
 125     $array->keys->map(sub { [ $_, $array->[$_] ] });
 126 }
 127
 128 sub each {
 129     my ($array, $sub) = @_;
 130     for my $i (0 .. $#$array) {
 131       $sub->($i, $array->[ $i ]);
 132     }
 133 }
 134
 135 sub each_key {
 136     my ($array, $sub) = @_;
 137     $sub->($_) for (0 .. $#$array);
 138 }
 139
 140 sub each_value {
 141     my ($array, $sub) = @_;
 142     $sub->($_) for @$array;
 143 }
 144
 145 sub each_n_values {
 146     my ($array, $n, $sub) = @_;
 147     my $it = List::MoreUtils::natatime($n, @$array);
 148
 149     while (my @vals = $it->()) {
 150         $sub->(@vals);
 151     }
 152
 153     return;
 154 }
 155
 156 # end indexed
 157
 158 sub flatten {
 159     @{$_[0]}
 160 }
 161
 162 sub _flatten_deep {
 163         my @array = @_;
 164         my $depth = CORE::pop @array;
 165         --$depth if (defined($depth));
 166
 167         CORE::map {
 168                 (ref eq 'ARRAY')
 169                         ? (defined($depth) && $depth == -1) ? $_ : _flatten_deep( @$_, $depth )
 170                         : $_
 171         } @array;
 172
 173 }
 174
 175 sub flatten_deep {
 176         my ($array, $depth) = @_;
 177         [ _flatten_deep(@$array, $depth) ];
 178 }
 179
 180 ## Junctions
 181
 182 sub all {
 183     my ($array) = @_;
 184     return Perl6::Junction::all(@$array);
 185 }
 186
 187 sub any {
 188     my ($array) = @_;
 189     return Perl6::Junction::any(@$array);
 190 }
 191
 192 sub none {
 193     my ($array) = @_;
 194     return Perl6::Junction::none(@$array);
 195 }
 196
 197 sub one {
 198     my ($array) = @_;
 199     return Perl6::Junction::one(@$array);
 200 }
 201
 202 ## Print
 203
 204 sub print { CORE::print @{$_[0]} }
 205 sub say   { CORE::print @{$_[0]}, "\n" }
 206
 207 1;
 208
 209 __END__
 210
 211 =pod
 212
 213 =head1 NAME
 214
 215 Moose::Autobox::Array - the Array role
 216
 217 =head1 SYNOPOSIS
 218
 219   use Moose::Autobox;
 220
 221   [ 1..5 ]->isa('ARRAY'); # true
 222   [ a..z ]->does('Moose::Autobox::Array'); # true
 223   [ 0..2 ]->does('Moose::Autobox::List'); # true
 224
 225   print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', ');
 226
 227   print [ 1, 'number' ]->sprintf('%d is the loneliest %s');
 228
 229   print ([ 1 .. 5 ]->any == 3) ? 'true' : 'false'; # prints 'true'
 230
 231 =head1 DESCRIPTION
 232
 233 This is a role to describe operations on the Array type.
 234
 235 =head1 METHODS
 236
 237 =over 4
 238
 239 =item B<pop>
 240
 241 =item B<push ($value)>
 242
 243 =item B<shift>
 244
 245 =item B<unshift ($value)>
 246
 247 =item B<delete ($index)>
 248
 249 =item B<sprintf ($format_string)>
 250
 251 =item B<slice (@indices)>
 252
 253 =item B<flatten>
 254
 255 =item B<flatten_deep ($depth)>
 256
 257 =item B<first>
 258
 259 =item B<last>
 260
 261 =back
 262
 263 =head2 Indexed implementation
 264
 265 =over 4
 266
 267 =item B<at ($index)>
 268
 269 =item B<put ($index, $value)>
 270
 271 =item B<exists ($index)>
 272
 273 =item B<keys>
 274
 275 =item B<values>
 276
 277 =item B<kv>
 278
 279 =item B<each>
 280
 281 =item B<each_key>
 282
 283 =item B<each_value>
 284
 285 =item B<each_n_values ($n, $callback)>
 286
 287 =back
 288
 289 =head2 List implementation
 290
 291 =over 4
 292
 293 =item B<head>
 294
 295 =item B<tail>
 296
 297 =item B<join (?$seperator)>
 298
 299 =item B<length>
 300
 301 =item B<map (\&block)>
 302
 303 =item B<grep (\&block)>
 304
 305 Note that, in both the above, $_ is in scope within the code block, as well as
 306 being passed as $_[0]. As per CORE::map and CORE::grep, $_ is an alias to
 307 the list value, so can be used to to modify the list, viz:
 308
 309     use Moose::Autobox;
 310
 311     my $foo = [1, 2, 3];
 312     $foo->map( sub {$_++} );
 313     print $foo->dump;
 314
 315 yields
 316
 317    $VAR1 = [
 318              2,
 319              3,
 320              4
 321            ];
 322
 323 =item B<reverse>
 324
 325 =item B<sort (?\&block)>
 326
 327 =back
 328
 329 =head2 Junctions
 330
 331 =over 4
 332
 333 =item B<all>
 334
 335 =item B<any>
 336
 337 =item B<none>
 338
 339 =item B<one>
 340
 341 =back
 342
 343 =over 4
 344
 345 =item B<meta>
 346
 347 =item B<print>
 348
 349 =item B<say>
 350
 351 =back
 352
 353 =head1 BUGS
 354
 355 All complex software has bugs lurking in it, and this module is no
 356 exception. If you find a bug please either email me, or add the bug
 357 to cpan-RT.
 358
 359 =head1 AUTHOR
 360
 361 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 362
 363 =head1 COPYRIGHT AND LICENSE
 364
 365 Copyright 2006-2008 by Infinity Interactive, Inc.
 366
 367 L<http://www.iinteractive.com>
 368
 369 This library is free software; you can redistribute it and/or modify
 370 it under the same terms as Perl itself.
 371
 372 =cut