File Coverage

blib/lib/Bubblegum/Object/Array.pm

Criterion	Covered	Total	%
statement	238	238	100.0
branch	45	62	72.5
condition	8	10	80.0
subroutine	63	63	100.0
pod	53	53	100.0
total	407	426	95.5

# ABSTRACT: Common Methods for Operating on Array References
package Bubblegum::Object::Array;

use 5.10.0;
use namespace::autoclean;

use Bubblegum::Class 'with';
use Bubblegum::Constraints -isas, -types;

use Scalar::Util 'looks_like_number';

with 'Bubblegum::Object::Role::Defined';
with 'Bubblegum::Object::Role::Indexed';
with 'Bubblegum::Object::Role::List';
with 'Bubblegum::Object::Role::Ref';
with 'Bubblegum::Object::Role::Coercive';
with 'Bubblegum::Object::Role::Output';

our @ISA = (); # non-object

our $VERSION = '0.45'; # VERSION

sub all {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    my $found = CORE::grep { $code->($_, @_) } @$self;
    return $found == @$self ? 1 : 0;
}

sub any {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    my $found = CORE::grep { $code->($_, @_) } @$self;
    return $found ? 1 : 0;
}

sub clear {
    goto ∅
}

sub count {
    goto &length;
}

sub defined {
    my $self  = CORE::shift;
    my $index = type_number CORE::shift;

    return CORE::defined $self->[$index];
}

sub delete {
    my $self  = CORE::shift;
    my $index = type_number CORE::shift;

    return CORE::delete $self->[$index];
}

sub each {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    my $i=0;
    foreach my $value (@$self) {
        $code->($i, $value, @_); $i++;
    }

    return $self;
}

