[gitmo/Moose-Autobox.git] / lib / Moose / Autobox / Array.pm

package Moose::Autobox::Array;
use Moose::Role 'with';
use Perl6::Junction;
use Moose::Autobox;

our $VERSION = '0.03';

with 'Moose::Autobox::Ref',
     'Moose::Autobox::List',
     'Moose::Autobox::Indexed';
    
## Array Interface

sub pop { 
    my ($array) = @_;    
    CORE::pop @$array; 
}

sub push { 
    my ($array, @rest) = @_;
    CORE::push @$array, @rest;  
    $array; 
}

sub unshift { 
    my ($array, @rest) = @_;    
    CORE::unshift @$array, @rest; 
    $array; 
}

sub delete { 
    my ($array, $index) = @_;    
    CORE::delete $array->[$index];
}

sub shift { 
    my ($array) = @_;    
    CORE::shift @$array; 
}    

sub slice {
    my ($array, $indicies) = @_;
    [ @{$array}[ @{$indicies} ] ];
} 

# NOTE: 
# sprintf args need to be reversed, 
# because the invocant is the array
sub sprintf { CORE::sprintf $_[1], @{$_[0]} }

## ::List interface implementation

sub head { $_[0]->[0] }
sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
 
sub length {
    my ($array) = @_;
    CORE::scalar @$array;
}

sub grep { 
    my ($array, $sub) = @_; 
    [ CORE::grep { $sub->($_) } @$array ]; 
}

sub map { 
    my ($array, $sub) = @_; 
    [ CORE::map { $sub->($_) } @$array ]; 
}

sub join { 
    my ($array, $sep) = @_;    
    $sep ||= ''; 
    CORE::join $sep, @$array; 
}

sub reverse { 
    my ($array) = @_;
    [ CORE::reverse @$array ];
}

sub sort { 
    my ($array, $sub) = @_;     
    $sub ||= sub { $a cmp $b }; 
    [ CORE::sort { $sub->($a, $b) } @$array ]; 
}    

## ::Indexed implementation

sub at {
    my ($array, $index) = @_;
    $array->[$index];
} 

sub put {
    my ($array, $index, $value) = @_;
    $array->[$index] = $value;
}

sub exists {
    my ($array, $index) = @_;    
    CORE::exists $array->[$index];    
}

sub keys { 
    my ($array) = @_;    
    [ 0 .. $#{$array} ];
}

sub values { 
    my ($array) = @_;    
    [ @$array ];
}

sub kv {
    my ($array) = @_;   
    $array->keys->map(sub { [ $_, $array->[$_] ] });
}

sub flatten {
    @{$_[0]}
}

sub _flatten_deep { 
	my @array = @_;
	my $depth = CORE::pop @array;
	--$depth if (defined($depth));
	
	CORE::map {
		(ref eq 'ARRAY')
			? (defined($depth) && $depth == -1) ? $_ : _flatten_deep( @$_, $depth )
			: $_
	} @array;

}

sub flatten_deep { 
	my ($array, $depth) = @_;	
	[ _flatten_deep(@$array, $depth) ];
}

## Junctions

sub all {
    my ($array) = @_;     
    return Perl6::Junction::all(@$array);
}

sub any {
    my ($array) = @_;     
    return Perl6::Junction::any(@$array);
}

sub none {
    my ($array) = @_;     
    return Perl6::Junction::none(@$array);
}

sub one {
    my ($array) = @_; 
    return Perl6::Junction::one(@$array);
}

## Print

sub print { CORE::print @{$_[0]} }
sub say   { CORE::print @{$_[0]}, "\n" }

1;

__END__

=pod

=head1 NAME 

Moose::Autobox::Array - the Array role

=head1 SYNOPOSIS

  use Moose::Autobox;
    
  [ 1..5 ]->isa('ARRAY'); # true
  [ a..z ]->does('Moose::Autobox::Array'); # true
  [ 0..2 ]->does('Moose::Autobox::List'); # true  
    
  print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', ');
  
  print [ 1, 'number' ]->sprintf('%d is the loneliest %s');
  
  print ([ 1 .. 5 ]->any == 3) ? 'true' : 'false'; # prints 'true'

=head1 DESCRIPTION

This is a role to describe operations on the Array type. 

=head1 METHODS

=over 4

=item B<pop>

=item B<push ($value)>

=item B<shift>

=item B<unshift ($value)>

=item B<delete ($index)>

=item B<sprintf ($format_string)>

=item B<slice (@indices)>

=item B<flatten>

=item B<flatten_deep ($depth)>

=back

=head2 Indexed implementation

=over 4

=item B<at ($index)>

=item B<put ($index, $value)>

=item B<exists ($index)>

=item B<keys>

=item B<values>

=item B<kv>

=back

=head2 List implementation

=over 4

=item B<head>

=item B<tail>

=item B<join (?$seperator)>

=item B<length>

=item B<map (\&block)>

=item B<grep (\&block)>

Note that, in both the above, $_ is in scope within the code block, as well as 
being passed as $_[0]. As per CORE::map and CORE::grep, $_ is an alias to 
the list value, so can be used to to modify the list, viz:

    use Moose::Autobox;

    my $foo = [1, 2, 3]; 
    $foo->map( sub {$_++} ); 
    print $foo->dump;

yields

   $VAR1 = [
             2,
             3,
             4
           ];
        
=item B<reverse>

=item B<sort (?\&block)>

=back

=head2 Junctions

=over 4

=item B<all>

=item B<any>

=item B<none>

=item B<one>

=back

=over 4

=item B<meta>

=item B<print>

=item B<say>

=back

=head1 BUGS

All complex software has bugs lurking in it, and this module is no 
exception. If you find a bug please either email me, or add the bug
to cpan-RT.

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2008 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

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