[catagits/DOM-Tiny.git] / lib / DOM / Tiny / Collection.pm

package DOM::Tiny::Collection;

use strict;
use warnings;
use Carp 'croak';
use Exporter 'import';
use List::Util;
use Scalar::Util 'blessed';

our @EXPORT_OK = ('c');

sub TO_JSON { [@{shift()}] }

sub c { __PACKAGE__->new(@_) }

sub compact {
  my $self = shift;
  return $self->new(grep { defined && (ref || length) } @$self);
}

sub each {
  my ($self, $cb) = @_;
  return @$self unless $cb;
  my $i = 1;
  $_->$cb($i++) for @$self;
  return $self;
}

sub first {
  my ($self, $cb) = (shift, shift);
  return $self->[0] unless $cb;
  return List::Util::first { $_ =~ $cb } @$self if ref $cb eq 'Regexp';
  return List::Util::first { $_->$cb(@_) } @$self;
}

sub flatten { $_[0]->new(_flatten(@{$_[0]})) }

sub grep {
  my ($self, $cb) = (shift, shift);
  return $self->new(grep { $_ =~ $cb } @$self) if ref $cb eq 'Regexp';
  return $self->new(grep { $_->$cb(@_) } @$self);
}

sub join {
  join $_[1] // '', map {"$_"} @{$_[0]};
}

sub last { shift->[-1] }

sub map {
  my ($self, $cb) = (shift, shift);
  return $self->new(map { $_->$cb(@_) } @$self);
}

sub new {
  my $class = shift;
  return bless [@_], ref $class || $class;
}

sub reduce {
  my $self = shift;
  @_ = (@_, @$self);
  goto &List::Util::reduce;
}

sub reverse { $_[0]->new(reverse @{$_[0]}) }

sub shuffle { $_[0]->new(List::Util::shuffle @{$_[0]}) }

sub size { scalar @{$_[0]} }

sub slice {
  my $self = shift;
  return $self->new(@$self[@_]);
}

sub sort {
  my ($self, $cb) = @_;

  return $self->new(sort @$self) unless $cb;

  my $caller = caller;
  no strict 'refs';
  my @sorted = sort {
    local (*{"${caller}::a"}, *{"${caller}::b"}) = (\$a, \$b);
    $a->$cb($b);
  } @$self;
  return $self->new(@sorted);
}

sub tap {
  my ($self, $cb) = (shift, shift);
  $_->$cb(@_) for $self;
  return $self;
}

sub to_array { [@{shift()}] }

sub uniq {
  my ($self, $cb) = (shift, shift);
  my %seen;
  return $self->new(grep { !$seen{$_->$cb(@_)}++ } @$self) if $cb;
  return $self->new(grep { !$seen{$_}++ } @$self);
}

sub _flatten {
  map { _ref($_) ? _flatten(@$_) : $_ } @_;
}

sub _ref { ref $_[0] eq 'ARRAY' || blessed $_[0] && $_[0]->isa(__PACKAGE__) }

1;

=encoding utf8

=head1 NAME

DOM::Tiny::Collection - Collection

=head1 SYNOPSIS

  use Mojo::Collection;

  # Manipulate collection
  my $collection = Mojo::Collection->new(qw(just works));
  unshift @$collection, 'it';
  say $collection->join("\n");

  # Chain methods
  $collection->map(sub { ucfirst })->shuffle->each(sub {
    my ($word, $num) = @_;
    say "$num: $word";
  });

  # Use the alternative constructor
  use Mojo::Collection 'c';
  c(qw(a b c))->join('/')->url_escape->say;

=head1 DESCRIPTION

L<Mojo::Collection> is an array-based container for collections.

  # Access array directly to manipulate collection
  my $collection = Mojo::Collection->new(1 .. 25);
  $collection->[23] += 100;
  say for @$collection;

=head1 FUNCTIONS

L<Mojo::Collection> implements the following functions, which can be imported
individually.

=head2 c

  my $collection = c(1, 2, 3);

Construct a new array-based L<Mojo::Collection> object.

=head1 METHODS

L<Mojo::Collection> implements the following methods.

=head2 TO_JSON

  my $array = $collection->TO_JSON;

Alias for L</"to_array">.

=head2 compact

  my $new = $collection->compact;

