The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More;
use strict; use warnings FATAL => 'all';

use List::Objects::WithUtils 'array';

my $arr = array;

ok( $arr->does( 'List::Objects::WithUtils::Role::Array' ),
  'does Array role'
);
ok( $arr->does( 'List::Objects::WithUtils::Role::WithJunctions' ),
  'does WithJunctions role'
);

## count()
cmp_ok( $arr->count, '==', 0, 'size 0 ok' );
$arr = array(1);
cmp_ok( $arr->count, '==', 1, 'size 1 ok' );
$arr = array(1,2,3);
cmp_ok( $arr->count, '==', 3, 'size 3 ok' );

## join()
cmp_ok( $arr->join, 'eq', '1,2,3', 'join 1 ok' );
cmp_ok( $arr->join('-'), 'eq', '1-2-3', 'join 2 ok' );

## copy()
my $copy = $arr->copy;
cmp_ok( $copy->count, '==', 3, 'copy size 3 ok' );

## is_empty()
ok( array()->is_empty, 'is_empty ok' );
ok( !$arr->is_empty, 'negative is_empty ok' );

## all() / export()
is_deeply( [ $arr->all ], [1, 2, 3], 'all() ok' );
is_deeply( [ $arr->export ], [1, 2, 3], 'export() ok' );

## get()
cmp_ok( $arr->get(0), '==', 1, 'get 0 ok' );
cmp_ok( $arr->get(1), '==', 2, 'get 1 ok' );
cmp_ok( $arr->get(2), '==', 3, 'get 2 ok' );

## random()
cmp_ok( array('foo')->random, 'eq', 'foo', 'random ok' );

## set()
ok( $arr->set(1, 4), 'set 1,4 ok' );
cmp_ok( $arr->get(1), '==', 4, 'get idx 1 after set 4 ok' );
my $set;
ok( $set = $arr->set(1, 2), 'set 1,2 ok' );
ok( $set == $arr, 'set returned self' );
cmp_ok( $arr->get(1), '==', 2, 'get idx 1 after set 2 ok' );

undef $set;


## push()
ok( $arr->push(4, 5), 'push 4,5 ok' );
cmp_ok( $arr->get(4), '==', 5, 'get idx 4 after push ok' );
my $pushed;
ok( $pushed = $arr->push(6), 'push 6 ok' );
ok( $pushed == $arr, 'push returned self' );
is_deeply( [ $arr->all ], [1,2,3,4,5,6], 'all() after push ok' );

## pop()
my $popped;
ok( $popped = $arr->pop, 'pop ok' );
cmp_ok( $popped, '==', 6, 'popped value ok' );
is_deeply( [ $arr->all ], [1,2,3,4,5], 'all() after pop ok' );

undef $pushed;
undef $popped;


## shift()
my $shifted;
ok( $shifted = $arr->shift, 'shift ok' );
cmp_ok( $shifted, '==', 1, 'shifted value ok' );
is_deeply( [ $arr->all ], [2,3,4,5], 'all() after shift ok' );

## unshift()
my $unshifted;
ok( $unshifted = $arr->unshift($shifted), 'unshift ok' );
ok( $unshifted == $arr, 'unshift returned self' );
is_deeply( [ $arr->all ], [1,2,3,4,5], 'all() after unshift ok' );

## clear()
my $cleared;
ok( $cleared = $arr->clear, 'clear() ok' );
ok( $cleared == $arr, 'clear() returned self' );
ok( $arr->is_empty, 'array is_empty after clear' );

undef $shifted;
undef $unshifted;
undef $cleared;


$arr = array(1,3,4);
is_deeply( [ $arr->all ], [1,3,4], 'array reset' );

## insert()
my $inserted;
ok( $inserted = $arr->insert(1, 2), 'insert() ok' );
is_deeply( [ $arr->all ], [1,2,3,4], 'all() after insert() ok' );
ok( $inserted == $arr, 'insert returned self' );

## delete()
my $deleted;
ok( $deleted = $arr->delete(2), 'delete() ok' );
cmp_ok( $deleted, '==', 3, 'deleted value ok' );
is_deeply( [ $arr->all ], [1,2,4], 'all() after delete() ok' );

undef $inserted;
undef $deleted;
undef $arr;


$arr = array(qw/a b c/);
is_deeply( [ $arr->all ], [qw/a b c/], 'array reset' );

## map()
my $upper = $arr->map(sub { uc $_[0] });
is_deeply( [ $upper->all ], [qw/A B C/], 'map() ok' );
is_deeply( [ $arr->all ], [qw/a b c/], 'orig after map() ok' );
is_deeply(
  [ array(qw/ a b c /)->map(sub { uc $_ })->all ],
  [ qw/ A B C / ],
  'map() on topicalizer ok'
);

## mapval()
my $valarr = array(1, 2, 3);
my $mapval = $valarr->mapval(sub { ++$_ });
is_deeply( [ $mapval->all ], [ 2, 3, 4 ], 'mapval() ok' );
is_deeply( [ $valarr->all ], [ 1, 2, 3 ], 'orig after mapval() ok' );
is_deeply(
  [ array(1, 2, 3)->mapval(sub { $_[0]++ })->all ],
  [ 2, 3, 4 ],
  'mapval() on @_ ok'
);

## grep()
$arr->push('b');
my $found = $arr->grep(sub { $_[0] eq 'b' });
is_deeply( [ $found->all ], [qw/b b/], 'grep() ok' );
is_deeply( [ $arr->all ], [qw/a b c b/], 'orig after grep() ok' );
is_deeply(
  [ array(qw/ a b c /)->grep(sub { /^b/ })->all ],
  [ 'b' ],
  'grep() on topicalizer ok'
);

undef $upper;
undef $found;

$arr = array(4, 2, 3, 1);

## sort()
my $sorted = $arr->sort(sub { $_[0] <=> $_[1] });
my $lazysorted = $arr->sort;
is_deeply( [ $sorted->all ], [1,2,3,4], 'sort() ok' );
is_deeply( [ $lazysorted->all ], [ $sorted->all ], 'default sort() ok' );

undef $sorted;
undef $lazysorted;


## reverse()
$arr = array(1,2,3);
my $reverse;
ok( $reverse = $arr->reverse, 'reverse() ok' );
is_deeply( [ $reverse->all ], [3,2,1], 'all() after reverse() ok' );
is_deeply( [ $arr->all ], [1,2,3], 'orig after reverse() ok' );

undef $reverse;

## sliced()
my $sliced;
ok( $sliced = $arr->sliced(0,2), 'sliced() ok' );
is_deeply( [ $sliced->all ], [1,3], 'all() after sliced() ok' );

undef $sliced;

## splice()
$arr = array( qw/ a b c d / );
my $spliced = $arr->splice(1, 3);
is_deeply( [ $spliced->all ], [qw/b c d/], '2-arg splice() ok' )
  or diag explain $spliced;
$spliced->splice( 2, 1, 'e' );
is_deeply( [ $spliced->all ], [qw/b c e/], '3-arg splice() ok' );

## has_any()
$arr = array();
ok( !$arr->has_any, 'negative has_any ok' );
$arr = array(qw/ a b c /);
ok( $arr->has_any, 'has_any ok' );
ok( $arr->has_any(sub { $_ eq 'b' }), 'has_any with param ok');
ok( !$arr->has_any(sub { $_ eq 'd' }), 'negative has_any with param ok' );

## first()
$arr = array(qw/ a ba bb c /);
my $first;
ok( $first = $arr->first(sub { $_ =~ /^b/ }), 'first() ok' );
cmp_ok( $first, 'eq', 'ba', 'first() correct element ok' );

## firstidx()
ok( $first = $arr->firstidx(sub { $_ =~ /^b/ }), 'firstidx() ok' );
cmp_ok( $first, '==', 1, 'firstidx() correct index ok' );

## reduce()
cmp_ok( array(1,2,3)->reduce(sub { $_[0] + $_[1] }), '==', 6, 'reduce() ok' );

## natatime()
$arr = array(1 .. 7);
my $itr = $arr->natatime(3);
is_deeply( [ $itr->() ], [1,2,3], 'itr() 1 ok' );
is_deeply( [ $itr->() ], [4,5,6], 'itr() 2 ok' );
is_deeply( [ $itr->() ], [7], 'itr() 3 ok' );

my $counted;
$arr->natatime(3, sub { ++$counted if @_ });
is( $counted, 3, 'natatime with coderef ok' );

undef $itr;

## items_after()
my $after = $arr->items_after(sub { $_ == 3 });
is_deeply( [ $after->all ], [4,5,6,7], 'items_after ok' );

## items_after_incl()
$after = $arr->items_after_incl(sub { $_ == 3 });
is_deeply( [ $after->all ], [3,4,5,6,7], 'items_after_incl ok' );

## items_before()
my $before = $arr->items_before(sub { $_ == 4 });
is_deeply( [ $before->all ], [1,2,3], 'items_before ok' );

