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