package Iterator::Flex::Base;

# ABSTRACT: Iterator object

use v5.28;
use strict;
use warnings;

use experimental qw( signatures postderef declared_refs );

our $VERSION = '0.34';

use Ref::Util;
use Scalar::Util;
use List::Util;
use Role::Tiny       ();
use Role::Tiny::With ();
use Module::Runtime  ();

use Iterator::Flex::Utils qw (
  :default
  :ExhaustionActions
  :GeneralParameters
  :RegistryIndices
  :IterAttrs
  :IterStates
  :InterfaceParameters
  :SignalParameters
  load_role
  throw_failure
);

use namespace::clean;

use overload
  '<>'     => sub ( $self, $, $ ) { &{$self}() },
  fallback => 0,
  bool     => sub { 1 },

  # these are required for the perldb to not barf
  # see https://github.com/Perl/perl5/issues/23486
  eq    => sub { 0 },
  q{""} => sub { q{} },
  ;

# We separate constructor parameters into two categories:
#
#  1. those that are used to construct the iterator
#  2. those that specify what happens when the iterator signals exhaustion
#
#  Category #2 may be expanded. Category #2 parameters are *not* passed
#  to the iterator class construct* routines


sub new ( $class, $state = undef, $general = {} ) {
    return $class->new_from_state( $state, $general );
}

sub new_from_state ( $class, $state, $general ) {
    return $class->new_from_attrs( $class->construct( $state ), $general );
}

