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