make sure these are defined
[gitmo/Moose.git] / lib / Moose / Meta / TypeConstraint / Parameterized.pm
CommitLineData
0fbd4b0a 1package Moose::Meta::TypeConstraint::Parameterized;
d67145ed 2
3use strict;
4use warnings;
5use metaclass;
6
7use Scalar::Util 'blessed';
acb8a5db 8use Moose::Util::TypeConstraints;
83526133 9use Moose::Meta::TypeConstraint::Parameterizable;
d67145ed 10
d67145ed 11use base 'Moose::Meta::TypeConstraint';
12
0fbd4b0a 13__PACKAGE__->meta->add_attribute('type_parameter' => (
14 accessor => 'type_parameter',
15 predicate => 'has_type_parameter',
d67145ed 16));
17
7fb4b360 18__PACKAGE__->meta->add_attribute('parameterized_from' => (
19 accessor => 'parameterized_from',
20 predicate => 'has_parameterized_from',
21));
22
dabed765 23sub 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__);
d03bd989 29
dabed765 30 return (
31 $self->type_parameter->equals( $other->type_parameter )
32 and
33 $self->parent->equals( $other->parent )
34 );
35}
36
d67145ed 37sub compile_type_constraint {
38 my $self = shift;
d03bd989 39
70ea9161 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
0fbd4b0a 45 my $type_parameter = $self->type_parameter;
d03bd989 46
70ea9161 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 }
7e4e1ad4 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);
d03bd989 55 return $self->SUPER::compile_type_constraint;
7e4e1ad4 56 }
d67145ed 57 }
d03bd989 58
59 # if we get here, then we couldn't
7e4e1ad4 60 # find a way to parameterize this type
70ea9161 61 require Moose;
d03bd989 62 Moose->throw_error("The " . $self->name . " constraint cannot be used, because "
4c0b3599 63 . $self->parent->name . " doesn't subtype or coerce from a parameterizable type.");
d67145ed 64}
65
7c047a36 66sub can_be_inlined {
7fb4b360 67 my $self = shift;
68
b612a613 69 return
70 $self->has_parameterized_from
71 && $self->parameterized_from->has_inline_generator
7c047a36 72 && $self->type_parameter->can_be_inlined;
7fb4b360 73}
74
e750d47f 75sub inline_environment {
76 my $self = shift;
77
78 return {
9bc21383 79 ($self->has_parameterized_from
80 ? (%{ $self->parameterized_from->inline_environment })
81 : ()),
82 ($self->has_type_parameter
83 ? (%{ $self->type_parameter->inline_environment })
84 : ()),
e750d47f 85 };
86}
87
7fb4b360 88sub _inline_check {
89 my $self = shift;
90
7c047a36 91 return unless $self->can_be_inlined;
7fb4b360 92
b612a613 93 return $self->parameterized_from->generate_inline_for( $self->type_parameter, @_ );
7fb4b360 94}
95
85a9908f 96sub create_child_type {
9ceb576e 97 my ($self, %opts) = @_;
83526133 98 return Moose::Meta::TypeConstraint::Parameterizable->new(%opts, parent=>$self);
9ceb576e 99}
100
d67145ed 1011;
102
ad46f524 103# ABSTRACT: Type constraints with a bound parameter (ArrayRef[Int])
104
d67145ed 105__END__
106
107
108=pod
109
d67145ed 110=head1 METHODS
111
f6fdcfe7 112This class is intentionally not documented because the API is
113confusing and needs some work.
d67145ed 114
f6fdcfe7 115=head1 INHERITANCE
d67145ed 116
f6fdcfe7 117C<Moose::Meta::TypeConstraint::Parameterized> is a subclass of
118L<Moose::Meta::TypeConstraint>.
d67145ed 119
120=head1 BUGS
121
d4048ef3 122See L<Moose/BUGS> for details on reporting bugs.
d67145ed 123
d67145ed 124=cut