Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
proof of concept for Promises/A+ in Mojolicious (Mojo::IOLoop::Delay:…
…:all is missing and there is no handling of return values from ->then callbacks or exceptions in ->then callbacks)
  • Loading branch information
kraih committed Oct 22, 2017
1 parent ae7db3f commit 8e14c2d
Show file tree
Hide file tree
Showing 3 changed files with 123 additions and 12 deletions.
6 changes: 2 additions & 4 deletions lib/Mojo/IOLoop.pm
Expand Up @@ -406,10 +406,8 @@ takes the same arguments as L<Mojo::IOLoop::Client/"connect">.
my $delay = $loop->delay(sub {...});
my $delay = $loop->delay(sub {...}, sub {...});
Build L<Mojo::IOLoop::Delay> object to manage callbacks and control the flow of
events for this event loop, which can help you avoid deep nested closures that
often result from continuation-passing style. Callbacks will be passed along to
L<Mojo::IOLoop::Delay/"steps">.
Build L<Mojo::IOLoop::Delay> object to use as a promise or for flow-control.
Callbacks will be passed along to L<Mojo::IOLoop::Delay/"steps">.
# Synchronize multiple non-blocking operations
my $delay = Mojo::IOLoop->delay(sub { say 'BOOM!' });
Expand Down
74 changes: 66 additions & 8 deletions lib/Mojo/IOLoop/Delay.pm
Expand Up @@ -3,6 +3,7 @@ use Mojo::Base 'Mojo::EventEmitter';

use Mojo::IOLoop;
use Mojo::Util;
use Scalar::Util 'weaken';

has ioloop => sub { Mojo::IOLoop->singleton };
has remaining => sub { [] };
Expand All @@ -18,12 +19,39 @@ sub data { Mojo::Util::_stash(data => @_) }

sub pass { $_[0]->begin->(@_) }

sub race {
my $self = shift;
my $next = $self->_clone;
$_->then(sub { $next->resolve(@_) }, sub { $next->reject(@_) }) for $self, @_;
return $next;
}

sub reject { shift->_finish(error => @_) }
sub resolve { shift->_finish(finish => @_) }

sub steps {
my $self = shift->remaining([@_]);
$self->ioloop->next_tick($self->begin);
return $self;
}

sub then {
my ($self, $finish, $error) = @_;

my $next = $self->_clone;
$self->once(finish => sub { shift; $next->resolve(@_) });
$self->once(error => sub { shift; $next->reject(@_) });
$next->once(finish => sub { shift; $finish->(@_) }) if $finish;
$next->once(error => sub { shift; $error->(@_) }) if $error;

return $next unless $self->{settled};

my $method = $self->{error} ? 'reject' : 'resolve';
my $args = $self->{error} || $self->{finish};
$next->ioloop->next_tick(sub { $next->$method(@$args) });
return $next;
}

