Commit | Line | Data |
7e4e1ad4 |
1 | package Moose::Meta::TypeConstraint::Parameterizable; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use metaclass; |
6 | |
03e7dbec |
7 | our $VERSION = '0.53'; |
7e4e1ad4 |
8 | our $AUTHORITY = 'cpan:STEVAN'; |
9 | |
10 | use base 'Moose::Meta::TypeConstraint'; |
11 | |
12 | __PACKAGE__->meta->add_attribute('constraint_generator' => ( |
13 | accessor => 'constraint_generator', |
14 | predicate => 'has_constraint_generator', |
15 | )); |
16 | |
17 | sub generate_constraint_for { |
18 | my ($self, $type) = @_; |
19 | |
20 | return unless $self->has_constraint_generator; |
21 | |
22 | return $self->constraint_generator->($type->type_parameter) |
23 | if $type->is_subtype_of($self->name); |
24 | |
25 | return $self->_can_coerce_constraint_from($type) |
26 | if $self->has_coercion |
27 | && $self->coercion->has_coercion_for_type($type->parent->name); |
28 | |
29 | return; |
30 | } |
31 | |
32 | sub _can_coerce_constraint_from { |
33 | my ($self, $type) = @_; |
34 | my $coercion = $self->coercion; |
35 | my $constraint = $self->constraint_generator->($type->type_parameter); |
36 | return sub { |
37 | local $_ = $coercion->coerce($_); |
38 | $constraint->(@_); |
39 | }; |
40 | } |
41 | |
42 | |
43 | 1; |
44 | |
45 | __END__ |
46 | |
47 | |
48 | =pod |
49 | |
50 | =head1 NAME |
51 | |
52 | Moose::Meta::TypeConstraint::Parameterizable - Higher Order type constraints for Moose |
53 | |
54 | =head1 METHODS |
55 | |
56 | =over 4 |
57 | |
58 | =item B<constraint_generator> |
59 | |
60 | =item B<has_constraint_generator> |
61 | |
62 | =item B<generate_constraint_for> |
63 | |
64 | =item B<meta> |
65 | |
66 | =back |
67 | |
68 | =head1 BUGS |
69 | |
70 | All complex software has bugs lurking in it, and this module is no |
71 | exception. If you find a bug please either email me, or add the bug |
72 | to cpan-RT. |
73 | |
74 | =head1 AUTHOR |
75 | |
76 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
77 | |
78 | =head1 COPYRIGHT AND LICENSE |
79 | |
80 | Copyright 2006-2008 by Infinity Interactive, Inc. |
81 | |
82 | L<http://www.iinteractive.com> |
83 | |
84 | This library is free software; you can redistribute it and/or modify |
85 | it under the same terms as Perl itself. |
86 | |
87 | =cut |