File Coverage

blib/lib/Promises6.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	11	12	91.6
condition			n/a
subroutine	21	21	100.0
pod	10	10	100.0
total	105	106	99.0

package Promises6;
use Evo -modern;
use Exporter 'import';
use Promises6::Util ':all';
use Promises6::Evo::Builder;

our $VERSION = '0.008';    # VERSION
my @DSL = qw(when_ok when_rejected when_progress promise then);
our @EXPORT_OK = (@DSL, qw(deferred resolved rejected all race));
our %EXPORT_TAGS = (all => \@EXPORT_OK, dsl => \@DSL);
sub deferred { Promises6::Evo::Builder->singleton->deferred() }

# dsl
sub then {
  my $dsl = Evo::dep_single 'Evo::Dsl';
  $dsl->stash->{'promise'} = $dsl->stash->{'promise'}->then(@_);
}
sub when_ok : prototype(&)       { then(shift, undef, undef) }
sub when_rejected : prototype(&) { then(undef, shift, undef) }
sub when_progress : prototype(&) { then(undef, undef, shift) }

# es6 mozilla all
# resolve all in the same order or reject immidiately with reason
# if one of promises is rejected
sub all(@promises) {
  my $total = @promises;
  my $d     = deferred;

  my ($counter, $i, @results) = (0, 0);
  foreach my $cur (@promises) {
    my $cur_i = $i;
    my $p = is_promise($cur) ? $cur : resolved($cur);
    $p->then(
      sub {
        $results[$cur_i] = shift;
        $d->resolve(\@results) unless ++$counter < $total;
      },
      sub { $d->reject(shift) }
    );
    $i++;

    # already can be rejected
    last unless $d->state == PENDING;
  }

  $d->promise;
}

# es6 mozilla race
# first who rejects or resolves a promise gets a prize
sub race(@promises) {
  my $total = @promises;
  my $d     = deferred;

  foreach my $cur (@promises) {
    my $p = is_promise($cur) ? $cur : resolved($cur);
    $p->then(sub { $d->resolve(shift) }, sub { $d->reject(shift) });

    # already can be resolved
    last unless $d->state == PENDING;
  }

  $d->promise;
}

sub promise : prototype(&) {
  my $cb      = shift;
  my $d       = deferred;
  my $resolve = sub { $d->resolve($_[0]) };
  my $reject  = sub { $d->reject($_[0]) };
  my $notify  = sub { $d->notify($_[0]) };

  my $promise = $d->promise;
  my $dsl     = Evo::dep_single('Evo::Dsl');
  $dsl->call(
    {promise => $d->promise},
    $resolve, $reject, $notify,
    sub {
      $cb->($resolve, $reject, $notify);
      $promise = $dsl->stash('promise');
    }
  );

  return $promise;
}

sub resolved : prototype($) {
  my $val = shift;
  deferred->resolve($val)->promise;
}

sub rejected : prototype($) {
  my $reason = shift;
  Carp::croak("Provide a reason, not a promise") if is_promise($reason);
  deferred->reject($reason)->promise;
}

1;

# ABSTRACT: Promises6 - Promises/A+ with DSL, ES6 syntax and progress notifications

__END__