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     $sep ||= '';
  30     CORE::join $sep, @$array;
  31 }
  32
  33 sub reverse {
  34     my ($array) = @_;
  35     [ CORE::reverse @$array ];
  36 }
  37
  38 sub sort {
  39     my ($array, $sub) = @_;
  40     $sub ||= sub { $a cmp $b };
  41     [ CORE::sort { $sub->($a, $b) } @$array ];
  42 }
  43
  44 # ...
  45
  46 sub reduce {
  47     my ($array, $func) = @_;
  48     my $a = $array->values;
  49     my $acc = $a->shift;
  50     $a->map(sub { $acc = $func->($acc, $_) });
  51     return $acc;
  52 }
  53
  54 sub zip {
  55     my ($array, $other) = @_;
  56     ($array->length < $other->length
  57         ? $other
  58         : $array)
  59             ->keys
  60             ->map(sub {
  61                 [ $array->[$_], $other->[$_] ]
  62             });
  63 }
  64
  65 ##
  66
  67 sub keys {
  68     my ($array) = @_;
  69     [ 0 .. $#{$array} ];
  70 }
  71
  72 sub values {
  73     my ($array) = @_;
  74     [ @$array ];
  75 }
  76
  77 sub kv {
  78     my ($array) = @_;
  79     $array->keys->map(sub { [ $_, $array->[$_] ] });
  80 }
  81
  82 ## Array Interface
  83
  84 sub pop {
  85     my ($array) = @_;
  86     CORE::pop @$array;
  87 }
  88
  89 sub push {
  90     my ($array, @rest) = @_;
  91     CORE::push @$array, @rest;
  92     $array;
  93 }
  94
  95 sub unshift {
  96     my ($array, @rest) = @_;
  97     CORE::unshift @$array, @rest;
  98     $array;
  99 }
 100 sub exists {
 101     my ($array, $index) = @_;
 102     CORE::exists $array->[$index];
 103 }
 104
 105 sub delete {
 106     my ($array, $index) = @_;
 107     CORE::delete $array->[$index];
 108 }
 109
 110 sub shift {
 111     my ($array) = @_;
 112     CORE::shift @$array;
 113 }
 114
 115 1;