sub each_key {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    $code->($_, @_) for (0..$#{$self});
    return $self;
}

sub each_n_values {
    my $self   = CORE::shift;
    my $number = $_[0] ? type_number CORE::shift : 2;
    my $code   = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    my @values = @$self;

    $code->(CORE::splice(@values, 0, $number), @_) while @values;
    return $self;
}

sub each_value {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    $code->($self->[$_], @_) for (0..$#{$self});
    return $self;
}

sub empty {
    my $self = CORE::shift;

    $#$self = -1;
    return $self;
}

sub exists {
    my $self  = CORE::shift;
    my $index = type_number CORE::shift;
    return CORE::exists $self->[$index];
}

sub first {
    my $self = CORE::shift;
    return $self->[0];
}

sub get {
    my $self  = CORE::shift;
    my $index = type_number CORE::shift;
    return $self->[$index];
}

sub grep {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    return [CORE::grep { $code->($_, @_) } @$self];
}

sub hashify {
    my $self = CORE::shift;
    my $temp = {};

    for (CORE::grep { CORE::defined $_ } @$self) {
        $temp->{$_} = 1;
    }

    return $temp;
}

sub head {
    my $self = CORE::shift;
    return $self->[0];
}

sub iterator {
    my $self = CORE::shift;

    my $i = 0;
    return sub {
        return undef if $i > $#{$self};
        return $self->[$i++];
    }
}

sub join {
    my $self = CORE::shift;
    my $separator = type_string CORE::shift if $_[0];
    return CORE::join $separator // '', @$self;
}

sub keyed {
    my $self = CORE::shift;
    my @keys = @_;

    type_string $_ for @keys;

    my $i=0;
    return { CORE::map { $_ => $self->[$i++] } @keys };
}

sub keys {
    my $self = CORE::shift;
    return [0 .. $#{$self}];
}

sub last {
    my $self = CORE::shift;
    return $self->[-1];
}

sub length {
    my $self = CORE::shift;
    return CORE::scalar @$self;
}

sub list {
    my $self = CORE::shift;
    return (@$self);
}

sub map {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    return [CORE::map { $code->($_, @_) } @$self];
}

sub max {
    my $self = CORE::shift;
    my $max;

    for my $val (@$self) {
        next if CORE::ref($val);
        next if ! CORE::defined($val);
        next if ! looks_like_number($val);
        $max //= $val;
        $max = $val if $val > $max;
    }

    return $max;
}

sub min {
    my $self = CORE::shift;
    my $min;

    for my $val (@$self) {
        next if CORE::ref($val);
        next if ! CORE::defined($val);
        next if ! looks_like_number($val);
        $min //= $val;
        $min = $val if $val < $min;
    }

    return $min;
}

sub none {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    my $found = CORE::grep { $code->($_, @_) } @$self;
    return $found ? 0 : 1;
}

sub nsort {
    my $self = CORE::shift;
    my $code = sub { $a <=> $b };
    return $self->sort($code);
}

sub one {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    my $found = CORE::grep { $code->($_, @_) } @$self;
    return $found == 1 ? 1 : 0;
}

sub pairs {
    goto &pairs_array;
}

sub pairs_array {
    my $self = CORE::shift;
    my $i=0;
    return [CORE::map +[$i++, $_], @$self];
}

sub pairs_hash {
    my $self = CORE::shift;
    my $i=0;
    return {CORE::map {$i++ => $_} @$self};
}

sub part {
    my $self = CORE::shift;
    my $code = CORE::shift;

    $code = $code->codify if isa_string $code;
    type_coderef $code;

    my $result = [[],[]];
    foreach my $value (@$self) {
        my $slot = $code->($value, @_) ? $$result[0] : $$result[1];
        CORE::push @$slot, $value;
    }

    return $result;
}

sub pop {
    my $self = CORE::shift;
    return CORE::pop @$self;
}

sub print {
    my $self = CORE::shift;
    return CORE::print @$self, @_;
}

sub push {
    my $self = CORE::shift;
    my @args = @_;

    CORE::push @$self, @args;
    return $self;
}

sub random {
    my $self = CORE::shift;
    return @$self[rand(1+$#{$self})];
}

sub reverse {
    my $self = CORE::shift;
    return [CORE::reverse @$self];
}

sub rotate {
    my $self = CORE::shift;
    CORE::push @$self, CORE::shift @$self;
    return $self;
}

sub rnsort {
    my $self = CORE::shift;
    my $code = sub { $b <=> $a };
    return $self->sort($code);
}

sub rsort {
    my $self = CORE::shift;
    my $code = sub { $b cmp $a };
    return $self->sort($code);
}

sub say {
    my $self = CORE::shift;
    return print(@$self, @_, "\n");
}

sub set {
    my $self  = CORE::shift;
    my $index = type_number CORE::shift;
    return $self->[$index] = CORE::shift;
}

sub shift {
    my $self = CORE::shift;
    return CORE::shift @$self;
}

sub size {
    goto &length;
}

sub slice {
    my $self = CORE::shift;
    my @indicies = @_;

    type_number $_ for @indicies;

    return [@$self[@indicies]];
}

sub sort {
    my $self = CORE::shift;
    my $code = type_coderef CORE::shift if $_[0];
    $code ||= sub { $a cmp $b };
    return [CORE::sort { $code->($a, $b) } @$self];
}

sub sum {
    my $self = CORE::shift;
    my $sum  = 0;

    for my $val (@$self) {
        next if CORE::ref($val);
        next if !CORE::defined($val);
        next if !looks_like_number($val);
        $sum += $val;
    }

    return $sum;
}

sub tail {
    my $self = CORE::shift;
    return [@$self[1 .. $#$self]];
}

sub unique {
    my $self = CORE::shift;

    my %seen;
    return [CORE::grep { not $seen{$_}++ } @$self];
}

sub unshift {
    my $self = CORE::shift;
    my @args = @_;

    CORE::unshift @$self, @args;
    return $self;
}

sub values {
    my $self = CORE::shift;
    return [@$self];
}

1;

__END__