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($_) } |
30 | => inline_as { "! defined $_[0]" }; |
31 | |
32 | subtype 'Defined' |
33 | => as 'Item' |
34 | => where { defined($_) } |
35 | => inline_as { "defined $_[0]" }; |
06d02aac |
36 | |
37 | subtype 'Bool' |
38 | => as 'Item' |
4e36cf24 |
39 | => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' } |
40 | => inline_as { qq{!defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0'} }; |
06d02aac |
41 | |
42 | subtype 'Value' |
43 | => as 'Defined' |
44 | => where { !ref($_) } |
4e36cf24 |
45 | => optimize_as( \&_Value ) |
46 | => inline_as { "defined $_[0] && ! ref $_[0]" }; |
06d02aac |
47 | |
48 | subtype 'Ref' |
49 | => as 'Defined' |
50 | => where { ref($_) } |
4e36cf24 |
51 | => optimize_as( \&_Ref ) |
52 | => inline_as { "ref $_[0]" }; |
06d02aac |
53 | |
54 | subtype 'Str' |
55 | => as 'Value' |
56 | => where { ref(\$_) eq 'SCALAR' } |
4e36cf24 |
57 | => optimize_as( \&_Str ) |
58 | => inline_as { |
59 | return ( qq{defined $_[0]} |
60 | . qq{&& ( ref(\\ $_[0] ) eq 'SCALAR'} |
61 | . qq{ || ref(\\(my \$value = $_[0])) eq 'SCALAR')} ); |
62 | }; |
06d02aac |
63 | |
64 | subtype 'Num' |
65 | => as 'Str' |
66 | => where { Scalar::Util::looks_like_number($_) } |
4e36cf24 |
67 | => optimize_as( \&_Num ) |
68 | => inline_as { "!ref $_[0] && Scalar::Util::looks_like_number($_[0])" }; |
06d02aac |
69 | |
70 | subtype 'Int' |
71 | => as 'Num' |
72 | => where { "$_" =~ /^-?[0-9]+$/ } |
4e36cf24 |
73 | => optimize_as( \&_Int ) |
74 | => inline_as { |
75 | return ( qq{defined $_[0]} |
76 | . qq{&& ! ref $_[0]} |
77 | . qq{&& ( my \$value = $_[0] ) =~ /\\A-?[0-9]+\\z/} ); |
78 | }; |
06d02aac |
79 | |
80 | subtype 'CodeRef' |
81 | => as 'Ref' |
82 | => where { ref($_) eq 'CODE' } |
4e36cf24 |
83 | => optimize_as( \&_CodeRef ) |
94ab1609 |
84 | => inline_as { qq{ref $_[0] eq 'CODE'} }; |
06d02aac |
85 | |
86 | subtype 'RegexpRef' |
87 | => as 'Ref' |
9882ca98 |
88 | => where( \&_RegexpRef ) |
4e36cf24 |
89 | => optimize_as( \&_RegexpRef ) |
94ab1609 |
90 | => inline_as { "Moose::Util::TypeConstraints::Builtins::_RegexpRef( $_[0] )" }; |
06d02aac |
91 | |
92 | subtype 'GlobRef' |
93 | => as 'Ref' |
94 | => where { ref($_) eq 'GLOB' } |
4e36cf24 |
95 | => optimize_as( \&_GlobRef ) |
94ab1609 |
96 | => inline_as { qq{ref $_[0] eq 'GLOB'} }; |
06d02aac |
97 | |
98 | # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a |
99 | # filehandle |
100 | subtype 'FileHandle' |
94ab1609 |
101 | => as 'Ref' |
06d02aac |
102 | => where { |
103 | Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") ); |
104 | } |
4e36cf24 |
105 | => optimize_as( \&_FileHandle ) |
106 | => inline_as { |
94ab1609 |
107 | return ( qq{ref $_[0] eq 'GLOB'} |
4e36cf24 |
108 | . qq{&& Scalar::Util::openhandle( $_[0] )} |
94ab1609 |
109 | . qq{or Scalar::Util::blessed( $_[0] ) && $_[0]->isa("IO::Handle")} ); |
4e36cf24 |
110 | }; |
06d02aac |
111 | |
112 | subtype 'Object' |
113 | => as 'Ref' |
114 | => where { blessed($_) } |
4e36cf24 |
115 | => optimize_as( \&_Object ) |
116 | => inline_as { "Scalar::Util::blessed( $_[0] )" }; |
06d02aac |
117 | |
118 | # This type is deprecated. |
119 | subtype 'Role' |
120 | => as 'Object' |
121 | => where { $_->can('does') } |
4e36cf24 |
122 | => optimize_as( \&_Role ); |
06d02aac |
123 | |
124 | subtype 'ClassName' |
125 | => as 'Str' |
126 | => where { Class::MOP::is_class_loaded($_) } |
4e36cf24 |
127 | => optimize_as( \&_ClassName ) |
128 | => inline_as { "Class::MOP::is_class_loaded( $_[0] )" }; |
06d02aac |
129 | |
130 | subtype 'RoleName' |
131 | => as 'ClassName' |
132 | => where { |
133 | (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role'); |
134 | } |
4e36cf24 |
135 | => optimize_as( \&_RoleName ) |
136 | => inline_as { |
137 | return ( qq{Class::MOP::is_class_loaded( $_[0] )} |
138 | . qq{&& ( Class::MOP::class_of( $_[0] ) || return )} |
139 | . qq{ ->isa('Moose::Meta::Role')} ); |
140 | }; |
06d02aac |
141 | |
142 | $registry->add_type_constraint( |
143 | Moose::Meta::TypeConstraint::Parameterizable->new( |
144 | name => 'ScalarRef', |
145 | package_defined_in => __PACKAGE__, |
146 | parent => |
147 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
148 | constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' }, |
9882ca98 |
149 | optimized => \&_ScalarRef, |
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 | }, |
157 | inlined => sub {qq{ref $_[0] eq 'SCALAR' || ref $_[0] eq 'REF'}}, |
158 | inline_generator => sub { |
159 | my $type_parameter = shift; |
160 | my $val = shift; |
161 | return $type_parameter->_inline_check( |
162 | '${ (' . $val . ') }' ); |
163 | }, |
06d02aac |
164 | ) |
165 | ); |
166 | |
167 | $registry->add_type_constraint( |
168 | Moose::Meta::TypeConstraint::Parameterizable->new( |
169 | name => 'ArrayRef', |
170 | package_defined_in => __PACKAGE__, |
171 | parent => |
172 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
173 | constraint => sub { ref($_) eq 'ARRAY' }, |
9882ca98 |
174 | optimized => \&_ArrayRef, |
06d02aac |
175 | constraint_generator => sub { |
176 | my $type_parameter = shift; |
177 | my $check = $type_parameter->_compiled_type_constraint; |
178 | return sub { |
179 | foreach my $x (@$_) { |
180 | ( $check->($x) ) || return; |
181 | } |
182 | 1; |
183 | } |
7fb4b360 |
184 | }, |
185 | inlined => sub {qq{ref $_[0] eq 'ARRAY'}}, |
186 | inline_generator => sub { |
187 | my $type_parameter = shift; |
188 | my $val = shift; |
189 | return |
190 | '&List::MoreUtils::all( sub { ' |
191 | . $type_parameter->_inline_check('$_') |
192 | . " }, \@{$val} )"; |
193 | }, |
06d02aac |
194 | ) |
195 | ); |
196 | |
197 | $registry->add_type_constraint( |
198 | Moose::Meta::TypeConstraint::Parameterizable->new( |
199 | name => 'HashRef', |
200 | package_defined_in => __PACKAGE__, |
201 | parent => |
202 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
203 | constraint => sub { ref($_) eq 'HASH' }, |
9882ca98 |
204 | optimized => \&_HashRef, |
06d02aac |
205 | constraint_generator => sub { |
206 | my $type_parameter = shift; |
207 | my $check = $type_parameter->_compiled_type_constraint; |
208 | return sub { |
209 | foreach my $x ( values %$_ ) { |
210 | ( $check->($x) ) || return; |
211 | } |
212 | 1; |
213 | } |
7fb4b360 |
214 | }, |
215 | inlined => sub {qq{ref $_[0] eq 'HASH'}}, |
216 | inline_generator => sub { |
217 | my $type_parameter = shift; |
218 | my $val = shift; |
219 | return |
220 | '&List::MoreUtils::all( sub { ' |
221 | . $type_parameter->_inline_check('$_') |
222 | . " }, values \%{$val} )"; |
223 | }, |
06d02aac |
224 | ) |
225 | ); |
226 | |
227 | $registry->add_type_constraint( |
228 | Moose::Meta::TypeConstraint::Parameterizable->new( |
229 | name => 'Maybe', |
230 | package_defined_in => __PACKAGE__, |
231 | parent => |
232 | Moose::Util::TypeConstraints::find_type_constraint('Item'), |
233 | constraint => sub {1}, |
234 | constraint_generator => sub { |
235 | my $type_parameter = shift; |
236 | my $check = $type_parameter->_compiled_type_constraint; |
237 | return sub { |
238 | return 1 if not( defined($_) ) || $check->($_); |
239 | return; |
240 | } |
7fb4b360 |
241 | }, |
242 | inlined => sub {'1'}, |
243 | inline_generator => sub { |
244 | my $type_parameter = shift; |
245 | my $val = shift; |
246 | return |
247 | "(! defined $val) || (" |
248 | . $type_parameter->_inline_check($val) . ')'; |
249 | }, |
06d02aac |
250 | ) |
251 | ); |
252 | } |
253 | |
9882ca98 |
254 | sub _Value { defined($_[0]) && !ref($_[0]) } |
255 | |
256 | sub _Ref { ref($_[0]) } |
257 | |
258 | # We might need to use a temporary here to flatten LVALUEs, for instance as in |
259 | # Str(substr($_,0,255)). |
260 | sub _Str { |
261 | defined($_[0]) |
262 | && ( ref(\ $_[0] ) eq 'SCALAR' |
263 | || ref(\(my $value = $_[0])) eq 'SCALAR') |
264 | } |
265 | |
266 | sub _Num { !ref($_[0]) && looks_like_number($_[0]) } |
267 | |
268 | # using a temporary here because regex matching promotes an IV to a PV, |
269 | # and that confuses some things (like JSON.pm) |
270 | sub _Int { |
271 | my $value = $_[0]; |
272 | defined($value) && !ref($value) && $value =~ /\A-?[0-9]+\z/ |
273 | } |
274 | |
275 | sub _ScalarRef { ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF' } |
276 | sub _ArrayRef { ref($_[0]) eq 'ARRAY' } |
277 | sub _HashRef { ref($_[0]) eq 'HASH' } |
278 | sub _CodeRef { ref($_[0]) eq 'CODE' } |
279 | sub _GlobRef { ref($_[0]) eq 'GLOB' } |
280 | |
281 | # RegexpRef is implemented in Moose.xs |
282 | |
283 | sub _FileHandle { |
284 | ref( $_[0] ) eq 'GLOB' && Scalar::Util::openhandle( $_[0] ) |
285 | or blessed( $_[0] ) && $_[0]->isa("IO::Handle"); |
286 | } |
287 | |
288 | sub _Object { blessed($_[0]) } |
289 | |
290 | sub _Role { |
291 | Moose::Deprecated::deprecated( |
292 | feature => 'Role type', |
293 | message => |
294 | 'The Role type has been deprecated. Maybe you meant to create a RoleName type? This type be will be removed in Moose 2.0200.' |
295 | ); |
296 | blessed( $_[0] ) && $_[0]->can('does'); |
297 | } |
298 | |
299 | sub _ClassName { |
300 | return Class::MOP::is_class_loaded( $_[0] ); |
301 | } |
302 | |
303 | sub _RoleName { |
4e36cf24 |
304 | _ClassName( $_[0] ) |
9882ca98 |
305 | && ( Class::MOP::class_of( $_[0] ) || return ) |
306 | ->isa('Moose::Meta::Role'); |
307 | } |
308 | |
06d02aac |
309 | 1; |