X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FParameterized.pm;h=175c9ab27624765d91b21de8f66731cb1d146003;hb=topic%2Fdocument-instance-role-application;hp=9300d7a0abe584dda50a5d974c9bfadf79f47c5e;hpb=85a9908f23fbb88856149822236cf6844641c699;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Parameterized.pm b/lib/Moose/Meta/TypeConstraint/Parameterized.pm index 9300d7a..175c9ab 100644 --- a/lib/Moose/Meta/TypeConstraint/Parameterized.pm +++ b/lib/Moose/Meta/TypeConstraint/Parameterized.pm @@ -6,16 +6,20 @@ use metaclass; use Scalar::Util 'blessed'; use Moose::Util::TypeConstraints; - -our $VERSION = '0.59'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; +use Moose::Meta::TypeConstraint::Parameterizable; use base 'Moose::Meta::TypeConstraint'; __PACKAGE__->meta->add_attribute('type_parameter' => ( accessor => 'type_parameter', predicate => 'has_type_parameter', + Class::MOP::_definition_context(), +)); + +__PACKAGE__->meta->add_attribute('parameterized_from' => ( + accessor => 'parameterized_from', + predicate => 'has_parameterized_from', + Class::MOP::_definition_context(), )); sub equals { @@ -24,7 +28,7 @@ sub equals { my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); return unless $other->isa(__PACKAGE__); - + return ( $self->type_parameter->equals( $other->type_parameter ) and @@ -34,79 +38,89 @@ sub equals { sub compile_type_constraint { my $self = shift; - - ($self->has_type_parameter) - || Moose->throw_error("You cannot create a Higher Order type without a type parameter"); - + + unless ( $self->has_type_parameter ) { + require Moose; + Moose->throw_error("You cannot create a Higher Order type without a type parameter"); + } + my $type_parameter = $self->type_parameter; - - (blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint')) - || Moose->throw_error("The type parameter must be a Moose meta type"); + + unless ( blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint') ) { + require Moose; + Moose->throw_error("The type parameter must be a Moose meta type"); + } foreach my $type (Moose::Util::TypeConstraints::get_all_parameterizable_types()) { if (my $constraint = $type->generate_constraint_for($self)) { $self->_set_constraint($constraint); - return $self->SUPER::compile_type_constraint; + return $self->SUPER::compile_type_constraint; } } - - # if we get here, then we couldn't + + # if we get here, then we couldn't # find a way to parameterize this type - Moose->throw_error("The " . $self->name . " constraint cannot be used, because " + require Moose; + Moose->throw_error("The " . $self->name . " constraint cannot be used, because " . $self->parent->name . " doesn't subtype or coerce from a parameterizable type."); } -sub create_child_type { - my ($self, %opts) = @_; - return Moose::Meta::TypeConstraint->new(%opts, parent => $self); +sub can_be_inlined { + my $self = shift; + + return + $self->has_parameterized_from + && $self->parameterized_from->has_inline_generator + && $self->type_parameter->can_be_inlined; } -1; +sub inline_environment { + my $self = shift; -__END__ + return { + ($self->has_parameterized_from + ? (%{ $self->parameterized_from->inline_environment }) + : ()), + ($self->has_type_parameter + ? (%{ $self->type_parameter->inline_environment }) + : ()), + }; +} +sub _inline_check { + my $self = shift; -=pod + return unless $self->can_be_inlined; -=head1 NAME + return $self->parameterized_from->generate_inline_for( $self->type_parameter, @_ ); +} -Moose::Meta::TypeConstraint::Parameterized - Higher Order type constraints for Moose +sub create_child_type { + my ($self, %opts) = @_; + return Moose::Meta::TypeConstraint::Parameterizable->new(%opts, parent=>$self); +} -=head1 METHODS +1; -=over 4 +# ABSTRACT: Type constraints with a bound parameter (ArrayRef[Int]) -=item B +__END__ -=item B -=item B +=pod -=item B +=head1 METHODS -=item B +This class is intentionally not documented because the API is +confusing and needs some work. -=item B +=head1 INHERITANCE -=back +C is a subclass of +L. =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 Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-2008 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +See L for details on reporting bugs. =cut