lib/Moose/Autobox/Array.pm

   1 package Moose::Autobox::Array;
   2 use Moose::Role 'with';
   3 use autobox;
   4
   5 our $VERSION = '0.01';
   6
   7 with 'Moose::Autobox::Ref',
   8      'Moose::Autobox::List';
   9
  10 ## List interface
  11
  12 sub length {
  13     my ($array) = @_;
  14     CORE::scalar @$array;
  15 }
  16
  17 sub grep {
  18     my ($array, $sub) = @_;
  19     [ CORE::grep { $sub->($_) } @$array ];
  20 }
  21
  22 sub map {
  23     my ($array, $sub) = @_;
  24     [ CORE::map { $sub->($_) } @$array ];
  25 }
  26
  27 sub join {
  28     my ($array, $sep) = @_;
  29     CORE::join $sep, @$array;
  30 }
  31
  32 sub reverse {
  33     my ($array) = @_;
  34     [ CORE::reverse @$array ];
  35 }
  36
  37 sub sort {
  38     my ($array, $sub) = @_;
  39     $sub ||= sub { $a cmp $b };
  40     [ CORE::sort { $sub->($a, $b) } @$array ];
  41 }
  42
  43 # ...
  44
  45 sub reduce {
  46     my ($array, $func) = @_;
  47     my $a = $array->values;
  48     my $acc = $a->shift;
  49     $a->map(sub { $acc = $func->($acc, $_) });
  50     return $acc;
  51 }
  52
  53 sub zip {
  54     my ($array, $other) = @_;
  55     ($array->length < $other->length
  56         ? $other
  57         : $array)
  58             ->keys
  59             ->map(sub {
  60                 [ $array->[$_], $other->[$_] ]
  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 1;