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'; |
acb8a5db |
8 | use Moose::Util::TypeConstraints; |
d67145ed |
9 | |
f5bc97e5 |
10 | our $VERSION = '0.60'; |
e606ae5f |
11 | $VERSION = eval $VERSION; |
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) |
c245d69b |
39 | || Moose->throw_error("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')) |
c245d69b |
44 | || Moose->throw_error("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 |
c245d69b |
55 | Moose->throw_error("The " . $self->name . " constraint cannot be used, because " |
4c0b3599 |
56 | . $self->parent->name . " doesn't subtype or coerce from a parameterizable type."); |
d67145ed |
57 | } |
58 | |
85a9908f |
59 | sub create_child_type { |
9ceb576e |
60 | my ($self, %opts) = @_; |
9ceb576e |
61 | return Moose::Meta::TypeConstraint->new(%opts, parent => $self); |
9ceb576e |
62 | } |
63 | |
d67145ed |
64 | 1; |
65 | |
66 | __END__ |
67 | |
68 | |
69 | =pod |
70 | |
71 | =head1 NAME |
72 | |
0fbd4b0a |
73 | Moose::Meta::TypeConstraint::Parameterized - Higher Order type constraints for Moose |
d67145ed |
74 | |
d67145ed |
75 | =head1 METHODS |
76 | |
77 | =over 4 |
78 | |
79 | =item B<compile_type_constraint> |
80 | |
0fbd4b0a |
81 | =item B<type_parameter> |
d67145ed |
82 | |
0fbd4b0a |
83 | =item B<has_type_parameter> |
d67145ed |
84 | |
85 | =item B<meta> |
86 | |
dabed765 |
87 | =item B<equals> |
88 | |
85a9908f |
89 | =item B<create_child_type> |
9ceb576e |
90 | |
d67145ed |
91 | =back |
92 | |
93 | =head1 BUGS |
94 | |
95 | All complex software has bugs lurking in it, and this module is no |
96 | exception. If you find a bug please either email me, or add the bug |
97 | to cpan-RT. |
98 | |
99 | =head1 AUTHOR |
100 | |
101 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
102 | |
103 | =head1 COPYRIGHT AND LICENSE |
104 | |
778db3ac |
105 | Copyright 2006-2008 by Infinity Interactive, Inc. |
d67145ed |
106 | |
107 | L<http://www.iinteractive.com> |
108 | |
109 | This library is free software; you can redistribute it and/or modify |
110 | it under the same terms as Perl itself. |
111 | |
112 | =cut |