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

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

our $VERSION = '0.02';

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; 
}     

# 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->[$_] ] });
}

## Junctions

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

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

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

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

1;

__END__

=pod

=head1 NAME 

Moose::Autobox::Array - the Array role

=head1 SYNOPOSIS

  use Moose::Autobox;
  use 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)>

=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)>

=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>

=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 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;
252ab1a2	4	use autobox;
5f654d8e	5
f6e003cc	6	our $VERSION = '0.02';
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;
	39	}
	40
	41	# NOTE:
	42	# sprintf args need to be reversed,
	43	# because the invocant is the array
	44	sub sprintf { CORE::sprintf $_[1], @{$_[0]} }
	45
	46	## ::List interface implementation
	47
	48	sub head { $_[0]->[0] }
	49	sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
e6bb88b0	50
5f654d8e	51	sub length {
	52	my ($array) = @_;
	53	CORE::scalar @$array;
	54	}
	55
	56	sub grep {
	57	my ($array, $sub) = @_;
	58	[ CORE::grep { $sub->($_) } @$array ];
	59	}
	60
	61	sub map {
	62	my ($array, $sub) = @_;
	63	[ CORE::map { $sub->($_) } @$array ];
	64	}
	65
	66	sub join {
feffe00c	67	my ($array, $sep) = @_;
feffe00c	68	$sep \|\|= '';
5f654d8e	69	CORE::join $sep, @$array;
	70	}
	71
	72	sub reverse {
	73	my ($array) = @_;
e6bb88b0	74	[ CORE::reverse @$array ];
5f654d8e	75	}
	76
	77	sub sort {
	78	my ($array, $sub) = @_;
	79	$sub \|\|= sub { $a cmp $b };
	80	[ CORE::sort { $sub->($a, $b) } @$array ];
5dc78481	81	}
5dc78481	82
260cc81f	83	## ::Indexed implementation
5dc78481	84
260cc81f	85	sub at {
	86	my ($array, $index) = @_;
	87	$array->[$index];
	88	}
5dc78481	89
260cc81f	90	sub put {
	91	my ($array, $index, $value) = @_;
	92	$array->[$index] = $value;
	93	}
5dc78481	94
6cf5bcf2	95	sub exists {
	96	my ($array, $index) = @_;
	97	CORE::exists $array->[$index];
	98	}
5dc78481	99
	100	sub keys {
	101	my ($array) = @_;
	102	[ 0 .. $#{$array} ];
	103	}
	104
	105	sub values {
	106	my ($array) = @_;
	107	[ @$array ];
	108	}
	109
	110	sub kv {
	111	my ($array) = @_;
feffe00c	112	$array->keys->map(sub { [ $_, $array->[$_] ] });
5dc78481	113	}
e6bb88b0	114
7fc99864	115	## Junctions
	116
	117	sub all {
	118	my ($array) = @_;
	119	return Perl6::Junction::All->all(@$array);
	120	}
	121
	122	sub any {
	123	my ($array) = @_;
	124	return Perl6::Junction::Any->any(@$array);
	125	}
	126
	127	sub none {
	128	my ($array) = @_;
	129	return Perl6::Junction::None->none(@$array);
	130	}
	131
	132	sub one {
	133	my ($array) = @_;
	134	return Perl6::Junction::One->one(@$array);
	135	}
	136
5f654d8e	137	1;
31d40d73	138
	139	__END__
	140
	141	=pod
	142
	143	=head1 NAME
	144
	145	Moose::Autobox::Array - the Array role
	146
	147	=head1 SYNOPOSIS
	148
	149	use Moose::Autobox;
	150	use autobox;
	151
5272f13f	152	[ 1..5 ]->isa('ARRAY'); # true
	153	[ a..z ]->does('Moose::Autobox::Array'); # true
	154	[ 0..2 ]->does('Moose::Autobox::List'); # true
	155
31d40d73	156	print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', ');
5272f13f	157
5272f13f	158	print [ 1, 'number' ]->sprintf('%d is the loneliest %s');
f6e003cc	159
f6e003cc	160	print ([ 1 .. 5 ]->any == 3) ? 'true' : 'false'; # prints 'true'
31d40d73	161
	162	=head1 DESCRIPTION
	163
8937074a	164	This is a role to describe operations on the Array type.
8937074a	165
260cc81f	166	=head1 METHODS
	167
	168	=over 4
	169
260cc81f	170	=item B<pop>
260cc81f	171
5272f13f	172	=item B<push ($value)>
260cc81f	173
	174	=item B<shift>
	175
5272f13f	176	=item B<unshift ($value)>
260cc81f	177
5272f13f	178	=item B<delete ($index)>
260cc81f	179
5272f13f	180	=item B<sprintf ($format_string)>
260cc81f	181
	182	=back
	183
5272f13f	184	=head2 Indexed implementation
260cc81f	185
	186	=over 4
	187
5272f13f	188	=item B<at ($index)>
260cc81f	189
5272f13f	190	=item B<put ($index, $value)>
260cc81f	191
5272f13f	192	=item B<exists ($index)>
260cc81f	193
	194	=item B<keys>
	195
260cc81f	196	=item B<values>
260cc81f	197
5272f13f	198	=item B<kv>
5272f13f	199
260cc81f	200	=back
260cc81f	201
5272f13f	202	=head2 List implementation
260cc81f	203
	204	=over 4
	205
	206	=item B<head>
	207
	208	=item B<tail>
	209
5272f13f	210	=item B<join (?$seperator)>
260cc81f	211
	212	=item B<length>
	213
5272f13f	214	=item B<map (\&block)>
260cc81f	215
5272f13f	216	=item B<grep (\&block)>
260cc81f	217
	218	=item B<reverse>
	219
5272f13f	220	=item B<sort (?\&block)>
	221
	222	=back
	223
7fc99864	224	=head2 Junctions
	225
	226	=over 4
	227
	228	=item B<all>
	229
	230	=item B<any>
	231
	232	=item B<none>
	233
	234	=item B<one>
	235
	236	=back
	237
5272f13f	238	=over 4
	239
	240	=item B<meta>
260cc81f	241
	242	=back
	243
31d40d73	244	=head1 BUGS
	245
	246	All complex software has bugs lurking in it, and this module is no
	247	exception. If you find a bug please either email me, or add the bug
	248	to cpan-RT.
	249
	250	=head1 AUTHOR
	251
	252	Stevan Little E<lt>stevan@iinteractive.comE<gt>
	253
	254	=head1 COPYRIGHT AND LICENSE
	255
	256	Copyright 2006 by Infinity Interactive, Inc.
	257
	258	L<http://www.iinteractive.com>
	259
	260	This library is free software; you can redistribute it and/or modify
	261	it under the same terms as Perl itself.
	262
f6e003cc	263	=cut