Skip to content

Instantly share code, notes, and snippets.

@hoehrmann
Created April 16, 2013 00:03
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save hoehrmann/5392308 to your computer and use it in GitHub Desktop.
Save hoehrmann/5392308 to your computer and use it in GitHub Desktop.
#####################################################################
#
#####################################################################
package Acme::IEnumerable::List;
use Modern::Perl;
use base qw/Acme::IEnumerable/;
use Carp;
sub _create {
bless {
_list => $_[0],
_new => $_[1],
}, __PACKAGE__;
}
sub count {
scalar @{ $_[0]->{_list} };
}
sub element_at {
my ($self, $index) = @_;
Carp::cluck unless defined $index;
croak unless $self->count > $index;
$self->{_list}->[$index];
}
sub last {
my ($self) = @_;
croak unless $self->count;
$self->{_list}->[-1]
}
sub last_or_default {
my ($self, $default) = @_;
return $default unless $self->count;
$self->{_list}->[-1]
}
sub first {
my ($self) = @_;
croak "No elements for 'first'" unless $self->count;
$self->{_list}->[0]
}
sub first_or_default {
my ($self, $default) = @_;
return $default unless $self->count;
$self->{_list}->[0]
}
sub from_list {
my $class = shift;
my @list = @_;
return _create \@list, sub {
return sub {
state $index = 0;
return unless $index <= $#list;
return \($list[$index++]);
};
};
}
sub skip {
my ($self, $count) = @_;
return Acme::IEnumerable::_create(sub {
return sub {
state $index = $count;
return unless $index < @{ $self->{_list} };
return \($self->{_list}->[$index++]);
};
});
}
sub reverse {
my ($self) = @_;
return Acme::IEnumerable::_create(sub {
return sub {
state $index = @{ $self->{_list} } - 1;
return if $index < 0;
return \($self->{_list}->[$index--]);
};
});
}
#####################################################################
#
#####################################################################
sub find { ... }
sub find_index { ... }
sub find_last { ... }
sub find_last_idex { ... }
sub exists { ... }
sub find_all { ... }
sub binary_search { ... }
sub index_of { ... }
sub last_index_of { ... }
1;
#####################################################################
#
#####################################################################
package Acme::IEnumerable::Ordered;
use Modern::Perl;
use base qw/Acme::IEnumerable/;
sub _create {
bless {
_key => $_[0],
_sgn => $_[1],
_par => $_[2],
_new => $_[3],
}, __PACKAGE__;
}
sub order_by {
# This assumes to_enumerable will remove the ::Ordered base type
my ($self) = @_;
$self->to_enumerable->order_by(@_);
}
sub order_by_descending {
# This assumes to_enumerable will remove the ::Ordered base type
my ($self) = @_;
$self->to_enumerable->order_by_descending(@_);
}
sub then_by_descending {
_then_by(@_[0..1], -1);
}
sub then_by {
_then_by(@_[0..1], 1);
}
sub _then_by {
my ($self, $key_extractor, $sign) = @_;
return _create $key_extractor, $sign, $self, sub {
my $top = $self;
my @ext = $key_extractor;
my @sgn = $sign;
for (my $c = $self; $c->isa(__PACKAGE__); $c = $c->{_par}) {
$top = $c;
unshift @ext, $c->{_key};
unshift @sgn, $c->{_sgn};
}
my @list = $top->to_perl;
# This is not written with efficiency in mind.
my @ordered = sort {
my $cmp = 0;
for (my $ix = 0; $ix < @ext; ++$ix) {
my $ext = $ext[$ix];
my $k1 = do { local $_ = $a; $ext->($_) };
my $k2 = do { local $_ = $b; $ext->($_) };
$cmp = $sgn[$ix] * ($k1 <=> $k2);
last if $cmp;
};
return $cmp;
} @list;
return Acme::IEnumerable->from_list(@ordered)->new;
};
}
#####################################################################
#
#####################################################################
package Acme::IEnumerable::Grouping;
use Modern::Perl;
use base qw/Acme::IEnumerable/;
sub from_list {
my $class = shift;
my $key = shift;
my $self = Acme::IEnumerable->from_list(@_);
$self->{key} = $key;
bless $self, __PACKAGE__;
}
sub key { $_[0]->{key} }
1;
#####################################################################
#
#####################################################################
package Acme::IEnumerable;
use Modern::Perl;
use Carp;
do {
no warnings 'once';
*from_list = \&Acme::IEnumerable::List::from_list;
*to_array = \&Acme::IEnumerable::to_perl;
*order_by = \&Acme::IEnumerable::Ordered::then_by;
*order_by_descending =
\&Acme::IEnumerable::Ordered::then_by_descending;
};
sub _create {
bless {
_new => $_[0],
}, __PACKAGE__;
}
sub new { $_[0]->{_new}->() }
sub range {
my ($class, $from, $count) = @_;
if (defined $count) {
...
}
return _create sub {
return sub {
state $counter = $from // 0;
return \($counter++);
};
};
}
sub take {
my ($self, $count) = @_;
return _create sub {
return sub {
state $left = $count;
return unless $left;
$left--;
state $base = $self->new();
my $item = $base->();
return unless ref $item;
return $item;
};
};
}
sub take_until {
my ($self, $predicate) = @_;
return $self->take_while(sub {
!$predicate->($_);
});
}
sub take_while {
my ($self, $predicate) = @_;
return _create sub {
return sub {
state $base = $self->new();
my $item = $base->();
return unless ref $item;
local $_ = $$item;
return unless $predicate->($_);
return $item;
};
};
}
sub group_by {
my ($self, $key_extractor) = @_;
return _create sub {
my $base = $self->new;
my %temp;
while (1) {
my $item = $base->();
last unless ref $item;
local $_ = $$item;
my $key = $key_extractor->($_);
push @{ $temp{$key} }, $_;
}
my @temp = map {
Acme::IEnumerable::Grouping->from_list($_, @{$temp{$_}})
} keys %temp;
return Acme::IEnumerable->from_list(@temp)->new;
};
}
sub stack_by {
my ($self, $key_extractor) = @_;
return _create sub {
# TODO: make this more lazy?
my $base = $self->new;
my @list;
while (1) {
my $item = $base->();
last unless ref $item;
local $_ = $$item;
my $key = $key_extractor->($_);
if (not @list or $key ne $list[-1]->{key}) {
push @list, {
key => $key,
};
}
push @{ $list[-1]->{value} }, $_;
}
my @temp = map {
Acme::IEnumerable::Grouping->from_list($_->{key}, @{ $_->{value} })
} @list;
return Acme::IEnumerable->from_list(@temp)->new;
};
}
sub skip {
my ($self, $count) = @_;
return _create sub {
return sub {
state $base = $self->new();
state $left = $count;
while ($left) {
my $item = $base->();
return unless ref $item;
$left--;
}
return $base->();
};
};
}
sub skip_while {
my ($self, $predicate) = @_;
return _create sub {
return sub {
state $base = $self->new();
state $skip = 1;
while ($skip) {
my $item = $base->();
return unless ref $item;
local $_ = $$item;
$skip &= !! $predicate->($_);
return $item unless $skip;
}
return $base->();
};
}
}
sub element_at {
my ($self, $index) = @_;
croak "Index out of range for element_at" if $index < 0;
my $base = $self->new();
while (1) {
my $item = $base->();
croak "Index out of range for element_at" unless ref $item;
return $$item unless $index--;
}
Carp::confess("Impossible");
}
sub last {
my ($self) = @_;
my $base = $self->new();
my $last;
while (1) {
my $item = $base->();
croak unless ref $item or ref $last;
return $$last unless ref $item;
$last = $item;
}
Carp::confess("Impossible");
}
sub first {
$_[0]->element_at(0);
}
sub first_or_default {
my ($self, $default) = @_;
my $base = $self->new();
my $item = $base->();
return $default unless ref $item;
return $$item;
}
sub last_or_default {
my ($self, $default) = @_;
my $base = $self->new();
my $item = $base->();
return $default unless ref $item;
while (1) {
my $next = $base->();
return $$item unless ref $next;
$item = $next;
}
}
sub count {
my ($self, $predicate) = @_;
$predicate //= sub { 1 };
my $base = $self->new();
while (1) {
state $counter = 0;
my $item = $base->();
return $counter unless ref $item;
local $_ = $$item;
$counter += !! $predicate->($_);
}
Carp::confess("Impossible");
}
sub select {
my ($self, $projection) = @_;
return _create sub {
return sub {
state $base = $self->new();
my $item = $base->();
return unless ref $item;
local $_ = $$item;
return \($projection->($_));
};
};
}
sub where {
my ($self, $predicate) = @_;
return _create sub {
return sub {
state $base = $self->new();
while (1) {
my $item = $base->();
return unless ref $item;
local $_ = $$item;
next unless $predicate->($_);
return $item;
}
};
};
}
sub zip {
my ($self, $other) = @_;
return _create sub {
return sub {
state $base1 = $self->new();
state $base2 = $other->new();
while (1) {
my $item1 = $base1->();
return unless ref $item1;
my $item2 = $base2->();
return unless ref $item2;
return \[$$item1, $$item2]
}
};
};
}
sub pairwise {
# TODO: make variant with a seed?
my ($self, $func) = @_;
return $self->each_cons(2, $func);
...;
my $base = $self->new();
my $prev = $base->();
return unless ref $prev;
while (1) {
my $curr = $base->();
return unless ref $curr;
$func->($$prev, $$curr);
$prev = $curr;
}
Carp::confess("Impossible");
}
sub each_cons {
my ($self, $count, $func) = @_;
my $base = $self->new();
my @prev;
while ($count-- > 1) {
my $prev = $base->();
return unless ref $prev;
push @prev, $$prev;
}
while (1) {
my $curr = $base->();
return unless ref $curr;
$func->(@prev, $$curr);
push @prev, $$curr;
shift @prev;
}
Carp::confess("Impossible");
}
sub aggregate {
my $self = shift;
my $base = $self->new();
my ($func, $seed);
if (@_ == 1) {
$func = shift;
my $item = $base->();
croak unless ref $item;
$seed = $$item;
} elsif (@_ == 2) {
$seed = shift;
$func = shift;
} else {
...
}
while (1) {
my $item = $base->();
return $seed unless ref $item;
$seed = $func->($seed, $$item);
}
Carp::confess("Impossible");
}
sub average {
my ($self) = @_;
my $base = $self->new();
my $item = $base->();
return unless ref $item;
my $count = 0;
my $total = 0;
while (1) {
$total += $$item;
$count += 1;
$item = $base->();
return $total/$count unless ref $item;
}
}
sub min {
my ($self) = @_;
return $self->aggregate(sub {
$_[0] < $_[1] ? $_[0] : $_[1]
});
}
sub max {
my ($self) = @_;
return $self->aggregate(sub {
$_[0] > $_[1] ? $_[0] : $_[1]
});
}
sub all {
my ($self, $predicate) = @_;
my $base = $self->new();
while (1) {
my $item = $base->();
return 1 unless ref $item;
local $_ = $$item;
return 0 unless $predicate->($_);
}
Carp::confess("Impossible");
}
sub allplus {
my ($self, $predicate) = @_;
my $base = $self->new();
my $okay = 0;
while (1) {
my $item = $base->();
return $okay unless ref $item;
local $_ = $$item;
$okay = $predicate->($_);
return 0 unless $okay;
}
Carp::confess("Impossible");
}
sub any {
my ($self, $predicate) = @_;
$predicate //= sub { 1 };
my $base = $self->new();
while (1) {
my $item = $base->();
return 0 unless ref $item;
local $_ = $$item;
return 1 if $predicate->($_);
}
Carp::confess("Impossible");
}
sub reverse {
my $self = shift;
Acme::IEnumerable->from_list(reverse $self->to_perl);
}
sub sum {
my $self = shift;
return $self->aggregate(0, sub { $_[0] + $_[1] });
}
sub to_perl {
my $self = shift;
my @result;
my $enum = $self->new();
for (my $item = $enum->(); ref $item; $item = $enum->()) {
push @result, $$item;
}
@result;
}
sub to_list {
my ($self) = @_;
Acme::IEnumerable->from_list($self->to_perl);
}
sub for_each {
my ($self, $action) = @_;
my $enum = $self->new();
for (my $item = $enum->(); ref $item; $item = $enum->()) {
local $_ = $$item;
$action->($_);
}
}
#####################################################################
#
#####################################################################
sub select_many { ... }
sub contains { ... }
sub sequence_equal { ... }
sub distinct { ... }
sub union { ... }
sub except { ... }
sub intersect { ... }
sub default_if_empty { ... }
sub single_or_default { ... }
sub concat { ... }
sub group_join { ... }
sub join { ... }
sub empty { ... }
sub cast { ... }
sub to_lookup { ...}
sub to_dictionary { ... }
#####################################################################
#
#####################################################################
sub distinct_by { ... }
sub min_by { ... }
sub max_by { ... }
sub to_enumerable { ... }
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment