Commit | Line | Data |
06d02aac |
1 | package Moose::Util::TypeConstraints::Builtins; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
7fb4b360 |
6 | use List::MoreUtils (); |
9882ca98 |
7 | use Scalar::Util qw( blessed looks_like_number reftype ); |
06d02aac |
8 | |
9 | sub type { goto &Moose::Util::TypeConstraints::type } |
10 | sub subtype { goto &Moose::Util::TypeConstraints::subtype } |
11 | sub as { goto &Moose::Util::TypeConstraints::as } |
12 | sub where (&) { goto &Moose::Util::TypeConstraints::where } |
13 | sub optimize_as (&) { goto &Moose::Util::TypeConstraints::optimize_as } |
4e36cf24 |
14 | sub inline_as (&) { goto &Moose::Util::TypeConstraints::inline_as } |
06d02aac |
15 | |
16 | sub define_builtins { |
17 | my $registry = shift; |
18 | |
4e36cf24 |
19 | type 'Any' # meta-type including all |
20 | => where {1} |
21 | => inline_as { '1' }; |
06d02aac |
22 | |
4e36cf24 |
23 | subtype 'Item' # base-type |
94ab1609 |
24 | => as 'Any' |
25 | => inline_as { '1' }; |
4e36cf24 |
26 | |
27 | subtype 'Undef' |
28 | => as 'Item' |
29 | => where { !defined($_) } |
3975b592 |
30 | => inline_as { '!defined(' . $_[1] . ')' }; |
4e36cf24 |
31 | |
32 | subtype 'Defined' |
33 | => as 'Item' |
34 | => where { defined($_) } |
3975b592 |
35 | => inline_as { 'defined(' . $_[1] . ')' }; |
06d02aac |
36 | |
37 | subtype 'Bool' |
38 | => as 'Item' |
4e36cf24 |
39 | => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' } |
3975b592 |
40 | => inline_as { |
41 | '!defined(' . $_[1] . ') ' |
42 | . '|| ' . $_[1] . ' eq "" ' |
43 | . '|| "' . $_[1] . '" eq "1" ' |
44 | . '|| "' . $_[1] . '" eq "0"' |
45 | }; |
06d02aac |
46 | |
47 | subtype 'Value' |
48 | => as 'Defined' |
49 | => where { !ref($_) } |
3975b592 |
50 | => inline_as { 'defined(' . $_[1] . ') && !ref(' . $_[1] . ')' }; |
06d02aac |
51 | |
52 | subtype 'Ref' |
53 | => as 'Defined' |
54 | => where { ref($_) } |
3975b592 |
55 | => inline_as { 'ref(' . $_[1] . ')' }; |
06d02aac |
56 | |
57 | subtype 'Str' |
58 | => as 'Value' |
a79639df |
59 | => where { ref(\$_) eq 'SCALAR' || ref(\(my $val = $_)) eq 'SCALAR' } |
4e36cf24 |
60 | => inline_as { |
3975b592 |
61 | 'defined(' . $_[1] . ') ' |
62 | . '&& (ref(\\' . $_[1] . ') eq "SCALAR"' |
e6fff671 |
63 | . '|| ref(\\(my $val = ' . $_[1] . ')) eq "SCALAR" )' |
4e36cf24 |
64 | }; |
06d02aac |
65 | |
66 | subtype 'Num' |
67 | => as 'Str' |
68 | => where { Scalar::Util::looks_like_number($_) } |
3975b592 |
69 | => inline_as { |
70 | '!ref(' . $_[1] . ') ' |
71 | . '&& Scalar::Util::looks_like_number(' . $_[1] . ')' |
72 | }; |
06d02aac |
73 | |
74 | subtype 'Int' |
75 | => as 'Num' |
a79639df |
76 | => where { (my $val = $_) =~ /\A-?[0-9]+\z/ } |
4e36cf24 |
77 | => inline_as { |
3975b592 |
78 | 'defined(' . $_[1] . ') ' |
79 | . '&& !ref(' . $_[1] . ') ' |
e6fff671 |
80 | . '&& (my $val = ' . $_[1] . ') =~ /\A-?[0-9]+\z/' |
4e36cf24 |
81 | }; |
06d02aac |
82 | |
83 | subtype 'CodeRef' |
84 | => as 'Ref' |
85 | => where { ref($_) eq 'CODE' } |
3975b592 |
86 | => inline_as { 'ref(' . $_[1] . ') eq "CODE"' }; |
06d02aac |
87 | |
88 | subtype 'RegexpRef' |
89 | => as 'Ref' |
9882ca98 |
90 | => where( \&_RegexpRef ) |
3975b592 |
91 | => inline_as { |
92 | 'Moose::Util::TypeConstraints::Builtins::_RegexpRef(' . $_[1] . ')' |
93 | }; |
06d02aac |
94 | |
95 | subtype 'GlobRef' |
96 | => as 'Ref' |
97 | => where { ref($_) eq 'GLOB' } |
3975b592 |
98 | => inline_as { 'ref(' . $_[1] . ') eq "GLOB"' }; |
06d02aac |
99 | |
100 | # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a |
101 | # filehandle |
102 | subtype 'FileHandle' |
94ab1609 |
103 | => as 'Ref' |
06d02aac |
104 | => where { |
188ba420 |
105 | (ref($_) eq "GLOB" && Scalar::Util::openhandle($_)) |
106 | || (blessed($_) && $_->isa("IO::Handle")); |
06d02aac |
107 | } |
4e36cf24 |
108 | => inline_as { |
3975b592 |
109 | '(ref(' . $_[1] . ') eq "GLOB" ' |
110 | . '&& Scalar::Util::openhandle(' . $_[1] . ')) ' |
111 | . '|| (Scalar::Util::blessed(' . $_[1] . ') ' |
112 | . '&& ' . $_[1] . '->isa("IO::Handle"))' |
4e36cf24 |
113 | }; |
06d02aac |
114 | |
115 | subtype 'Object' |
116 | => as 'Ref' |
117 | => where { blessed($_) } |
3975b592 |
118 | => inline_as { 'Scalar::Util::blessed(' . $_[1] . ')' }; |
06d02aac |
119 | |
120 | # This type is deprecated. |
121 | subtype 'Role' |
122 | => as 'Object' |
43837b8a |
123 | => where { $_->can('does') }; |
06d02aac |
124 | |
125 | subtype 'ClassName' |
126 | => as 'Str' |
127 | => where { Class::MOP::is_class_loaded($_) } |
3975b592 |
128 | => inline_as { 'Class::MOP::is_class_loaded(' . $_[1] . ')' }; |
06d02aac |
129 | |
130 | subtype 'RoleName' |
131 | => as 'ClassName' |
132 | => where { |
133 | (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role'); |
134 | } |
4e36cf24 |
135 | => inline_as { |
3975b592 |
136 | 'Class::MOP::is_class_loaded(' . $_[1] . ') ' |
d6874ac6 |
137 | . '&& do {' |
138 | . 'my $meta = Class::MOP::class_of(' . $_[1] . ');' |
139 | . '$meta && $meta->isa("Moose::Meta::Role");' |
140 | . '}' |
4e36cf24 |
141 | }; |
06d02aac |
142 | |
143 | $registry->add_type_constraint( |
144 | Moose::Meta::TypeConstraint::Parameterizable->new( |
145 | name => 'ScalarRef', |
146 | package_defined_in => __PACKAGE__, |
147 | parent => |
148 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
149 | constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' }, |
06d02aac |
150 | constraint_generator => sub { |
151 | my $type_parameter = shift; |
152 | my $check = $type_parameter->_compiled_type_constraint; |
153 | return sub { |
154 | return $check->( ${$_} ); |
155 | }; |
7fb4b360 |
156 | }, |
3975b592 |
157 | inlined => sub { |
158 | 'ref(' . $_[1] . ') eq "SCALAR" ' |
159 | . '|| ref(' . $_[1] . ') eq "REF"' |
160 | }, |
7fb4b360 |
161 | inline_generator => sub { |
964294c1 |
162 | my $self = shift; |
7fb4b360 |
163 | my $type_parameter = shift; |
164 | my $val = shift; |
3975b592 |
165 | '(ref(' . $val . ') eq "SCALAR" || ref(' . $val . ') eq "REF") ' |
166 | . '&& ' . $type_parameter->_inline_check('${(' . $val . ')}') |
7fb4b360 |
167 | }, |
06d02aac |
168 | ) |
169 | ); |
170 | |
171 | $registry->add_type_constraint( |
172 | Moose::Meta::TypeConstraint::Parameterizable->new( |
173 | name => 'ArrayRef', |
174 | package_defined_in => __PACKAGE__, |
175 | parent => |
176 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
177 | constraint => sub { ref($_) eq 'ARRAY' }, |
06d02aac |
178 | constraint_generator => sub { |
179 | my $type_parameter = shift; |
180 | my $check = $type_parameter->_compiled_type_constraint; |
181 | return sub { |
182 | foreach my $x (@$_) { |
183 | ( $check->($x) ) || return; |
184 | } |
185 | 1; |
186 | } |
7fb4b360 |
187 | }, |
3975b592 |
188 | inlined => sub { 'ref(' . $_[1] . ') eq "ARRAY"' }, |
7fb4b360 |
189 | inline_generator => sub { |
964294c1 |
190 | my $self = shift; |
7fb4b360 |
191 | my $type_parameter = shift; |
192 | my $val = shift; |
d6874ac6 |
193 | |
194 | 'do {' |
195 | . 'my $check = ' . $val . ';' |
196 | . 'ref($check) eq "ARRAY" ' |
197 | . '&& &List::MoreUtils::all(' |
198 | . 'sub { ' . $type_parameter->_inline_check('$_') . ' }, ' |
199 | . '@{$check}' |
200 | . ')' |
201 | . '}'; |
7fb4b360 |
202 | }, |
06d02aac |
203 | ) |
204 | ); |
205 | |
206 | $registry->add_type_constraint( |
207 | Moose::Meta::TypeConstraint::Parameterizable->new( |
208 | name => 'HashRef', |
209 | package_defined_in => __PACKAGE__, |
210 | parent => |
211 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
212 | constraint => sub { ref($_) eq 'HASH' }, |
06d02aac |
213 | constraint_generator => sub { |
214 | my $type_parameter = shift; |
215 | my $check = $type_parameter->_compiled_type_constraint; |
216 | return sub { |
217 | foreach my $x ( values %$_ ) { |
218 | ( $check->($x) ) || return; |
219 | } |
220 | 1; |
221 | } |
7fb4b360 |
222 | }, |
3975b592 |
223 | inlined => sub { 'ref(' . $_[1] . ') eq "HASH"' }, |
7fb4b360 |
224 | inline_generator => sub { |
964294c1 |
225 | my $self = shift; |
7fb4b360 |
226 | my $type_parameter = shift; |
227 | my $val = shift; |
d6874ac6 |
228 | |
229 | 'do {' |
230 | . 'my $check = ' . $val . ';' |
231 | . 'ref($check) eq "HASH" ' |
232 | . '&& &List::MoreUtils::all(' |
233 | . 'sub { ' . $type_parameter->_inline_check('$_') . ' }, ' |
234 | . 'values %{$check}' |
235 | . ')' |
236 | . '}'; |
7fb4b360 |
237 | }, |
06d02aac |
238 | ) |
239 | ); |
240 | |
241 | $registry->add_type_constraint( |
242 | Moose::Meta::TypeConstraint::Parameterizable->new( |
243 | name => 'Maybe', |
244 | package_defined_in => __PACKAGE__, |
245 | parent => |
246 | Moose::Util::TypeConstraints::find_type_constraint('Item'), |
247 | constraint => sub {1}, |
248 | constraint_generator => sub { |
249 | my $type_parameter = shift; |
250 | my $check = $type_parameter->_compiled_type_constraint; |
251 | return sub { |
252 | return 1 if not( defined($_) ) || $check->($_); |
253 | return; |
254 | } |
7fb4b360 |
255 | }, |
256 | inlined => sub {'1'}, |
257 | inline_generator => sub { |
964294c1 |
258 | my $self = shift; |
7fb4b360 |
259 | my $type_parameter = shift; |
260 | my $val = shift; |
3975b592 |
261 | '!defined(' . $val . ') ' |
262 | . '|| (' . $type_parameter->_inline_check($val) . ')' |
7fb4b360 |
263 | }, |
06d02aac |
264 | ) |
265 | ); |
266 | } |
267 | |
268 | 1; |
297899d1 |
269 | |
270 | __END__ |
271 | |
272 | =pod |
273 | |
274 | =for pod_coverage_needs_some_pod |
275 | |
276 | =cut |
277 | |