lib/Moose/Autobox/Array.pm

   1 package Moose::Autobox::Array;
   2 use Moose::Role 'with';
   3
   4 our $VERSION = '0.01';
   5
   6 with 'Moose::Autobox::Ref',
   7      'Moose::Autobox::List';
   8
   9 ## List interface
  10
  11 sub length {
  12     my ($array) = @_;
  13     CORE::scalar @$array;
  14 }
  15
  16 sub grep {
  17     my ($array, $sub) = @_;
  18     [ CORE::grep { $sub->($_) } @$array ];
  19 }
  20
  21 sub map {
  22     my ($array, $sub) = @_;
  23     [ CORE::map { $sub->($_) } @$array ];
  24 }
  25
  26 sub join {
  27     my ($array, $sep) = @_;
  28     CORE::join $sep, @$array;
  29 }
  30
  31 sub reverse {
  32     my ($array) = @_;
  33     [ CORE::reverse @$array ];
  34 }
  35
  36 sub sort {
  37     my ($array, $sub) = @_;
  38     $sub ||= sub { $a cmp $b };
  39     [ CORE::sort { $sub->($a, $b) } @$array ];
  40 }
  41
  42 # ...
  43
  44 sub reduce {
  45     my ($array, $func) = @_;
  46     my @a = @$array;
  47     my $acc = CORE::shift @a;
  48     $acc = $func->($acc, $_) foreach @a;
  49     return $acc;
  50 }
  51
  52 sub zip {
  53     my ($array, $other) = @_;
  54     [
  55         CORE::map {
  56             [ $array->[$_], $other->[$_] ]
  57         } 0 .. $#{(
  58             CORE::scalar @{$array} < CORE::scalar @{$other}
  59                 ? $other : $array
  60         )}
  61     ];
  62 }
  63
  64 ##
  65
  66 sub keys {
  67     my ($array) = @_;
  68     [ 0 .. $#{$array} ];
  69 }
  70
  71 sub values {
  72     my ($array) = @_;
  73     [ @$array ];
  74 }
  75
  76 sub kv {
  77     my ($array) = @_;
  78     [ CORE::map { [ $_, $array->[$_] ] } (0 .. $#{$array}) ];
  79 }
  80
  81 ## Array Interface
  82
  83 sub pop {
  84     my ($array) = @_;
  85     CORE::pop @$array;
  86 }
  87
  88 sub push {
  89     my ($array, @rest) = @_;
  90     CORE::push @$array, @rest;
  91     $array;
  92 }
  93
  94 sub unshift {
  95     my ($array, @rest) = @_;
  96     CORE::unshift @$array, @rest;
  97     $array;
  98 }
  99 sub exists {
 100     my ($array, $index) = @_;
 101     CORE::exists $array->[$index];
 102 }
 103
 104 sub delete {
 105     my ($array, $index) = @_;
 106     CORE::delete $array->[$index];
 107 }
 108
 109 sub shift {
 110     my ($array) = @_;
 111     CORE::shift @$array;
 112 }
 113
 114
 115 1;