Create a new collection with all elements that are defined and not an empty
string.

  # "0, 1, 2, 3"
  Mojo::Collection->new(0, 1, undef, 2, '', 3)->compact->join(', ');

=head2 each

  my @elements = $collection->each;
  $collection  = $collection->each(sub {...});

Evaluate callback for each element in collection or return all elements as a
list if none has been provided. The element will be the first argument passed
to the callback and is also available as C<$_>.

  # Make a numbered list
  $collection->each(sub {
    my ($e, $num) = @_;
    say "$num: $e";
  });

=head2 first

  my $first = $collection->first;
  my $first = $collection->first(qr/foo/);
  my $first = $collection->first(sub {...});
  my $first = $collection->first($method);
  my $first = $collection->first($method, @args);

Evaluate regular expression/callback for, or call method on, each element in
collection and return the first one that matched the regular expression, or for
which the callback/method returned true. The element will be the first argument
passed to the callback and is also available as C<$_>.

  # Longer version
  my $first = $collection->first(sub { $_->$method(@args) });

  # Find first value that contains the word "mojo"
  my $interesting = $collection->first(qr/mojo/i);

  # Find first value that is greater than 5
  my $greater = $collection->first(sub { $_ > 5 });

=head2 flatten

  my $new = $collection->flatten;

Flatten nested collections/arrays recursively and create a new collection with
all elements.

  # "1, 2, 3, 4, 5, 6, 7"
  Mojo::Collection->new(1, [2, [3, 4], 5, [6]], 7)->flatten->join(', ');

=head2 grep

  my $new = $collection->grep(qr/foo/);
  my $new = $collection->grep(sub {...});
  my $new = $collection->grep($method);
  my $new = $collection->grep($method, @args);

Evaluate regular expression/callback for, or call method on, each element in
collection and create a new collection with all elements that matched the
regular expression, or for which the callback/method returned true. The element
will be the first argument passed to the callback and is also available as
C<$_>.

  # Longer version
  my $new = $collection->grep(sub { $_->$method(@args) });

  # Find all values that contain the word "mojo"
  my $interesting = $collection->grep(qr/mojo/i);

  # Find all values that are greater than 5
  my $greater = $collection->grep(sub { $_ > 5 });

=head2 join

  my $stream = $collection->join;
  my $stream = $collection->join("\n");

Turn collection into string.

  # Join all values with commas
  $collection->join(', ')->say;

=head2 last

  my $last = $collection->last;

Return the last element in collection.

=head2 map

  my $new = $collection->map(sub {...});
  my $new = $collection->map($method);
  my $new = $collection->map($method, @args);

Evaluate callback for, or call method on, each element in collection and create
a new collection from the results. The element will be the first argument
passed to the callback and is also available as C<$_>.

  # Longer version
  my $new = $collection->map(sub { $_->$method(@args) });

  # Append the word "mojo" to all values
  my $mojoified = $collection->map(sub { $_ . 'mojo' });

=head2 new

  my $collection = Mojo::Collection->new(1, 2, 3);

Construct a new array-based L<Mojo::Collection> object.

=head2 reduce

  my $result = $collection->reduce(sub {...});
  my $result = $collection->reduce(sub {...}, $initial);

Reduce elements in collection with callback, the first element will be used as
initial value if none has been provided.

  # Calculate the sum of all values
  my $sum = $collection->reduce(sub { $a + $b });

  # Count how often each value occurs in collection
  my $hash = $collection->reduce(sub { $a->{$b}++; $a }, {});

=head2 reverse

  my $new = $collection->reverse;

Create a new collection with all elements in reverse order.

=head2 slice

  my $new = $collection->slice(4 .. 7);

Create a new collection with all selected elements.

  # "B C E"
  Mojo::Collection->new('A', 'B', 'C', 'D', 'E')->slice(1, 2, 4)->join(' ');

=head2 shuffle

  my $new = $collection->shuffle;

Create a new collection with all elements in random order.

=head2 size

  my $size = $collection->size;

Number of elements in collection.

=head2 sort

  my $new = $collection->sort;
  my $new = $collection->sort(sub {...});

Sort elements based on return value of callback and create a new collection
from the results.

  # Sort values case-insensitive
  my $case_insensitive = $collection->sort(sub { uc($a) cmp uc($b) });

