# This module is part of debbugs, and
# is released under the terms of the GPL version 2, or any later
# version (at your option). See the file README and COPYING for more
# information.
# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.

package Debbugs::Collection;

=head1 NAME

Debbugs::Collection -- Collection base class which can generate lots of objects

=head1 SYNOPSIS

This base class is designed for holding collections of objects which can be
uniquely identified by a key and added/generated by that same key.

=head1 DESCRIPTION



=cut

use Mouse;
use strictures 2;
use namespace::autoclean;
use List::AllUtils qw(pairmap);
use Carp qw(croak);

extends 'Debbugs::OOBase';

=head1 METHODS

=head2 Debbugs::Collection->new(%params|$params)

Creates a new Debbugs::Collection object.

Parameters:

=over

=item universe

To avoid unnecessarily constructing new members, collections have a universe to
which existing members can be obtained from. By default the universe is this
collection. Generally, you should create exactly one universe for each
collection type.

=item schema

Optional Debbugs::Schema object


=back

=head2 $collection->members()

Returns list of members of this collection

=head2 $collection->members_ref()

Returns an ARRAYREF of members of this collection

=head2 $collection->keys_of_members()

Returns a list of the keys of all members of this collection

=head2 $collection->member_key($member)

Given a member, returns the key of that member

=head2 $collection->exists($member_key)

Returns true if a member with $member_key exists in the collection

=head2 $collection->clone()

Returns a clone of this collection with the same universe as this collection

=head2 $collection->limit(@member_keys)

Returns a new collection limited to the list of member keys passed. Will add new
members to the universe if they do not currently exist.

=head2 $collection->add($member)

Add a member to this collection

=head2 $collection->add_by_key($member_key)

Add a member to this collection by key

=head2 $collection->combine($collection2) or $collection + $collection2

Combines the members of both collections together and returns the new collection

=head2 $collection->get($member_key)

Get member(s) by key, returning undef for keys which do not exist in the
collection

=head2 $collection->get_or_add_by_key($member_key)

Get or add a member by the member key.

=head2 $collection->count()

Return the number of members in this collection

=head2 $collection->grep({$_ eq 5})

Return the members in this collection which satisfy the condition, setting $_
locally to each member object

=head2 $collection->join(', ')

Returns the keys of the members of this collection joined

=head2 $collection->apply({$_*2})

Return the list of applying BLOCK to each member; each member can return 0 or
more results

=head2 $collection->map({$_*2})

Returns the list of applying BLOCK to each member; each member should return
exactly one result

=head2 $collection->sort({$a <=> $b})

Return the list of members sorted by BLOCK

=cut

has 'members' => (is => 'bare',
		  isa => 'ArrayRef',
		  traits => ['Array'],
		  default => sub {[]},
                  writer => '_set_members',
                  predicate => '_has_members',
		  handles => {_add => 'push',
			      members => 'elements',
			      count => 'count',
			      _get_member => 'get',
                              grep => 'grep',
                              map => 'map',
                              sort => 'sort',
			     },
		 );

sub apply {
    my $self = shift;
    my $block = shift;
    my @r;
    for ($self->members) {
        push @r,$block->();
    }
    return @r;
}

sub members_ref {
    my $self = shift;
    return [$self->members];
}

has 'member_hash' => (traits => ['Hash'],
		      is => 'bare',
                      # really a HashRef[Int], but type checking is too slow
		      isa => 'HashRef',
		      lazy => 1,
		      reader => '_member_hash',
		      builder => '_build_member_hash',
                      clearer => '_clear_member_hash',
                      predicate => '_has_member_hash',
                      writer => '_set_member_hash',
		      handles => {# _add_member_hash => 'set',
				  _member_key_exists => 'exists',
				  _get_member_hash => 'get',
				 },
		     );

# because _add_member_hash needs to be fast, we are overriding the default set
# method which is very safe but slow, because it makes copies.
sub _add_member_hash {
    my ($self,@kv) = @_;
    pairmap {
        defined($a)
            or $self->meta->
            throw_error("Hash keys passed to _add_member_hash must be defined" );
        ($b eq int($b)) or
            $self->meta->
            throw_error("Values passed to _add_member_hash must be integer");
    } @kv;
    my @return;
    while (my ($key, $value) = splice @kv, 0, 2 ) {
        push @return,
            $self->{member_hash}{$key} = $value
    }
    wantarray ? return @return: return $return[0];
}

