lib/Moose/Autobox/Array.pm

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