=head2 tap

  $collection = $collection->tap(sub {...});

Alias for L<Mojo::Base/"tap">.

=head2 to_array

  my $array = $collection->to_array;

Turn collection into array reference.

=head2 uniq

  my $new = $collection->uniq;
  my $new = $collection->uniq(sub {...});
  my $new = $collection->uniq($method);
  my $new = $collection->uniq($method, @args);

Create a new collection without duplicate elements, using the string
representation of either the elements or the return value of the
callback/method.

  # Longer version
  my $new = $collection->uniq(sub { $_->$method(@args) });

  # "foo bar baz"
  Mojo::Collection->new('foo', 'bar', 'bar', 'baz')->uniq->join(' ');

  # "[[1, 2], [2, 1]]"
  Mojo::Collection->new([1, 2], [2, 1], [3, 2])->uniq(sub{ $_->[1] })->to_array;

=head1 BUGS

Report any issues on the public bugtracker.

=head1 AUTHOR

Dan Book <dbook@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2015 by Dan Book.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=head1 SEE ALSO

L<Mojo::Collection>
Commit	Line	Data
d6512b50	1	package DOM::Tiny::Collection;
	2
	3	use strict;
	4	use warnings;
	5	use Carp 'croak';
	6	use Exporter 'import';
	7	use List::Util;
	8	use Scalar::Util 'blessed';
	9
	10	our @EXPORT_OK = ('c');
	11
	12	sub TO_JSON { [@{shift()}] }
	13
	14	sub c { __PACKAGE__->new(@_) }
	15
	16	sub compact {
	17	my $self = shift;
	18	return $self->new(grep { defined && (ref \|\| length) } @$self);
	19	}
	20
	21	sub each {
	22	my ($self, $cb) = @_;
	23	return @$self unless $cb;
	24	my $i = 1;
	25	$_->$cb($i++) for @$self;
	26	return $self;
	27	}
	28
	29	sub first {
	30	my ($self, $cb) = (shift, shift);
	31	return $self->[0] unless $cb;
	32	return List::Util::first { $_ =~ $cb } @$self if ref $cb eq 'Regexp';
	33	return List::Util::first { $_->$cb(@_) } @$self;
	34	}
	35
	36	sub flatten { $_[0]->new(_flatten(@{$_[0]})) }
	37
	38	sub grep {
	39	my ($self, $cb) = (shift, shift);
	40	return $self->new(grep { $_ =~ $cb } @$self) if ref $cb eq 'Regexp';
	41	return $self->new(grep { $_->$cb(@_) } @$self);
	42	}
	43
	44	sub join {
	45	join $_[1] // '', map {"$_"} @{$_[0]};
	46	}
	47
	48	sub last { shift->[-1] }
	49
	50	sub map {
	51	my ($self, $cb) = (shift, shift);
	52	return $self->new(map { $_->$cb(@_) } @$self);
	53	}
	54
	55	sub new {
	56	my $class = shift;
	57	return bless [@_], ref $class \|\| $class;
	58	}
	59
	60	sub reduce {
	61	my $self = shift;
	62	@_ = (@_, @$self);
	63	goto &List::Util::reduce;
	64	}
