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 can_be_inlined {
  67     my $self = shift;
  68
  69     return
  70            $self->has_parameterized_from
  71         && $self->parameterized_from->has_inline_generator
  72         && $self->type_parameter->can_be_inlined;
  73 }
  74
  75 sub inline_environment {
  76     my $self = shift;
  77
  78     return {
  79         ($self->has_parameterized_from
  80             ? (%{ $self->parameterized_from->inline_environment })
  81             : ()),
  82         ($self->has_type_parameter
  83             ? (%{ $self->type_parameter->inline_environment })
  84             : ()),
  85     };
  86 }
  87
  88 sub _inline_check {
  89     my $self = shift;
  90
  91     return unless $self->can_be_inlined;
  92
  93     return $self->parameterized_from->generate_inline_for( $self->type_parameter, @_ );
  94 }
  95
  96 sub create_child_type {
  97     my ($self, %opts) = @_;
  98     return Moose::Meta::TypeConstraint::Parameterizable->new(%opts, parent=>$self);
  99 }
 100
 101 1;
 102
 103 # ABSTRACT: Type constraints with a bound parameter (ArrayRef[Int])
 104
 105 __END__
 106
 107
 108 =pod
 109
 110 =head1 METHODS
 111
 112 This class is intentionally not documented because the API is
 113 confusing and needs some work.
 114
 115 =head1 INHERITANCE
 116
 117 C<Moose::Meta::TypeConstraint::Parameterized> is a subclass of
 118 L<Moose::Meta::TypeConstraint>.
 119
 120 =head1 BUGS
 121
 122 See L<Moose/BUGS> for details on reporting bugs.
 123
 124 =cut