## items_before_incl()
$before = $arr->items_before_incl(sub { $_ == 4 });
is_deeply( [ $before->all ], [1,2,3,4], 'items_before_incl ok' );

## shuffle()
my $shuffled = array(1,2,3)->shuffle;
ok(
  (
    $shuffled->grep(sub { $_[0] == 1 })
    and $shuffled->grep(sub { $_[0] == 2 })
    and $shuffled->grep(sub { $_[0] == 3 })
    and $shuffled->count == 3
  ),
  'shuffle() ok'
) or diag explain $shuffled;

## uniq()
$arr = array( 1, 2, 2, 3, 4, 5, 5 );
my $uniq = $arr->uniq;
is_deeply( [ $uniq->sort->all ], [1,2,3,4,5], 'uniq() ok' );

undef $uniq;

## sort_by()
$arr = array(
  { id => 'c' },
  { id => 'a' },
  { id => 'b' },
);

my $hsorted = $arr->sort_by(sub { $_->{id} });
is_deeply( [ $hsorted->all ],
  [
    { id => 'a' },
    { id => 'b' },
    { id => 'c' },
  ],
  'sort_by ok' 
);

## nsort_by()
$arr = array(
  { id => 3 },
  { id => 1 },
  { id => 2 },
);

$hsorted = $arr->nsort_by(sub { $_->{id} });
is_deeply( [ $hsorted->all ],
  [
    { id => 1 },
    { id => 2 },
    { id => 3 },
  ],
  'nsort_by ok'
);

## uniq_by()
$arr = array(
  { id => 1 },
  { id => 2 },
  { id => 1 },
  { id => 3 },
  { id => 3 },
);

$hsorted = $arr->uniq_by(sub { $_->{id} });
is_deeply( [ $hsorted->all ],
  [
    { id => 1 },
    { id => 2 },
    { id => 3 },
  ],
  'uniq_by ok'
);

## WithJunctions
$arr = array(1, 2, 3);

## any_items()
ok( $arr->any_items == 2, 'any_items == 2 ok' );
ok( $arr->any_items == 3, 'any_items == 3 ok' );
ok( not($arr->any_items == 4), 'negative any_items ok' );

## all_items()
ok( not($arr->all_items == 2), 'not all_items == 2 ok' );
$arr = array(1, 1, 1);
ok( $arr->all_items == 1, 'all_items == 1 ok' );

undef $arr;

## mesh()
my $mesh_even = array(qw/ a b c d /)->mesh( array(1, 2, 3, 4) );
is_deeply( 
  [ $mesh_even->all ],
  [ 'a', 1, 'b', 2, 'c', 3, 'd', 4 ],
  'mesh even list ok'
);

undef $mesh_even;

my @u_one; $#u_one = 9;
my $with_holes = array( 1 .. 10 )->mesh( array(@u_one) );
is_deeply(
  [ $with_holes->all ],
  [
    1, undef, 2, undef, 3, undef, 4, undef, 5, undef,
    6, undef, 7, undef, 8, undef, 9, undef, 10, undef
  ],
  'mesh with undef-filled list ok'
);

undef $with_holes;

my @a_one = ( 1, 2 );
my @a_two = qw/ foo bar baz /;
# mesh() with mixed array obj / array ref
my $mesh_multi = array( 'x' )->mesh( array(@a_one), [ @a_two ] );
is_deeply(
  [ $mesh_multi->all ],
  [ 'x', 1, 'foo', undef, 2, 'bar', undef, undef, 'baz' ],
  'mesh with array/ref mix ok'
);

undef @a_one; undef @a_two;
undef $mesh_multi;

eval {; array( 'foo' )->mesh( 'bar' ) };
ok $@ =~ /ARRAY/, 'mesh with bad args dies'
  or diag explain $@;


## part()
my $parts_n = do {
  my $i = 0;
  array(1 .. 12)->part(sub { $i++ % 3 });
};
ok( $parts_n->count == 3, 'part() created 3 arrays' );
is_deeply(
  [ $parts_n->get(0)->all ],
  [ 1, 4, 7, 10 ],
  'part() first array ok'
);
is_deeply(
  [ $parts_n->get(1)->all ],
  [ 2, 5, 8, 11 ],
  'part() second array ok'
);
is_deeply(
  [ $parts_n->get(2)->all ],
  [ 3, 6, 9, 12 ],
  'part() third array ok'
);

undef $parts_n;

