lib/Moose/Meta/TypeConstraint/Parameterized.pm

   1 package Moose::Meta::TypeConstraint::Parameterized;
   2
   3 use strict;
   4 use warnings;
   5 use metaclass;
   6
   7 use Scalar::Util 'blessed';
   8 use Moose::Util::TypeConstraints;
   9 use Moose::Meta::TypeConstraint::Parameterizable;
  10
  11 use base 'Moose::Meta::TypeConstraint';
  12
  13 __PACKAGE__->meta->add_attribute('type_parameter' => (
  14     accessor  => 'type_parameter',
  15     predicate => 'has_type_parameter',
  16 ));
  17
  18 __PACKAGE__->meta->add_attribute('parameterized_from' => (
  19     accessor   => 'parameterized_from',
  20     predicate  => 'has_parameterized_from',
  21 ));
  22
  23 sub equals {
  24     my ( $self, $type_or_name ) = @_;
  25
  26     my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
  27
  28     return unless $other->isa(__PACKAGE__);
  29
  30     return (
  31         $self->type_parameter->equals( $other->type_parameter )
  32             and
  33         $self->parent->equals( $other->parent )
  34     );
  35 }
  36
  37 sub compile_type_constraint {
  38     my $self = shift;
  39
  40     unless ( $self->has_type_parameter ) {
  41         require Moose;
  42         Moose->throw_error("You cannot create a Higher Order type without a type parameter");
  43     }
  44
  45     my $type_parameter = $self->type_parameter;
  46
  47     unless ( blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint') ) {
  48         require Moose;
  49         Moose->throw_error("The type parameter must be a Moose meta type");
  50     }
  51
  52     foreach my $type (Moose::Util::TypeConstraints::get_all_parameterizable_types()) {
  53         if (my $constraint = $type->generate_constraint_for($self)) {
  54             $self->_set_constraint($constraint);
  55             return $self->SUPER::compile_type_constraint;
  56         }
  57     }
  58
  59     # if we get here, then we couldn't
  60     # find a way to parameterize this type
  61     require Moose;
  62     Moose->throw_error("The " . $self->name . " constraint cannot be used, because "
  63           . $self->parent->name . " doesn't subtype or coerce from a parameterizable type.");
  64 }
  65
  66 sub has_inlined_type_constraint {
  67     my $self = shift;
  68
  69     return
  70            $self->has_parameterized_from
  71         && $self->parameterized_from->has_inline_generator
  72         && $self->type_parameter->has_inlined_type_constraint;
  73
  74 }
  75
  76 sub _inline_check {
  77     my $self = shift;
  78
  79     return unless $self->has_inlined_type_constraint;
  80
  81     return $self->parameterized_from->generate_inline_for( $self->type_parameter, @_ );
  82 }
  83
  84 sub create_child_type {
  85     my ($self, %opts) = @_;
  86     return Moose::Meta::TypeConstraint::Parameterizable->new(%opts, parent=>$self);
  87 }
  88
  89 1;
  90
  91 # ABSTRACT: Type constraints with a bound parameter (ArrayRef[Int])
  92
  93 __END__
  94
  95
  96 =pod
  97
  98 =head1 METHODS
  99
 100 This class is intentionally not documented because the API is
 101 confusing and needs some work.
 102
 103 =head1 INHERITANCE
 104
 105 C<Moose::Meta::TypeConstraint::Parameterized> is a subclass of
 106 L<Moose::Meta::TypeConstraint>.
 107
 108 =head1 BUGS
 109
 110 See L<Moose/BUGS> for details on reporting bugs.
 111
 112 =cut