65
66	sub reverse { $_[0]->new(reverse @{$_[0]}) }
67
68	sub shuffle { $_[0]->new(List::Util::shuffle @{$_[0]}) }
69
70	sub size { scalar @{$_[0]} }
71
72	sub slice {
73	my $self = shift;
74	return $self->new(@$self[@_]);
75	}
76
77	sub sort {
78	my ($self, $cb) = @_;
79
80	return $self->new(sort @$self) unless $cb;
81
82	my $caller = caller;
83	no strict 'refs';
84	my @sorted = sort {
85	local ({"${caller}::a"}, {"${caller}::b"}) = (\$a, \$b);
86	$a->$cb($b);
87	} @$self;
88	return $self->new(@sorted);
89	}
90
91	sub tap {
92	my ($self, $cb) = (shift, shift);
93	$_->$cb(@_) for $self;
94	return $self;
95	}
96
97	sub to_array { [@{shift()}] }
98
99	sub uniq {
100	my ($self, $cb) = (shift, shift);
101	my %seen;
102	return $self->new(grep { !$seen{$_->$cb(@_)}++ } @$self) if $cb;
103	return $self->new(grep { !$seen{$_}++ } @$self);
104	}
105
106	sub _flatten {
107	map { _ref($_) ? _flatten(@$_) : $_ } @_;
108	}
109
110	sub _ref { ref $_[0] eq 'ARRAY' \|\| blessed $_[0] && $_[0]->isa(__PACKAGE__) }
111
112	1;
113
114	=encoding utf8
115
116	=head1 NAME
117
118	DOM::Tiny::Collection - Collection
119
120	=head1 SYNOPSIS
121
122	use Mojo::Collection;
123
124	# Manipulate collection
125	my $collection = Mojo::Collection->new(qw(just works));
126	unshift @$collection, 'it';
127	say $collection->join("\n");
128
129	# Chain methods
130	$collection->map(sub { ucfirst })->shuffle->each(sub {
131	my ($word, $num) = @_;
132	say "$num: $word";
133	});
134
135	# Use the alternative constructor
136	use Mojo::Collection 'c';
137	c(qw(a b c))->join('/')->url_escape->say;
138
139	=head1 DESCRIPTION
140
141	L<Mojo::Collection> is an array-based container for collections.
142
143	# Access array directly to manipulate collection
144	my $collection = Mojo::Collection->new(1 .. 25);
145	$collection->[23] += 100;
146	say for @$collection;
147
148	=head1 FUNCTIONS
149
150	L<Mojo::Collection> implements the following functions, which can be imported
151	individually.
152
153	=head2 c
154
155	my $collection = c(1, 2, 3);
156
157	Construct a new array-based L<Mojo::Collection> object.
158
159	=head1 METHODS
160
161	L<Mojo::Collection> implements the following methods.
162
163	=head2 TO_JSON
164
165	my $array = $collection->TO_JSON;
166
167	Alias for L</"to_array">.
168
169	=head2 compact
170
171	my $new = $collection->compact;
172
173	Create a new collection with all elements that are defined and not an empty
174	string.
175
176	# "0, 1, 2, 3"
177	Mojo::Collection->new(0, 1, undef, 2, '', 3)->compact->join(', ');
178
179	=head2 each
180
181	my @elements = $collection->each;
182	$collection = $collection->each(sub {...});
183
184	Evaluate callback for each element in collection or return all elements as a
185	list if none has been provided. The element will be the first argument passed
186	to the callback and is also available as C<$_>.
187
188	# Make a numbered list
189	$collection->each(sub {
190	my ($e, $num) = @_;
191	say "$num: $e";
192	});
193
194	=head2 first
195
196	my $first = $collection->first;
197	my $first = $collection->first(qr/foo/);
198	my $first = $collection->first(sub {...});
199	my $first = $collection->first($method);
200	my $first = $collection->first($method, @args);
201
202	Evaluate regular expression/callback for, or call method on, each element in
203	collection and return the first one that matched the regular expression, or for
204	which the callback/method returned true. The element will be the first argument
205	passed to the callback and is also available as C<$_>.
206
207	# Longer version
208	my $first = $collection->first(sub { $_->$method(@args) });
209
210	# Find first value that contains the word "mojo"
211	my $interesting = $collection->first(qr/mojo/i);
212
213	# Find first value that is greater than 5
214	my $greater = $collection->first(sub { $_ > 5 });
215
216	=head2 flatten
217
218	my $new = $collection->flatten;
219
220	Flatten nested collections/arrays recursively and create a new collection with
221	all elements.
222
223	# "1, 2, 3, 4, 5, 6, 7"
224	Mojo::Collection->new(1, [2, [3, 4], 5, [6]], 7)->flatten->join(', ');
225
226	=head2 grep
227
228	my $new = $collection->grep(qr/foo/);
229	my $new = $collection->grep(sub {...});
230	my $new = $collection->grep($method);
231	my $new = $collection->grep($method, @args);
232
233	Evaluate regular expression/callback for, or call method on, each element in
234	collection and create a new collection with all elements that matched the
235	regular expression, or for which the callback/method returned true. The element
236	will be the first argument passed to the callback and is also available as
237	C<$_>.
238
239	# Longer version
240	my $new = $collection->grep(sub { $_->$method(@args) });
241
242	# Find all values that contain the word "mojo"
243	my $interesting = $collection->grep(qr/mojo/i);
244
245	# Find all values that are greater than 5
246	my $greater = $collection->grep(sub { $_ > 5 });
247
248	=head2 join
249
250	my $stream = $collection->join;
251	my $stream = $collection->join("\n");
252
253	Turn collection into string.
254
255	# Join all values with commas
256	$collection->join(', ')->say;
257
258	=head2 last
259
260	my $last = $collection->last;
261
262	Return the last element in collection.
263
264	=head2 map
265
266	my $new = $collection->map(sub {...});
267	my $new = $collection->map($method);
268	my $new = $collection->map($method, @args);
269
270	Evaluate callback for, or call method on, each element in collection and create
271	a new collection from the results. The element will be the first argument
272	passed to the callback and is also available as C<$_>.
273
274	# Longer version
275	my $new = $collection->map(sub { $_->$method(@args) });
276
277	# Append the word "mojo" to all values
278	my $mojoified = $collection->map(sub { $_ . 'mojo' });
279
280	=head2 new
281
282	my $collection = Mojo::Collection->new(1, 2, 3);
283
284	Construct a new array-based L<Mojo::Collection> object.
285
286	=head2 reduce
287
288	my $result = $collection->reduce(sub {...});
289	my $result = $collection->reduce(sub {...}, $initial);
290
291	Reduce elements in collection with callback, the first element will be used as
292	initial value if none has been provided.
293
294	# Calculate the sum of all values
295	my $sum = $collection->reduce(sub { $a + $b });
296
297	# Count how often each value occurs in collection
298	my $hash = $collection->reduce(sub { $a->{$b}++; $a }, {});
299
300	=head2 reverse
301
302	my $new = $collection->reverse;
303
304	Create a new collection with all elements in reverse order.
305
306	=head2 slice
307
308	my $new = $collection->slice(4 .. 7);
309
310	Create a new collection with all selected elements.
311
312	# "B C E"
313	Mojo::Collection->new('A', 'B', 'C', 'D', 'E')->slice(1, 2, 4)->join(' ');
314
315	=head2 shuffle
316
317	my $new = $collection->shuffle;
318
319	Create a new collection with all elements in random order.
320
321	=head2 size
322
323	my $size = $collection->size;
324
325	Number of elements in collection.
326
327	=head2 sort
328
329	my $new = $collection->sort;
330	my $new = $collection->sort(sub {...});
331
332	Sort elements based on return value of callback and create a new collection
333	from the results.
334
335	# Sort values case-insensitive
336	my $case_insensitive = $collection->sort(sub { uc($a) cmp uc($b) });
337
338	=head2 tap
339
340	$collection = $collection->tap(sub {...});
341
342	Alias for L<Mojo::Base/"tap">.
343
344	=head2 to_array
345
346	my $array = $collection->to_array;
347
348	Turn collection into array reference.
349
350	=head2 uniq
351
352	my $new = $collection->uniq;
353	my $new = $collection->uniq(sub {...});
354	my $new = $collection->uniq($method);
355	my $new = $collection->uniq($method, @args);
356
357	Create a new collection without duplicate elements, using the string
358	representation of either the elements or the return value of the
359	callback/method.
360
361	# Longer version
362	my $new = $collection->uniq(sub { $_->$method(@args) });
363
364	# "foo bar baz"
365	Mojo::Collection->new('foo', 'bar', 'bar', 'baz')->uniq->join(' ');
366
367	# "[[1, 2], [2, 1]]"
368	Mojo::Collection->new([1, 2], [2, 1], [3, 2])->uniq(sub{ $_->[1] })->to_array;
369
370	=head1 BUGS
371
372	Report any issues on the public bugtracker.
373
374	=head1 AUTHOR
375
376	Dan Book <dbook@cpan.org>
377
378	=head1 COPYRIGHT AND LICENSE
379
380	This software is Copyright (c) 2015 by Dan Book.
381
382	This is free software, licensed under:
383
384	The Artistic License 2.0 (GPL Compatible)
385
386	=head1 SEE ALSO
387
388	L<Mojo::Collection>