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 | |
25374f01 |
11 | our $VERSION = '0.02'; |
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 | |
21 | sub compile_type_constraint { |
22 | my $self = shift; |
23 | |
0fbd4b0a |
24 | ($self->has_type_parameter) |
25 | || confess "You cannot create a Higher Order type without a type parameter"; |
d67145ed |
26 | |
0fbd4b0a |
27 | my $type_parameter = $self->type_parameter; |
d67145ed |
28 | |
0fbd4b0a |
29 | (blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint')) |
30 | || confess "The type parameter must be a Moose meta type"; |
7e4e1ad4 |
31 | |
32 | foreach my $type (Moose::Util::TypeConstraints::get_all_parameterizable_types()) { |
33 | if (my $constraint = $type->generate_constraint_for($self)) { |
34 | $self->_set_constraint($constraint); |
35 | return $self->SUPER::compile_type_constraint; |
36 | } |
d67145ed |
37 | } |
38 | |
7e4e1ad4 |
39 | # if we get here, then we couldn't |
40 | # find a way to parameterize this type |
41 | confess "The " . $self->name . " constraint cannot be used, because " |
42 | . $self->parent->name . " doesn't subtype or coerce from a parameterizable type."; |
d67145ed |
43 | } |
44 | |
45 | 1; |
46 | |
47 | __END__ |
48 | |
49 | |
50 | =pod |
51 | |
52 | =head1 NAME |
53 | |
0fbd4b0a |
54 | Moose::Meta::TypeConstraint::Parameterized - Higher Order type constraints for Moose |
d67145ed |
55 | |
d67145ed |
56 | =head1 METHODS |
57 | |
58 | =over 4 |
59 | |
60 | =item B<compile_type_constraint> |
61 | |
0fbd4b0a |
62 | =item B<type_parameter> |
d67145ed |
63 | |
0fbd4b0a |
64 | =item B<has_type_parameter> |
d67145ed |
65 | |
66 | =item B<meta> |
67 | |
68 | =back |
69 | |
70 | =head1 BUGS |
71 | |
72 | All complex software has bugs lurking in it, and this module is no |
73 | exception. If you find a bug please either email me, or add the bug |
74 | to cpan-RT. |
75 | |
76 | =head1 AUTHOR |
77 | |
78 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
79 | |
80 | =head1 COPYRIGHT AND LICENSE |
81 | |
778db3ac |
82 | Copyright 2006-2008 by Infinity Interactive, Inc. |
d67145ed |
83 | |
84 | L<http://www.iinteractive.com> |
85 | |
86 | This library is free software; you can redistribute it and/or modify |
87 | it under the same terms as Perl itself. |
88 | |
89 | =cut |