=head2 $collection->universe


=cut

has 'universe' => (is => 'ro',
                   isa => 'Debbugs::Collection',
                   required => 1,
                   builder => '_build_universe',
                   writer => '_set_universe',
                   predicate => 'has_universe',
                  );

sub _build_universe {
    # By default, the universe is myself
    return $_[0];
}

sub clone {
    my $self = shift;
    my $new = bless { %{$self} }, ref $self;
    if ($self->_has_members) {
        $new->_set_members([$self->members]);
    }
    if ($self->_has_member_hash) {
        $new->_set_member_hash({%{$self->_member_hash}})
    }
    return $new;
}

sub _shallow_clone {
    my $self = shift;
    return bless { %{$self} }, ref $self;
}

sub limit {
    my $self = shift;
    my $limit = $self->_shallow_clone();
    # Set the universe to whatever my universe is (potentially myself)
    # $limit->_set_universe($self->universe);
    $limit->_set_members([]);
    $limit->_clear_member_hash();
    $limit->add($self->universe->get_or_add_by_key(@_)) if @_;
    return $limit;
}

sub get_or_add_by_key {
    my $self = shift;
    return () unless @_;
    my @return;
    my @exists;
    my @need_to_add;
    for my $i (0..$#_) {
        # we assume that if it's already a blessed reference, that it's the
        # right object to return
        if (ref $_[$i]) {
            croak "Passed a reference instead of a key to get_or_add_by_key";
        }
        elsif ($self->_member_key_exists($_[$i])) {
            push @exists,$i;
        } else {
            push @need_to_add,$i;
        }
    }
    # create and add by key
    if (@need_to_add) {
        @return[@need_to_add] =
            $self->add_by_key(@_[@need_to_add]);
    }
    if (@exists) {
        @return[@exists] =
            $self->get(@_[@exists]);
    }
    # if we've only been asked to get or create one thing, then it's expected
    # that we are returning only one thing
    if (@_ == 1) {
        return $return[0];
    }
    return @return;
}

has 'constructor_args' => (is => 'rw',
			   isa => 'ArrayRef',
			   lazy => 1,
                           builder => '_build_constructor_args',
			  );

sub _build_constructor_args {
    return [];
}

sub add_by_key {
    my $self = shift;
    # we'll assume that add does the right thing. around this in subclasses
    return $self->add(@_);
}

sub add {
    my $self = shift;
    my @members_added;
    for my $member (@_) {
        if (not defined $member) {
            confess("Undefined member to add");
        }
        push @members_added,$member;
	if ($self->exists($member)) {
	    next;
	}
	$self->_add($member);
	$self->_add_member_hash($self->member_key($member),
				$self->count()-1,
			       );
    }
    return @members_added;
}

use overload '+' => "combine",
    '""' => "CARP_TRACE";

sub combine {
    my $self = shift;
    my $return = $self->clone;
    $return->add($_->members) for @_;
    return $return;
}

sub get {
    my $self = shift;
    my @res = map {$self->_get_member($_)}
        $self->_get_member_hash(@_);
    wantarray?@res:$res[0];
}


sub member_key {
    return $_[1];
}

sub keys_of_members {
    my $self = shift;
    return $self->map(sub {$self->member_key($_)});
}

sub exists {
    my $self = shift;
    return $self->_member_key_exists($self->member_key($_[0]));
}

sub join {
    my $self = shift;
    my $joiner = shift;
    return CORE::join($joiner,$self->keys_of_members);
}

sub _build_member_hash {
    my $self = shift;
    my $hash = {};
    my $i = 0;
    for my $member ($self->members) {
	$hash->{$self->member_key($member)} =
	    $i++;
    }
    return $hash;
}

sub CARP_TRACE {
    my $self = shift;
    my @members = $self->members;
    if (@members > 5) {
        @members = map {$self->member_key($_)}
            @members[0..4];
        push @members,'...';
    } else {
        @members = map {$self->member_key($_)} @members;
    }
    return __PACKAGE__.'={n_members='.$self->count().
        ',members=('.CORE::join(',',@members).')}';
}


__PACKAGE__->meta->make_immutable;
no Mouse;
1;

__END__
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
