Commit | Line | Data |
5964b3ca |
1 | package MooseX::Dependent::Types; |
a018b5bb |
2 | |
3cfd35fd |
3 | use Moose::Util::TypeConstraints; |
a588ee00 |
4 | use MooseX::Dependent::Meta::TypeConstraint::Dependent; |
5964b3ca |
5 | use MooseX::Types -declare => [qw(Dependent)]; |
3cfd35fd |
6 | |
a018b5bb |
7 | =head1 NAME |
8 | |
5964b3ca |
9 | MooseX::Dependent::Types - L<MooseX::Types> constraints that depend on values. |
a018b5bb |
10 | |
11 | =head1 SYNOPSIS |
12 | |
5964b3ca |
13 | Within your L<MooseX::Types> declared library module: |
3cfd35fd |
14 | |
613e1e97 |
15 | use MooseX::Dependent::Types qw(Dependent); |
88f58fbf |
16 | |
17 | subtype Set, |
18 | as class_type("Set::Scalar"); |
613e1e97 |
19 | |
88f58fbf |
20 | subtype UniqueInt, |
613e1e97 |
21 | as Dependent[Int, Set], |
22 | where { |
23 | my ($int, $set) = @_; |
88f58fbf |
24 | return !$set->has($int); |
613e1e97 |
25 | }; |
6c67366e |
26 | |
88f58fbf |
27 | subtype PositiveSet, |
28 | as Set, |
29 | where { |
30 | my ($set) = @_; |
31 | return !grep {$_ <0 } $set->members; |
32 | }; |
33 | |
34 | subtype PositiveUniqueInt, |
35 | as UniqueInt[PositiveSet]; |
36 | |
37 | my $set = Set::Scalar->new(1,2,3); |
38 | |
39 | UniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) |
40 | UniqueInt([$set])->check(-99); ## Okay, -99 isn't in (1,2,3) |
41 | UniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) |
42 | |
43 | PositiveUniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) |
44 | PositiveUniqueInt([$set])->check(-99); ## Not OK, -99 not Positive Int |
45 | PositiveUniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) |
46 | |
47 | my $negative_set = Set::Scalar->new(-1,-2,-3); |
48 | |
49 | UniqueInt([$negative_set])->check(100); ## Throws exception |
50 | |
a018b5bb |
51 | =head1 DESCRIPTION |
52 | |
5964b3ca |
53 | A L<MooseX::Types> library for creating dependent types. A dependent type |
54 | constraint for all intents and uses is a subclass of a parent type, but adds a |
55 | secondary type parameter which is available to constraint callbacks (such as |
56 | inside the 'where' clause) or in the coercions. |
57 | |
58 | This allows you to create a type that has additional runtime advice, such as a |
59 | set of numbers within which another number must be unique, or allowable ranges |
60 | for a integer, such as in: |
61 | |
62 | subtype Range, |
63 | as Dict[max=>Int, min=>Int], |
64 | where { |
65 | my ($range) = @_; |
66 | return $range->{max} > $range->{min}; |
67 | }; |
68 | |
69 | subtype RangedInt, |
70 | as Dependent[Int, Range], |
71 | where { |
72 | my ($value, $range) = @_; |
73 | return ($value >= $range->{min} && |
6c67366e |
74 | $value <= $range->{max}); |
5964b3ca |
75 | }; |
76 | |
6c67366e |
77 | RangedInt([{min=>10,max=>100}])->check(50); ## OK |
78 | RangedInt([{min=>50, max=>75}])->check(99); ## Not OK, 99 exceeds max |
79 | |
80 | This throws a hard Moose exception. You'll need to capture it in an eval or |
9c319add |
81 | related exception catching system (see L<TryCatch>). |
6c67366e |
82 | |
83 | RangedInt([{min=>99, max=>10}])->check(10); ## Not OK, not a valid Range! |
84 | |
85 | If you can't accept a hard exception here, you'll need to test the constraining |
86 | values first, as in: |
87 | |
88 | my $range = {min=>99, max=>10}; |
89 | if(my $err = Range->validate($range)) { |
90 | ## Handle #$err |
91 | } else { |
92 | RangedInt($range)->check(99); |
93 | } |
5964b3ca |
94 | |
95 | Please note that for ArrayRef or HashRef dependent type constraints, as in the |
96 | example above, as a convenience we automatically ref the incoming type |
97 | parameters, so that the above could also be written as: |
98 | |
6c67366e |
99 | RangedInt([min=>10,max=>100])->check(50); ## OK |
100 | RangedInt([min=>50, max=>75])->check(99); ## Not OK, 99 exceeds max |
101 | RangedInt([min=>99, max=>10])->check(10); ## Exception, not a valid Range! |
5964b3ca |
102 | |
103 | This is the preferred syntax, as it improve readability and adds to the |
104 | conciseness of your type constraint declarations. An exception wil be thrown if |
105 | your type parameters don't match the required reference type. |
106 | |
6c67366e |
107 | Also not that if you 'chain' parameterization results with a method call like: |
108 | |
109 | TypeConstraint([$ob])->method; |
110 | |
111 | You need to have the "(...)" around the ArrayRef in the Type Constraint |
112 | parameters. This seems to have something to do with the precendent level of |
113 | "->". Patches or thoughts welcomed. You only need to do this in the above |
114 | case which I imagine is not a very common case. |
115 | |
5964b3ca |
116 | ==head2 Subtyping a Dependent type constraints |
117 | |
118 | When subclassing a dependent type you must be careful to match either the |
119 | required type parameter type constraint, or if re-parameterizing, the new |
120 | type constraints are a subtype of the parent. For example: |
121 | |
122 | subtype RangedInt, |
123 | as Dependent[Int, Range], |
124 | where { |
125 | my ($value, $range) = @_; |
126 | return ($value >= $range->{min} && |
127 | $value =< $range->{max}); |
128 | }; |
129 | |
130 | Example subtype with additional constraints: |
131 | |
132 | subtype PositiveRangedInt, |
133 | as RangedInt, |
134 | where { |
135 | shift >= 0; |
136 | }; |
137 | |
88f58fbf |
138 | Or you could have done the following instead: |
5964b3ca |
139 | |
140 | ## Subtype of Int for positive numbers |
141 | subtype PositiveInt, |
142 | as Int, |
143 | where { |
6c67366e |
144 | my ($value, $range) = @_; |
145 | return $value >= 0; |
5964b3ca |
146 | }; |
147 | |
148 | ## subtype Range to re-parameterize Range with subtypes |
66efbe23 |
149 | subtype PositiveRange, |
5964b3ca |
150 | as Range[max=>PositiveInt, min=>PositiveInt]; |
151 | |
152 | ## create subtype via reparameterizing |
153 | subtype PositiveRangedInt, |
66efbe23 |
154 | as RangedInt[PositiveRange]; |
5964b3ca |
155 | |
156 | Notice how re-parameterizing the dependent type 'RangedInt' works slightly |
6c67366e |
157 | differently from re-parameterizing 'PositiveRange' Although it initially takes |
5964b3ca |
158 | two type constraint values to declare a dependent type, should you wish to |
159 | later re-parameterize it, you only use a subtype of the second type parameter |
160 | (the dependent type constraint) since the first type constraint sets the parent |
161 | type for the dependent type. In other words, given the example above, a type |
162 | constraint of 'RangedInt' would have a parent of 'Int', not 'Dependent' and for |
163 | all intends and uses you could stick it wherever you'd need an Int. |
164 | |
165 | subtype NameAge, |
166 | as Tuple[Str, Int]; |
167 | |
168 | ## re-parameterized subtypes of NameAge containing a Dependent Int |
169 | subtype NameBetween18and35Age, |
170 | as NameAge[ |
171 | Str, |
172 | PositiveRangedInt[min=>18,max=>35], |
173 | ]; |
174 | |
175 | One caveat is that you can't stick an unparameterized dependent type inside a |
176 | structure, such as L<MooseX::Types::Structured> since that would require the |
177 | ability to convert a 'containing' type constraint into a dependent type, which |
178 | is a capacity we current don't have. |
179 | |
3cfd35fd |
180 | =head2 Coercions |
a018b5bb |
181 | |
26cf337e |
182 | Dependent types have some limited support for coercions. Several things must |
183 | be kept in mind. The first is that the coercion targets the type constraint |
184 | which is being made dependent, Not the dependent type. So for example if you |
185 | create a Dependent type like: |
186 | |
187 | subtype RequiredAgeInYears, |
188 | as Int; |
189 | |
190 | subtype PersonOverAge, |
191 | as Dependent[Person, RequiredAgeInYears] |
192 | where { |
193 | my ($person, $required_years_old) = @_; |
194 | return $person->years_old > $required_years_old; |
195 | } |
196 | |
197 | This would validate the following: |
198 | |
199 | my $person = Person->new(age=>35); |
200 | PersonOverAge([18])->check($person); |
5964b3ca |
201 | |
26cf337e |
202 | You can then apply the following coercion |
203 | |
204 | coerce PersonOverAge, |
205 | from Dict[age=>int], |
206 | via {Person->new(%$_)}, |
207 | from Int, |
208 | via {Person->new(age=>$_)}; |
209 | |
210 | This coercion would then apply to all the following: |
211 | |
212 | PersonOverAge([18])->check(30); ## via the Int coercion |
213 | PersonOverAge([18])->check({age=>50}); ## via the Dict coercion |
214 | |
215 | However, you are not allowed to place coercions on dependent types that have |
216 | had their constraining value filled, nor subtypes of such. For example: |
217 | |
218 | coerce PersonOverAge[18], |
219 | from DateTime, |
220 | via {$_->years}; |
221 | |
222 | That would generate a hard exception. This is a limitation for now until I can |
223 | devise a smarter way to cache the generated type constraints. However, I doubt |
224 | it will be a significant limitation, since the general use case is supported. |
225 | |
226 | Lastly, the constraining value is available in the coercion in much the same way |
227 | it is available to the constraint. |
228 | |
229 | ## Create a type constraint where a Person must be in the set |
230 | subtype PersonInSet, |
231 | as Dependent[Person, PersonSet], |
5964b3ca |
232 | where { |
26cf337e |
233 | my ($person, $person_set) = @_; |
234 | $person_set->find($person); |
235 | } |
6b2f4f88 |
236 | |
26cf337e |
237 | coerce PersonInSet, |
238 | from HashRef, |
5964b3ca |
239 | via { |
26cf337e |
240 | my ($hashref, $person_set) = @_; |
241 | return $person_set->create($hash_ref); |
5964b3ca |
242 | }; |
a018b5bb |
243 | |
3cfd35fd |
244 | =head2 Recursion |
a018b5bb |
245 | |
26cf337e |
246 | TBD |
a018b5bb |
247 | |
3cfd35fd |
248 | =head1 TYPE CONSTRAINTS |
a018b5bb |
249 | |
3cfd35fd |
250 | This type library defines the following constraints. |
a018b5bb |
251 | |
5964b3ca |
252 | =head2 Dependent[ParentTypeConstraint, DependentValueTypeConstraint] |
a018b5bb |
253 | |
5964b3ca |
254 | Create a subtype of ParentTypeConstraint with a dependency on a value that can |
255 | pass the DependentValueTypeConstraint. If DependentValueTypeConstraint is empty |
256 | we default to the 'Any' type constraint (see L<Moose::Util::TypeConstraints>). |
9b6d2e22 |
257 | |
5964b3ca |
258 | This creates a type constraint which must be further parameterized at later time |
259 | before it can be used to ->check or ->validate a value. Attempting to do so |
260 | will cause an exception. |
a018b5bb |
261 | |
262 | =cut |
263 | |
3cfd35fd |
264 | Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( |
a588ee00 |
265 | MooseX::Dependent::Meta::TypeConstraint::Dependent->new( |
5964b3ca |
266 | name => 'MooseX::Dependent::Types::Dependent', |
a588ee00 |
267 | parent => find_type_constraint('Any'), |
0a9f5b94 |
268 | constraint => sub {1}, |
9b6d2e22 |
269 | ) |
3cfd35fd |
270 | ); |
9b6d2e22 |
271 | |
3cfd35fd |
272 | =head1 AUTHOR |
a018b5bb |
273 | |
3cfd35fd |
274 | John Napiorkowski, C<< <jjnapiork@cpan.org> >> |
275 | |
276 | =head1 COPYRIGHT & LICENSE |
a018b5bb |
277 | |
278 | This program is free software; you can redistribute it and/or modify |
3cfd35fd |
279 | it under the same terms as Perl itself. |
a018b5bb |
280 | |
281 | =cut |
9b6d2e22 |
282 | |
a018b5bb |
283 | 1; |