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=3d7cbaef0717d40aaf473a31dd11bac10a2d4227;hpb=c245d69b0b9984226cc876c0578b18e89b5cbf23;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/TypeConstraint/Parameterized.pm b/lib/Moose/Meta/TypeConstraint/Parameterized.pm index 3d7cbae..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.57'; -$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,72 +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."); } -1; - -__END__ - - -=pod +sub can_be_inlined { + my $self = shift; -=head1 NAME + return + $self->has_parameterized_from + && $self->parameterized_from->has_inline_generator + && $self->type_parameter->can_be_inlined; +} -Moose::Meta::TypeConstraint::Parameterized - Higher Order type constraints for Moose +sub inline_environment { + my $self = shift; -=head1 METHODS + return { + ($self->has_parameterized_from + ? (%{ $self->parameterized_from->inline_environment }) + : ()), + ($self->has_type_parameter + ? (%{ $self->type_parameter->inline_environment }) + : ()), + }; +} -=over 4 +sub _inline_check { + my $self = shift; -=item B + return unless $self->can_be_inlined; -=item B + return $self->parameterized_from->generate_inline_for( $self->type_parameter, @_ ); +} -=item B +sub create_child_type { + my ($self, %opts) = @_; + return Moose::Meta::TypeConstraint::Parameterizable->new(%opts, parent=>$self); +} -=item B +1; -=item B +# ABSTRACT: Type constraints with a bound parameter (ArrayRef[Int]) -=back +__END__ -=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. +=pod -=head1 AUTHOR +=head1 METHODS -Stevan Little Estevan@iinteractive.comE +This class is intentionally not documented because the API is +confusing and needs some work. -=head1 COPYRIGHT AND LICENSE +=head1 INHERITANCE -Copyright 2006-2008 by Infinity Interactive, Inc. +C is a subclass of +L. -L +=head1 BUGS -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