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