my $parts_single = array(1 .. 12)->part(sub { 3 });
ok( $parts_single->get(0)->count == 0, 'part() 0 empty ok' );
ok( $parts_single->get(1)->count == 0, 'part() 1 empty ok' );
ok( $parts_single->get(2)->count == 0, 'part() 2 empty ok' );
is_deeply( 
  [ $parts_single->get(3)->all ],
  [ 1 .. 12 ],
  'part() 3 filled ok'
);

undef $parts_single;

my ($evens, $odds) = array( 1 .. 6 )->part(sub { $_[0] & 1 })->all;
is_deeply( [ $evens->all ], [ 2,4,6 ], 'part() with args picked evens ok' );
is_deeply( [ $odds->all ], [ 1,3,5 ], 'part() with args picked odds ok' );

## bisect()
my $pair = array( 1 .. 10 )->bisect(sub { $_[0] >= 5 });
isa_ok( $pair, 'List::Objects::WithUtils::Array', 
  'bisect() array obj'
);

ok( $pair->count == 2, 'bisect() returned two items' );
isa_ok( $pair->get(0), 'List::Objects::WithUtils::Array',
  'bisect() item 0 obj'
);
isa_ok( $pair->get(1), 'List::Objects::WithUtils::Array',
  'bisect() item 1 obj'
);

is_deeply(
  [ $pair->get(0)->all ],
  [ 5 .. 10 ],
  'bisect() item 0 ok'
);
is_deeply(
  [ $pair->get(1)->all ],
  [ 1 .. 4 ],
  'bisect() item 1 ok'
);

ok( array->bisect(sub {})->count == 2, 'bisect() always returns two arrays' );


## tuples()
my $tuples = array( 1 .. 7 )->tuples(2);
is_deeply(
  [ $tuples->all ],
  [
    [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 7, undef ]
  ],
  'tuples() ok'
);

my $deep = array( 1, 2, [ 3, 4, [ 5, 6 ], 7 ] );
## flatten_all()
is_deeply(
  [ $deep->flatten_all ],
  [ 1, 2, 3, 4, 5, 6, 7 ],
  'flatten_all() ok'
);

is_deeply(
  [ array( 1, 2, array(3, 4, array(5, 6) ), 7 )->flatten_all ],
  [ 1, 2, 3, 4, 5, 6, 7 ],
  'flatten_all() against objs ok'
);

## flatten()
is_deeply(
  [ $deep->flatten ],
  [ $deep->all ],
  'flatten() with no args same as all() ok'
);

is_deeply(
  [ $deep->flatten(0) ],
  [ $deep->all ],
  'flatten() to depth 0 ok'
);

is_deeply(
  [ $deep->flatten(-1) ],
  [ $deep->all ],
  'flatten() to negative depth same as all() ok'
);

is_deeply(
  [ $deep->flatten(1) ],
  [ 1, 2, 3, 4, [ 5, 6 ], 7 ],
  'flatten to depth 1 ok'
);

is_deeply(
  [ $deep->flatten(2) ],
  [ 1, 2, 3, 4, 5, 6, 7 ],
  'flatten to depth 2 ok'
);

my $cmplx = array(
  1, 2,
  [ 3, 4, [ 5, 6 ] ],
  [ 7, 8, [ 9, 10 ] ],
);

is_deeply(
  [ $cmplx->flatten(1) ],
  [ 1, 2, 3, 4, [ 5, 6 ], 7, 8, [ 9, 10 ] ],
  'flatten complex array ok'
);

{ package My::Obj;
  use strict; use warnings FATAL => 'all';
  sub new { bless [ 'foo' ], shift }

  use List::Objects::WithUtils 'array';
  use Test::More;

  my $foo = My::Obj->new;
  my $with_objs = array(
    array(1, 2, 3),
    $foo,
    [4, 5, 6],
  );

  is_deeply(
    [ $with_objs->flatten_all ],
    [ 1, 2, 3, $foo, 4, 5, 6 ],
    'flatten_all skipped ARRAY-type obj ok'
  );

  is_deeply(
    [ $with_objs->flatten(1) ],
    [ 1, 2, 3, $foo, 4, 5, 6 ],
    'flatten skipped ARRAY-type obj ok'
  );
}


## subclasses
{  package My::List;
   use strict; use warnings FATAL => 'all';

   require List::Objects::WithUtils::Array;
   use parent 'List::Objects::WithUtils::Array';

   package My::Foo;
   use strict; use warnings FATAL => 'all';
   use Test::More;

   my $foo = My::List->new;
   isa_ok( $foo->map(sub { $_[0] }), 'My::List', 'subclassed obj' );
}

done_testing;