sub wait {
my $self = shift;
return if $self->ioloop->is_running;
Expand All @@ -32,24 +60,37 @@ sub wait {
$self->ioloop->start;
}

sub _clone {
my $self = shift;
my $clone = $self->new;
weaken $clone->ioloop($self->ioloop)->{ioloop};
return $clone;
}

sub _die { $_[0]->has_subscribers('error') ? $_[0]->ioloop->stop : die $_[1] }

sub _finish {
my ($self, $event) = (shift, shift);
$self->{settled} ? return $self : $self->{settled}++;
$self->{$event} = [@_];
return $self->remaining([])->emit($event => @_);
}

sub _step {
my ($self, $id, $offset, $len) = (shift, shift, shift, shift);

$self->{args}[$id]
= [@_ ? defined $len ? splice @_, $offset, $len : splice @_, $offset : ()];
return $self if $self->{fail} || --$self->{pending} || $self->{lock};
return $self if $self->{settled} || --$self->{pending} || $self->{lock};
local $self->{lock} = 1;
my @args = map {@$_} @{delete $self->{args}};

$self->{counter} = 0;
if (my $cb = shift @{$self->remaining}) {
eval { $self->$cb(@args); 1 }
or (++$self->{fail} and return $self->remaining([])->emit(error => $@));
eval { $self->$cb(@args); 1 } or $self->reject($@);
}

return $self->remaining([])->emit(finish => @args) unless $self->{counter};
return $self->resolve(@args) unless $self->{counter};
$self->ioloop->next_tick($self->begin) unless $self->{pending};
return $self;
}
Expand All @@ -60,7 +101,7 @@ sub _step {
=head1 NAME
Mojo::IOLoop::Delay - Manage callbacks and control the flow of events
Mojo::IOLoop::Delay - Promises/A+ and flow-control helpers
=head1 SYNOPSIS
Expand Down Expand Up @@ -120,9 +161,10 @@ Mojo::IOLoop::Delay - Manage callbacks and control the flow of events
=head1 DESCRIPTION
L<Mojo::IOLoop::Delay> manages callbacks and controls the flow of events for
L<Mojo::IOLoop>, which can help you avoid deep nested closures that often
result from continuation-passing style.
L<Mojo::IOLoop::Delay> is a Perl-ish implementation of
L<Promises/A+|https://promisesaplus.com> and provides flow-control helpers for
L<Mojo::IOLoop>, which can help you avoid deep nested closures that often result
from continuation-passing style.
use Mojo::IOLoop;
Expand Down Expand Up @@ -304,6 +346,18 @@ next step.
# Longer version
$delay->begin(0)->(@args);
=head2 race
my $thenable = $delay->race(@thenables);
=head2 reject
$delay = $delay->reject(@args);
=head2 resolve
$delay = $delay->resolve(@args);
=head2 steps
$delay = $delay->steps(sub {...}, sub {...});
Expand All @@ -314,6 +368,10 @@ unless it is delayed by incrementing the event counter. This chain will continue
until there are no L</"remaining"> callbacks, a callback does not increment the
event counter or an exception gets thrown in a callback.
=head2 then
my $thenable = $delay->then(sub {...}, sub {...});
=head2 wait
$delay->wait;
Expand Down
55 changes: 55 additions & 0 deletions t/mojo/delay.t
Expand Up @@ -20,6 +20,61 @@ $end2->();
$delay->wait;
is_deeply \@results, [1, 1], 'right results';

# Thenable
my ($resolve, $reject, $resolve2, $reject2);
$delay = Mojo::IOLoop::Delay->new;
my $delay2 = $delay->then(sub { $resolve = shift }, sub { $reject = shift });
$delay2->then(sub { $resolve2 = shift }, sub { $reject2 = shift });
$delay->resolve('works');
is $resolve, 'works', 'promise was resolved';
is $resolve2, 'works', 'promise was resolved';
is $reject, undef, 'promise was not rejected';
is $reject2, undef, 'promise was not rejected';

# Thenable (race)
($resolve, $reject) = ();
my $promise = Mojo::IOLoop::Delay->new;
my $promise2 = Mojo::IOLoop::Delay->new;
my $promise3 = Mojo::IOLoop::Delay->new;
$promise->race($promise2, $promise3)
->then(sub { $resolve = shift }, sub { $reject = shift });
$promise->resolve('first');
$promise2->resolve('second');
$promise3->resolve('third');
is $resolve, 'first', 'promise was resolved';
is $reject, undef, 'promise was not rejected';
($resolve, $reject) = ();
$promise = Mojo::IOLoop::Delay->new;
$promise2 = Mojo::IOLoop::Delay->new;
$promise3 = Mojo::IOLoop::Delay->new;
$promise->race($promise2, $promise3)
->then(sub { $resolve = shift }, sub { $reject = shift });
$promise3->reject('third');
$promise->reject('first');
$promise2->reject('second');
is $resolve, undef, 'promise was not resolved';
is $reject, 'third', 'promise was rejected';

# Thenable (already settled)
($resolve, $reject) = ();
$delay = Mojo::IOLoop::Delay->new;
$delay->resolve('works');
$delay->then(sub { $resolve = shift }, sub { $reject = shift });
is $resolve, undef, 'no value';
is $reject, undef, 'no value';
$delay->ioloop->one_tick;
is $resolve, 'works', 'right value';
is $reject, undef, 'no value';
($resolve, $reject) = ();
$delay = Mojo::IOLoop::Delay->new->catch(sub { });
$delay->reject('works too');
$delay->then(sub { $resolve = shift }, sub { $reject = shift });
is $resolve, undef, 'no value';
is $reject, undef, 'no value';
$delay->ioloop->one_tick;
is $resolve, undef, 'no value';
is $reject, 'works too', 'right value';

# Argument splicing
$delay = Mojo::IOLoop::Delay->new;
Mojo::IOLoop->next_tick($delay->begin);
Expand Down

0 comments on commit 8e14c2d

Please sign in to comment.