docs
[gitmo/Moose-Autobox.git] / lib / Moose / Autobox / Array.pm
CommitLineData
5f654d8e 1package Moose::Autobox::Array;
2use Moose::Role 'with';
7fc99864 3use Perl6::Junction;
7dad2765 4use Moose::Autobox;
5f654d8e 5
e3598a18 6our $VERSION = '0.10';
5f654d8e 7
e6bb88b0 8with 'Moose::Autobox::Ref',
31d40d73 9 'Moose::Autobox::List',
10 'Moose::Autobox::Indexed';
6cf5bcf2 11
12## Array Interface
13
14sub pop {
15 my ($array) = @_;
16 CORE::pop @$array;
17}
18
19sub push {
20 my ($array, @rest) = @_;
21 CORE::push @$array, @rest;
22 $array;
23}
24
25sub unshift {
26 my ($array, @rest) = @_;
27 CORE::unshift @$array, @rest;
28 $array;
29}
5f654d8e 30
6cf5bcf2 31sub delete {
32 my ($array, $index) = @_;
33 CORE::delete $array->[$index];
34}
35
36sub shift {
37 my ($array) = @_;
38 CORE::shift @$array;
c11e6a74 39}
40
41sub slice {
42 my ($array, $indicies) = @_;
43 [ @{$array}[ @{$indicies} ] ];
44}
6cf5bcf2 45
46# NOTE:
47# sprintf args need to be reversed,
48# because the invocant is the array
49sub sprintf { CORE::sprintf $_[1], @{$_[0]} }
50
51## ::List interface implementation
52
53sub head { $_[0]->[0] }
54sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
e6bb88b0 55
5f654d8e 56sub length {
57 my ($array) = @_;
58 CORE::scalar @$array;
59}
60
61sub grep {
62 my ($array, $sub) = @_;
63 [ CORE::grep { $sub->($_) } @$array ];
64}
65
66sub map {
67 my ($array, $sub) = @_;
68 [ CORE::map { $sub->($_) } @$array ];
69}
70
71sub join {
feffe00c 72 my ($array, $sep) = @_;
73 $sep ||= '';
5f654d8e 74 CORE::join $sep, @$array;
75}
76
77sub reverse {
78 my ($array) = @_;
e6bb88b0 79 [ CORE::reverse @$array ];
5f654d8e 80}
81
82sub sort {
83 my ($array, $sub) = @_;
84 $sub ||= sub { $a cmp $b };
85 [ CORE::sort { $sub->($a, $b) } @$array ];
5dc78481 86}
87
260cc81f 88## ::Indexed implementation
5dc78481 89
260cc81f 90sub at {
91 my ($array, $index) = @_;
92 $array->[$index];
93}
5dc78481 94
260cc81f 95sub put {
96 my ($array, $index, $value) = @_;
97 $array->[$index] = $value;
98}
5dc78481 99
6cf5bcf2 100sub exists {
101 my ($array, $index) = @_;
102 CORE::exists $array->[$index];
103}
5dc78481 104
105sub keys {
106 my ($array) = @_;
107 [ 0 .. $#{$array} ];
108}
109
110sub values {
111 my ($array) = @_;
112 [ @$array ];
113}
114
115sub kv {
116 my ($array) = @_;
feffe00c 117 $array->keys->map(sub { [ $_, $array->[$_] ] });
5dc78481 118}
e6bb88b0 119
2dcdd7d7 120sub each {
121 my ($array, $sub) = @_;
122 for my $i (0 .. $#$array) {
123 $sub->($i, $array->[ $i ]);
124 }
125}
126
127sub each_key {
128 my ($array, $sub) = @_;
2224d5b4 129 $sub->($_) for (0 .. $#$array);
2dcdd7d7 130}
131
132sub each_value {
133 my ($array, $sub) = @_;
134 $sub->($_) for @$array;
135}
136
137# end indexed
138
2197a7c0 139sub flatten {
140 @{$_[0]}
141}
142
e477b088 143sub _flatten_deep {
144 my @array = @_;
145 my $depth = CORE::pop @array;
146 --$depth if (defined($depth));
147
148 CORE::map {
149 (ref eq 'ARRAY')
150 ? (defined($depth) && $depth == -1) ? $_ : _flatten_deep( @$_, $depth )
151 : $_
152 } @array;
153
154}
155
156sub flatten_deep {
157 my ($array, $depth) = @_;
158 [ _flatten_deep(@$array, $depth) ];
159}
160
7fc99864 161## Junctions
162
163sub all {
164 my ($array) = @_;
aaf111de 165 return Perl6::Junction::all(@$array);
7fc99864 166}
167
168sub any {
169 my ($array) = @_;
aaf111de 170 return Perl6::Junction::any(@$array);
7fc99864 171}
172
173sub none {
174 my ($array) = @_;
aaf111de 175 return Perl6::Junction::none(@$array);
7fc99864 176}
177
178sub one {
179 my ($array) = @_;
aaf111de 180 return Perl6::Junction::one(@$array);
7fc99864 181}
182
3f4dd8b7 183## Print
184
185sub print { CORE::print @{$_[0]} }
186sub say { CORE::print @{$_[0]}, "\n" }
187
5f654d8e 1881;
31d40d73 189
190__END__
191
192=pod
193
194=head1 NAME
195
196Moose::Autobox::Array - the Array role
197
198=head1 SYNOPOSIS
199
200 use Moose::Autobox;
31d40d73 201
5272f13f 202 [ 1..5 ]->isa('ARRAY'); # true
203 [ a..z ]->does('Moose::Autobox::Array'); # true
204 [ 0..2 ]->does('Moose::Autobox::List'); # true
205
31d40d73 206 print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', ');
5272f13f 207
208 print [ 1, 'number' ]->sprintf('%d is the loneliest %s');
f6e003cc 209
210 print ([ 1 .. 5 ]->any == 3) ? 'true' : 'false'; # prints 'true'
31d40d73 211
212=head1 DESCRIPTION
213
8937074a 214This is a role to describe operations on the Array type.
215
260cc81f 216=head1 METHODS
217
218=over 4
219
260cc81f 220=item B<pop>
221
5272f13f 222=item B<push ($value)>
260cc81f 223
224=item B<shift>
225
5272f13f 226=item B<unshift ($value)>
260cc81f 227
5272f13f 228=item B<delete ($index)>
260cc81f 229
5272f13f 230=item B<sprintf ($format_string)>
260cc81f 231
c11e6a74 232=item B<slice (@indices)>
233
2197a7c0 234=item B<flatten>
235
e477b088 236=item B<flatten_deep ($depth)>
237
260cc81f 238=back
239
5272f13f 240=head2 Indexed implementation
260cc81f 241
242=over 4
243
5272f13f 244=item B<at ($index)>
260cc81f 245
5272f13f 246=item B<put ($index, $value)>
260cc81f 247
5272f13f 248=item B<exists ($index)>
260cc81f 249
250=item B<keys>
251
260cc81f 252=item B<values>
253
5272f13f 254=item B<kv>
255
c0ab09e3 256=item B<each>
257
258=item B<each_key>
259
260=item B<each_value>
261
260cc81f 262=back
263
5272f13f 264=head2 List implementation
260cc81f 265
266=over 4
267
268=item B<head>
269
270=item B<tail>
271
5272f13f 272=item B<join (?$seperator)>
260cc81f 273
274=item B<length>
275
5272f13f 276=item B<map (\&block)>
260cc81f 277
5272f13f 278=item B<grep (\&block)>
260cc81f 279
09a0196c 280Note that, in both the above, $_ is in scope within the code block, as well as
281being passed as $_[0]. As per CORE::map and CORE::grep, $_ is an alias to
282the list value, so can be used to to modify the list, viz:
283
284 use Moose::Autobox;
285
286 my $foo = [1, 2, 3];
287 $foo->map( sub {$_++} );
288 print $foo->dump;
289
290yields
291
292 $VAR1 = [
293 2,
294 3,
295 4
296 ];
297
260cc81f 298=item B<reverse>
299
5272f13f 300=item B<sort (?\&block)>
301
302=back
303
7fc99864 304=head2 Junctions
305
306=over 4
307
308=item B<all>
309
310=item B<any>
311
312=item B<none>
313
314=item B<one>
315
316=back
317
5272f13f 318=over 4
319
320=item B<meta>
260cc81f 321
3f4dd8b7 322=item B<print>
323
324=item B<say>
325
260cc81f 326=back
327
31d40d73 328=head1 BUGS
329
330All complex software has bugs lurking in it, and this module is no
331exception. If you find a bug please either email me, or add the bug
332to cpan-RT.
333
334=head1 AUTHOR
335
336Stevan Little E<lt>stevan@iinteractive.comE<gt>
337
338=head1 COPYRIGHT AND LICENSE
339
ea4e64bf 340Copyright 2006-2008 by Infinity Interactive, Inc.
31d40d73 341
342L<http://www.iinteractive.com>
343
344This library is free software; you can redistribute it and/or modify
345it under the same terms as Perl itself.
346
f6e003cc 347=cut