Commit | Line | Data |
0fbd4b0a |
1 | package Moose::Meta::TypeConstraint::Parameterized; |
d67145ed |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use metaclass; |
6 | |
7 | use Scalar::Util 'blessed'; |
8 | use Carp 'confess'; |
acb8a5db |
9 | use Moose::Util::TypeConstraints; |
d67145ed |
10 | |
330dbb07 |
11 | our $VERSION = '0.55'; |
d67145ed |
12 | our $AUTHORITY = 'cpan:STEVAN'; |
13 | |
14 | use base 'Moose::Meta::TypeConstraint'; |
15 | |
0fbd4b0a |
16 | __PACKAGE__->meta->add_attribute('type_parameter' => ( |
17 | accessor => 'type_parameter', |
18 | predicate => 'has_type_parameter', |
d67145ed |
19 | )); |
20 | |
dabed765 |
21 | sub equals { |
22 | my ( $self, $type_or_name ) = @_; |
23 | |
24 | my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); |
25 | |
26 | return unless $other->isa(__PACKAGE__); |
27 | |
28 | return ( |
29 | $self->type_parameter->equals( $other->type_parameter ) |
30 | and |
31 | $self->parent->equals( $other->parent ) |
32 | ); |
33 | } |
34 | |
d67145ed |
35 | sub compile_type_constraint { |
36 | my $self = shift; |
37 | |
0fbd4b0a |
38 | ($self->has_type_parameter) |
39 | || confess "You cannot create a Higher Order type without a type parameter"; |
d67145ed |
40 | |
0fbd4b0a |
41 | my $type_parameter = $self->type_parameter; |
d67145ed |
42 | |
0fbd4b0a |
43 | (blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint')) |
44 | || confess "The type parameter must be a Moose meta type"; |
7e4e1ad4 |
45 | |
46 | foreach my $type (Moose::Util::TypeConstraints::get_all_parameterizable_types()) { |
47 | if (my $constraint = $type->generate_constraint_for($self)) { |
48 | $self->_set_constraint($constraint); |
49 | return $self->SUPER::compile_type_constraint; |
50 | } |
d67145ed |
51 | } |
52 | |
7e4e1ad4 |
53 | # if we get here, then we couldn't |
54 | # find a way to parameterize this type |
55 | confess "The " . $self->name . " constraint cannot be used, because " |
56 | . $self->parent->name . " doesn't subtype or coerce from a parameterizable type."; |
d67145ed |
57 | } |
58 | |
59 | 1; |
60 | |
61 | __END__ |
62 | |
63 | |
64 | =pod |
65 | |
66 | =head1 NAME |
67 | |
0fbd4b0a |
68 | Moose::Meta::TypeConstraint::Parameterized - Higher Order type constraints for Moose |
d67145ed |
69 | |
d67145ed |
70 | =head1 METHODS |
71 | |
72 | =over 4 |
73 | |
74 | =item B<compile_type_constraint> |
75 | |
0fbd4b0a |
76 | =item B<type_parameter> |
d67145ed |
77 | |
0fbd4b0a |
78 | =item B<has_type_parameter> |
d67145ed |
79 | |
80 | =item B<meta> |
81 | |
dabed765 |
82 | =item B<equals> |
83 | |
d67145ed |
84 | =back |
85 | |
86 | =head1 BUGS |
87 | |
88 | All complex software has bugs lurking in it, and this module is no |
89 | exception. If you find a bug please either email me, or add the bug |
90 | to cpan-RT. |
91 | |
92 | =head1 AUTHOR |
93 | |
94 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
95 | |
96 | =head1 COPYRIGHT AND LICENSE |
97 | |
778db3ac |
98 | Copyright 2006-2008 by Infinity Interactive, Inc. |
d67145ed |
99 | |
100 | L<http://www.iinteractive.com> |
101 | |
102 | This library is free software; you can redistribute it and/or modify |
103 | it under the same terms as Perl itself. |
104 | |
105 | =cut |