sub new_from_attrs ( $class, $in_ipar = {}, $in_gpar = {} ) {    ## no critic (ExcessComplexity)

    my %ipar = $in_ipar->%*;
    my %gpar = $in_gpar->%*;

    $class->_validate_interface_pars( \%ipar );
    $class->_validate_signal_pars( \%gpar );

    my @roles = ( delete( $ipar{ +_ROLES } ) // [] )->@*;

    $gpar{ +ERROR } //= [THROW];
    $gpar{ +ERROR } = [ $gpar{ +ERROR } ]
      unless Ref::Util::is_arrayref( $gpar{ +ERROR } );

    if ( $gpar{ +ERROR }[0] eq THROW ) {
        push @roles, 'Error::Throw';
    }
    else {
        throw_failure( q{unknown specification of iterator error signaling behavior:}, $gpar{ +ERROR }[0] );
    }

    my $exhaustion_action = $gpar{ +EXHAUSTION } // [ ( +RETURN ) => undef ];

    my @exhaustion_action
      = Ref::Util::is_arrayref( $exhaustion_action )
      ? ( $exhaustion_action->@* )
      : ( $exhaustion_action );

    $gpar{ +EXHAUSTION } = \@exhaustion_action;

    if ( $exhaustion_action[0] eq RETURN ) {
        push @roles, 'Exhaustion::Return';
    }
    elsif ( $exhaustion_action[0] eq THROW ) {

        push @roles,
          @exhaustion_action > 1 && $exhaustion_action[1] eq PASSTHROUGH
          ? 'Exhaustion::PassthroughThrow'
          : 'Exhaustion::Throw';
    }
    else {
        throw_failure( parameter => "unknown exhaustion action: $exhaustion_action[0]" );
    }

    if ( defined( my $par = $ipar{ +METHODS } ) ) {

        require Iterator::Flex::Method;

        throw_failure( parameter => q{value for methods parameter must be a hash reference} )
          unless Ref::Util::is_hashref( $par );

        for my $name ( keys $par->%* ) {

            my $code = $par->{$name};

            throw_failure( parameter => "value for 'methods' parameter key '$name' must be a code reference" )
              unless Ref::Util::is_coderef( $code );

            # create role for the method
            my $role = eval { Iterator::Flex::Method::Maker( $name, name => $name ) };

            if ( $@ ne q{} ) {
                my $error = $@;
                die $error
                  unless Ref::Util::is_blessed_ref( $error )
                  && $error->isa( 'Iterator::Flex::Failure::RoleExists' );
                $role = $error->payload;
            }

            push @roles, q{+} . $role;    # need '+', as these are fully qualified role module names.
        }
    }

    @roles = map { load_role( $_, $class->_role_namespaces ) } @roles;
    $class = Role::Tiny->create_class_with_roles( $class, @roles );

    unless ( $class->can( '_construct_next' ) ) {
        throw_failure(
            class => "Constructed class '$class' does not provide the required _construct_next method\n" );
    }

    unless ( $class->does( 'Iterator::Flex::Role::State' ) ) {
        throw_failure( class => "Constructed class '$class' does not provide a State role\n" );
    }

    $ipar{ +_NAME } //= $class;

    my $self = bless $class->_construct_next( \%ipar, \%gpar ), $class;

    throw_failure(
        parameter => q{attempt to register an iterator subroutine which has already been registered.} )
      if exists $REGISTRY{ refaddr $self };

    my $regentry = $REGISTRY{ refaddr $self } = [];

    # convert to arrays. some of the parameter values are weak
    # references so make sure we don't unweaken them
    my @ipar;
    for my $key ( keys %ipar ) {
        $ipar[ $RegIterationIndexMap{$key} ] = $ipar{$key};
        Scalar::Util::weaken $ipar[ $RegIterationIndexMap{$key} ]
          if Ref::Util::is_ref( $ipar{$key} )
          && Scalar::Util::isweak( $ipar{$key} );
    }
    my @gpar;
    for my $key ( keys %gpar ) {
        $gpar[ $RegGeneralParameterIndexMap{$key} ] = $gpar{$key};
        Scalar::Util::weaken $gpar[ $RegGeneralParameterIndexMap{$key} ]
          if Ref::Util::is_ref( $gpar{$key} )
          && Scalar::Util::isweak( $gpar{$key} );
    }

    $regentry->[REG_ITERATOR] = \@ipar;
    $regentry->[REG_GENERAL]  = \@gpar;

    $self->_clear_state;

    return $self;
}

sub _validate_interface_pars ( $class, $pars ) {
    state %InterfaceParameters = {}->%{ +INTERFACE_PARAMETER_VALUES };

    my @bad = grep { !exists $InterfaceParameters{$_} } keys $pars->%*;

    throw_failure( parameter => "unknown interface parameters: @{[ join ', ', @bad ]}" )
      if @bad;

    throw_failure( parameter => "@{[ _ROLES ]}  must be an arrayref" )
      if defined $pars->{_ROLES} && !Ref::Util::is_arrayref( $pars->{ +_ROLES } );

    if ( defined( my $par = $pars->{ +_DEPENDS } ) ) {
        $pars->{ +_DEPENDS } = $par = [$par] unless Ref::Util::is_arrayref( $par );
        throw_failure( parameter => "dependency #$_ is not an iterator object" )
          unless List::Util::all { $class->_is_iterator( $_ ) } $par->@*;
    }

    return;
}

sub _validate_signal_pars ( $class, $pars ) {
    state %SignalParameters = {}->%{ +SIGNAL_PARAMETER_VALUES };
    my @bad = grep { !exists $SignalParameters{$_} } keys $pars->%*;

    throw_failure( parameter => "unknown signal parameters: @{[ join ', ', @bad ]}" )
      if @bad;
}


sub DESTROY ( $self ) {

    if ( defined $self ) {
        delete $REGISTRY{ refaddr $self };
    }
}

sub _name ( $self ) {
    $REGISTRY{ refaddr $self }[REG_ITERATOR][REG_ITER__NAME];
}






















# TODO: this is too restrictive. It should allow simple coderefs, or
# things with a next or __next__.

sub _is_iterator ( $, $obj ) {
    return Ref::Util::is_blessed_ref( $obj ) && $obj->isa( __PACKAGE__ );
}













sub __iter__ ( $self ) {
    return $REGISTRY{ refaddr $self }[REG_ITERATOR][REG_ITER_NEXT];
}













sub may ( $self, $meth ) {

    my \@attributes = $REGISTRY{ refaddr $self }[REG_ITERATOR];
    my $may         = $attributes[REG_ITER_MAY_METHOD] //= {};

    return $may->{"_may_$meth"}
      //= defined $attributes[REG_ITER__DEPENDS]
      ? !List::Util::first { !$_->may( $meth ) } $attributes[REG_ITER__DEPENDS]->@*
      : defined $attributes[ $RegIterationIndexMap{$meth} ];
}
















sub _namespaces {
    return 'Iterator::Flex';
}
















sub _role_namespaces {
    return 'Iterator::Flex::Role';
}

















sub _add_roles ( $class, @roles ) {
    Role::Tiny->apply_roles_to_package( $class,
        map { load_role( $_, $class->_role_namespaces ) } @roles );
}

sub _apply_method_to_depends ( $self, $meth ) {

    if ( defined( my $depends = $REGISTRY{ refaddr $self }[REG_ITERATOR][REG_ITER__DEPENDS] ) ) {
        # first check if dependencies have method
        my $cant = List::Util::first { !$_->can( $meth ) } $depends->@*;
        throw_failure( Unsupported => "dependency: @{[ $cant->_name ]} does not have a '$meth' method" )
          if $cant;

        # now apply the method
        $_->$meth foreach $depends->@*;
    }
}









sub is_exhausted ( $self ) {
    $self->get_state == IterState_EXHAUSTED;
}














sub set_exhausted ( $self ) {
    $self->set_state( IterState_EXHAUSTED );
}














sub _clear_state ( $self ) {
    $self->set_state( IterState_CLEAR );
}









sub is_error ( $self ) {
    $self->get_state == IterState_ERROR;
}














sub set_error ( $self ) {
    $self->set_state( IterState_ERROR );
}









sub throws_on_exhaustion( $self ) {
    return $REGISTRY{ refaddr $self }[REG_GENERAL][REG_GP_EXHAUSTION][0] eq THROW;

}









sub returns_on_exhaustion( $self ) {
    return $REGISTRY{ refaddr $self }[REG_GENERAL][REG_GP_EXHAUSTION][0] eq RETURN;

}









sub buffer ( $self, $n = 0, $pars = {} ) {
    require Iterator::Flex::Buffer;
    Iterator::Flex::Buffer->new( $self, $n, $pars );
}










sub cache ( $self, $pars = {} ) {
    require Iterator::Flex::Cache;
    Iterator::Flex::Cache->new( $self, $pars );
}

sub icache;
*icache = \&cache;












sub cat ( $self, @args ) {
    require Iterator::Flex::Cat;
    Iterator::Flex::Cat->new( $self, @args );
}

sub chain;
*chain = \&cat;












sub chunk ( $self, $pars = {} ) {
    require Iterator::Flex::Chunk;
    Iterator::Flex::Chunk->new( $self, $pars );
}

sub ichunk;
*ichunk = \&chunk;

sub batch;
*batch = \&chunk;














sub drain ( $self, $n = undef ) {

    throw_failure( parameter => '$n is not a positive integer' )
      if defined $n && !( Scalar::Util::looks_like_number( $n ) && int( $n ) == $n && $n > 0 );

    my @values;

    eval {
        if ( $n ) {
            while ( $n-- ) {
                push @values, $self->next;
                if ( $self->is_exhausted ) {
                    pop @values;
                    last;
                }
            }
        }
        else {
            while ( 1 ) {
                push @values, $self->next;
                if ( $self->is_exhausted ) {
                    pop @values;
                    last;
                }
            }
        }
        1;
    } or do {
        die $@
          unless Ref::Util::is_blessed_ref( $@ )
          && $@->isa( 'Iterator::Flex::Failure::Exhausted' );
    };

    return \@values;
}









sub flatten ( $self, $pars = {} ) {
    require Iterator::Flex::Flatten;
    return Iterator::Flex::Flatten->new( $self, $pars );
}

sub iflatten;
*iflatten = \*flatten;










sub foreach ( $self, $code ) {    ## no critic (BuiltinHomonyms)

    if ( $self->throws_on_exhaustion ) {
        eval {
            local $_;    ## no critic (InitializationForLocalVars)
            while ( 1 ) { $_ = $self->(); $code->() }
            1;
        } or do {
            die $@
              unless Ref::Util::is_blessed_ref( $@ )
              && $@->isa( 'Iterator::Flex::Failure::Exhausted' );
        };
    }
    elsif ( $self->returns_on_exhaustion ) {

        # optimize for when sentinel is the undefined value
        if ( !defined $self->sentinel ) {
            local $_;    ## no critic (InitializationForLocalVars)
            $code->() while defined( $_ = $self->() );
        }

        # yeah, this is too slow.  should adapt the logic in Wrap::Return.
        else {
            local $_;                          ## no critic (InitializationForLocalVars)
            $_ = $self->();
            until ( $self->is_exhausted ) {    ## no critic (UntilBlock)
                $code->();
                $_ = $self->();
            }
        }
    }
}










sub gather ( $self, $code, $pars = {} ) {
    require Iterator::Flex::Gather;
    Iterator::Flex::Gather->new( $code, $self, $pars );
}

sub igather;
*igather = \&gather;









sub grep ( $self, $code, $pars = {} ) {    ## no critic (BuiltinHomonyms)

    require Iterator::Flex::Grep;
    Iterator::Flex::Grep->new( $code, $self, $pars );
}

sub igrep;
*igrep = \&grep;









sub map ( $self, $code, $pars = {} ) {    ## no critic (BuiltinHomonyms)

    require Iterator::Flex::Map;
    Iterator::Flex::Map->new( $code, $self, $pars );
}

sub imap;
*imap = \&map;









sub take ( $self, $n, $pars = {} ) {
    require Iterator::Flex::Take;
    Iterator::Flex::Take->new( $self, $n, $pars );
}

1;

#
# This file is part of Iterator-Flex
#
# This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__

=pod

=for :stopwords Diab Jerius Smithsonian Astrophysical Observatory

=head1 NAME

Iterator::Flex::Base - Iterator object

=head1 VERSION

version 0.34

=head1 METHODS

=head2 may

  $bool = $iter->may( $method );

Similar to L<can|UNIVERSAL/can>, except it checks that the method can
be called on the iterators which C<$iter> depends on.  For example,
it's possible that C<$iter> implements a C<rewind> method, but that
it's dependencies do not.  In that case L<can|UNIVERSAL/can> will
return true, but C<may> will return false.

=head2 is_exhausted

  $bool = $iter->is_exhausted

Returns true if the iterator is in the L<exhausted state|Iterator::Flex::Manual::Overview/Exhausted State>

=head2 is_error

   $bool = $self->is_error

Returns true if the iterator is in the L<error state|Iterator::Flex::Manual::Overview/Error State>

=head2 throws_on_exhaustion

  $bool = $iter->throws_on_exhaustion;

Returns true if the iterator throws on exhaustion.

=head2 returns_on_exhaustion

  $bool = $iter->returns_on_exhaustion;

Returns true if the iterator returns a sentinel on exhaustion.

=head2 buffer

  $new_iter = $iter->buffer( $capacity = 0, ?\%pars );

Return a new iterator buffering the original iterator via L<Iterator::Flex::Buffer>.

=head2 cache

  $new_iter = $iter->cache( ?\%pars );

Return a new iterator caching the original iterator via L<Iterator::Flex::Cache>.

=head2 cat

=head2 chain

  $new_iter = $iter->cat( @iterables, ?\%pars );
  $new_iter = $iter->chain( @iterables, ?\%pars );

Return a new iterator concatenating the original iterator with C<@iterables> via L<Iterator::Flex::Cat>.

=head2 chunk

=head2 batch

  $new_iter = $iter->chunk( ?\%pars );
  $new_iter = $iter->batch( ?\%pars );

Return a new iterator chunking the original iterator via L<Iterator::Flex::Chunk>.

=head2 drain

   \@values = $iter->drain( ?$nelem );

drains the iterator by repeatedly calling C<<$iter->next> until the
iterator is exhausted.  C<$iter> will I<not> throw if it signals
exhaustion by throwing.

If C<$nelem> is provided, it will return no more than C<$nelem> at a
time.

=head2 flatten

  $new_iter = $iter->flatten;

Return a new iterator modifying the original iterator via L<Iterator::Flex::Flatten>.

=head2 foreach

  $iter->foreach( $coderef );

Calls the passed subroutine for each value returned by C<$iter>. The
value is made available to C<$iter> in the C<$_> variable.

=head2 gather

  $new_iter = $iter->gather( sub { ... }, ?\%pars );

Return a new iterator modifying the original iterator via L<Iterator::Flex::Gather>.

=head2 grep

  $new_iter = $iter->grep( sub { ... }, ?\%pars );

Return a new iterator modifying the original iterator via L<Iterator::Flex::Grep>.

=head2 map

  $new_iter = $iter->map( sub { ... } );

Return a new iterator modifying the original iterator via L<Iterator::Flex::Map>.

=head2 take

    $new_iter = $iter->take( $n, ?\%pars );

Return a new iterator yielding at most C<$n> elements from C<$iter>, via L<Iterator::Flex::Take>.

=begin :internal

=method _is_iterator

  $class->_is_iterator( $obj  );

Returns true if an object is an iterator, where iterator is defined as

=over

=item *

An object which inherits from C<Iterator::Flex::Base>.

=back

=end :internal

=begin :internal

=method __iter__

   $sub = $iter->__iter__;

Returns the subroutine which returns the next value from the iterator.

=end :internal

=begin :internal

=method _namespaces

 @namespaces = $class->_namespaces;

Returns a list of namespaces to search for classes.  When called on the base class,
this returns

 Iterator::Flex

=end :internal

=begin :internal

=method _role_namespaces

 @namespaces = $class->_role_namespaces;

Returns a list of namespaces to search for roles.  When called on the base class,
returns

 Iterator::Flex::Role

=end :internal

=begin :internal

=method _add_roles

  $class->_add_roles( @roles );

Add roles to the class. If the name begins with a C<+>, it is assumed
to be a fully qualified name, otherwise it is searched for in the
namespaces returned by the L</_role_namespaces> class
method.

=end :internal

=begin :internal

=method set_exhausted

Sets the iterator state status to
L<exhausted|Iterator::Flex::Manual::Overview/Exhausted State>.

It does I<not> signal exhaustion.

=end :internal

=begin :internal

=method _clear_state

Clear the state status.  After this call, this will hold:

  $iter->is_error => false
  $iter->is_exhausted => false

=end :internal

=begin :internal

=method set_error

Sets the iterator state status to
L<error|Iterator::Flex::Manual::Overview/Error State>.

It does I<not> signal error.

=end :internal

=head1 SUPPORT

=head2 Bugs

Please report any bugs or feature requests to bug-iterator-flex@rt.cpan.org  or through the web interface at: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Iterator-Flex>

=head2 Source

Source is available at

  https://gitlab.com/djerius/iterator-flex

and may be cloned from

  https://gitlab.com/djerius/iterator-flex.git

=head1 SEE ALSO

Please see those modules/websites for more information related to this module.

=over 4

=item *

L<Iterator::Flex|Iterator::Flex>

=back

=head1 AUTHOR

Diab Jerius <djerius@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.

This is free software, licensed under:

  The GNU General Public License, Version 3, June 2007

=cut
