X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FTypeConstraint%2FParameterized.pm;h=175c9ab27624765d91b21de8f66731cb1d146003;hb=HEAD;hp=1cfbbde3742fdbe5d5afce27988511cc3330aeed;hpb=baf46b9edc7dc3665c7eaf9d1684b157efb09e1a;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Parameterized.pm b/lib/Moose/Meta/TypeConstraint/Parameterized.pm index 1cfbbde..175c9ab 100644 --- a/lib/Moose/Meta/TypeConstraint/Parameterized.pm +++ b/lib/Moose/Meta/TypeConstraint/Parameterized.pm @@ -8,15 +8,18 @@ use Scalar::Util 'blessed'; use Moose::Util::TypeConstraints; use Moose::Meta::TypeConstraint::Parameterizable; -our $VERSION = '0.72_01'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - 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 { @@ -25,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 @@ -35,14 +38,14 @@ sub equals { sub compile_type_constraint { my $self = shift; - + 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; - + unless ( blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint') ) { require Moose; Moose->throw_error("The type parameter must be a Moose meta type"); @@ -51,17 +54,47 @@ sub compile_type_constraint { 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 require Moose; - Moose->throw_error("The " . $self->name . " constraint cannot be used, because " + Moose->throw_error("The " . $self->name . " constraint cannot be used, because " . $self->parent->name . " doesn't subtype or coerce from a parameterizable type."); } +sub can_be_inlined { + my $self = shift; + + return + $self->has_parameterized_from + && $self->parameterized_from->has_inline_generator + && $self->type_parameter->can_be_inlined; +} + +sub inline_environment { + my $self = shift; + + 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; + + return unless $self->can_be_inlined; + + return $self->parameterized_from->generate_inline_for( $self->type_parameter, @_ ); +} + sub create_child_type { my ($self, %opts) = @_; return Moose::Meta::TypeConstraint::Parameterizable->new(%opts, parent=>$self); @@ -69,15 +102,13 @@ sub create_child_type { 1; +# ABSTRACT: Type constraints with a bound parameter (ArrayRef[Int]) + __END__ =pod -=head1 NAME - -Moose::Meta::TypeConstraint::Parameterized - Type constraints with a bound parameter (ArrayRef[Int]) - =head1 METHODS This class is intentionally not documented because the API is @@ -90,21 +121,6 @@ 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-2009 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