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($_) } |
964294c1 |
30 | => inline_as { "! defined $_[1]" }; |
4e36cf24 |
31 | |
32 | subtype 'Defined' |
33 | => as 'Item' |
34 | => where { defined($_) } |
964294c1 |
35 | => inline_as { "defined $_[1]" }; |
06d02aac |
36 | |
37 | subtype 'Bool' |
38 | => as 'Item' |
4e36cf24 |
39 | => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' } |
964294c1 |
40 | => inline_as { qq{!defined($_[1]) || $_[1] eq "" || "$_[1]" eq '1' || "$_[1]" eq '0'} }; |
06d02aac |
41 | |
42 | subtype 'Value' |
43 | => as 'Defined' |
44 | => where { !ref($_) } |
964294c1 |
45 | => inline_as { "defined $_[1] && ! ref $_[1]" }; |
06d02aac |
46 | |
47 | subtype 'Ref' |
48 | => as 'Defined' |
49 | => where { ref($_) } |
964294c1 |
50 | => inline_as { "ref $_[1]" }; |
06d02aac |
51 | |
52 | subtype 'Str' |
53 | => as 'Value' |
54 | => where { ref(\$_) eq 'SCALAR' } |
4e36cf24 |
55 | => inline_as { |
964294c1 |
56 | return ( qq{defined $_[1]} |
57 | . qq{&& ( ref(\\ $_[1] ) eq 'SCALAR'} |
ff1687ca |
58 | . qq{ || ref(\\(my \$str_value = $_[1])) eq 'SCALAR')} ); |
4e36cf24 |
59 | }; |
06d02aac |
60 | |
61 | subtype 'Num' |
62 | => as 'Str' |
63 | => where { Scalar::Util::looks_like_number($_) } |
964294c1 |
64 | => inline_as { "!ref $_[1] && Scalar::Util::looks_like_number($_[1])" }; |
06d02aac |
65 | |
66 | subtype 'Int' |
67 | => as 'Num' |
743ec002 |
68 | => where { "$_" =~ /\A-?[0-9]+\z/ } |
4e36cf24 |
69 | => inline_as { |
964294c1 |
70 | return ( qq{defined $_[1]} |
71 | . qq{&& ! ref $_[1]} |
ff1687ca |
72 | . qq{&& ( my \$int_value = $_[1] ) =~ /\\A-?[0-9]+\\z/} ); |
4e36cf24 |
73 | }; |
06d02aac |
74 | |
75 | subtype 'CodeRef' |
76 | => as 'Ref' |
77 | => where { ref($_) eq 'CODE' } |
964294c1 |
78 | => inline_as { qq{ref $_[1] eq 'CODE'} }; |
06d02aac |
79 | |
80 | subtype 'RegexpRef' |
81 | => as 'Ref' |
9882ca98 |
82 | => where( \&_RegexpRef ) |
964294c1 |
83 | => inline_as { "Moose::Util::TypeConstraints::Builtins::_RegexpRef( $_[1] )" }; |
06d02aac |
84 | |
85 | subtype 'GlobRef' |
86 | => as 'Ref' |
87 | => where { ref($_) eq 'GLOB' } |
964294c1 |
88 | => inline_as { qq{ref $_[1] eq 'GLOB'} }; |
06d02aac |
89 | |
90 | # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a |
91 | # filehandle |
92 | subtype 'FileHandle' |
94ab1609 |
93 | => as 'Ref' |
06d02aac |
94 | => where { |
95 | Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") ); |
96 | } |
4e36cf24 |
97 | => inline_as { |
964294c1 |
98 | return ( qq{ref $_[1] eq 'GLOB'} |
99 | . qq{&& Scalar::Util::openhandle( $_[1] )} |
100 | . qq{or Scalar::Util::blessed( $_[1] ) && $_[1]->isa("IO::Handle")} ); |
4e36cf24 |
101 | }; |
06d02aac |
102 | |
103 | subtype 'Object' |
104 | => as 'Ref' |
105 | => where { blessed($_) } |
964294c1 |
106 | => inline_as { "Scalar::Util::blessed( $_[1] )" }; |
06d02aac |
107 | |
108 | # This type is deprecated. |
109 | subtype 'Role' |
110 | => as 'Object' |
43837b8a |
111 | => where { $_->can('does') }; |
06d02aac |
112 | |
113 | subtype 'ClassName' |
114 | => as 'Str' |
115 | => where { Class::MOP::is_class_loaded($_) } |
964294c1 |
116 | => inline_as { "Class::MOP::is_class_loaded( $_[1] )" }; |
06d02aac |
117 | |
118 | subtype 'RoleName' |
119 | => as 'ClassName' |
120 | => where { |
121 | (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role'); |
122 | } |
4e36cf24 |
123 | => inline_as { |
964294c1 |
124 | return ( qq{Class::MOP::is_class_loaded( $_[1] )} |
125 | . qq{&& ( Class::MOP::class_of( $_[1] ) || return )} |
4e36cf24 |
126 | . qq{ ->isa('Moose::Meta::Role')} ); |
127 | }; |
06d02aac |
128 | |
129 | $registry->add_type_constraint( |
130 | Moose::Meta::TypeConstraint::Parameterizable->new( |
131 | name => 'ScalarRef', |
132 | package_defined_in => __PACKAGE__, |
133 | parent => |
134 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
135 | constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' }, |
06d02aac |
136 | constraint_generator => sub { |
137 | my $type_parameter = shift; |
138 | my $check = $type_parameter->_compiled_type_constraint; |
139 | return sub { |
140 | return $check->( ${$_} ); |
141 | }; |
7fb4b360 |
142 | }, |
964294c1 |
143 | inlined => sub {qq{ref $_[1] eq 'SCALAR' || ref $_[1] eq 'REF'}}, |
7fb4b360 |
144 | inline_generator => sub { |
964294c1 |
145 | my $self = shift; |
7fb4b360 |
146 | my $type_parameter = shift; |
147 | my $val = shift; |
43837b8a |
148 | return qq{(ref $val eq 'SCALAR' || ref $val eq 'REF') && } |
149 | . $type_parameter->_inline_check( '${ (' . $val . ') }' ); |
7fb4b360 |
150 | }, |
06d02aac |
151 | ) |
152 | ); |
153 | |
154 | $registry->add_type_constraint( |
155 | Moose::Meta::TypeConstraint::Parameterizable->new( |
156 | name => 'ArrayRef', |
157 | package_defined_in => __PACKAGE__, |
158 | parent => |
159 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
160 | constraint => sub { ref($_) eq 'ARRAY' }, |
06d02aac |
161 | constraint_generator => sub { |
162 | my $type_parameter = shift; |
163 | my $check = $type_parameter->_compiled_type_constraint; |
164 | return sub { |
165 | foreach my $x (@$_) { |
166 | ( $check->($x) ) || return; |
167 | } |
168 | 1; |
169 | } |
7fb4b360 |
170 | }, |
964294c1 |
171 | inlined => sub {qq{ref $_[1] eq 'ARRAY'}}, |
7fb4b360 |
172 | inline_generator => sub { |
964294c1 |
173 | my $self = shift; |
7fb4b360 |
174 | my $type_parameter = shift; |
175 | my $val = shift; |
176 | return |
43837b8a |
177 | qq{ref $val eq 'ARRAY' && } |
178 | . '&List::MoreUtils::all( sub { ' |
7fb4b360 |
179 | . $type_parameter->_inline_check('$_') |
180 | . " }, \@{$val} )"; |
181 | }, |
06d02aac |
182 | ) |
183 | ); |
184 | |
185 | $registry->add_type_constraint( |
186 | Moose::Meta::TypeConstraint::Parameterizable->new( |
187 | name => 'HashRef', |
188 | package_defined_in => __PACKAGE__, |
189 | parent => |
190 | Moose::Util::TypeConstraints::find_type_constraint('Ref'), |
191 | constraint => sub { ref($_) eq 'HASH' }, |
06d02aac |
192 | constraint_generator => sub { |
193 | my $type_parameter = shift; |
194 | my $check = $type_parameter->_compiled_type_constraint; |
195 | return sub { |
196 | foreach my $x ( values %$_ ) { |
197 | ( $check->($x) ) || return; |
198 | } |
199 | 1; |
200 | } |
7fb4b360 |
201 | }, |
964294c1 |
202 | inlined => sub {qq{ref $_[1] eq 'HASH'}}, |
7fb4b360 |
203 | inline_generator => sub { |
964294c1 |
204 | my $self = shift; |
7fb4b360 |
205 | my $type_parameter = shift; |
206 | my $val = shift; |
207 | return |
43837b8a |
208 | qq{ref $val eq 'HASH' && } |
209 | . '&List::MoreUtils::all( sub { ' |
7fb4b360 |
210 | . $type_parameter->_inline_check('$_') |
211 | . " }, values \%{$val} )"; |
212 | }, |
06d02aac |
213 | ) |
214 | ); |
215 | |
216 | $registry->add_type_constraint( |
217 | Moose::Meta::TypeConstraint::Parameterizable->new( |
218 | name => 'Maybe', |
219 | package_defined_in => __PACKAGE__, |
220 | parent => |
221 | Moose::Util::TypeConstraints::find_type_constraint('Item'), |
222 | constraint => sub {1}, |
223 | constraint_generator => sub { |
224 | my $type_parameter = shift; |
225 | my $check = $type_parameter->_compiled_type_constraint; |
226 | return sub { |
227 | return 1 if not( defined($_) ) || $check->($_); |
228 | return; |
229 | } |
7fb4b360 |
230 | }, |
231 | inlined => sub {'1'}, |
232 | inline_generator => sub { |
964294c1 |
233 | my $self = shift; |
7fb4b360 |
234 | my $type_parameter = shift; |
235 | my $val = shift; |
236 | return |
237 | "(! defined $val) || (" |
238 | . $type_parameter->_inline_check($val) . ')'; |
239 | }, |
06d02aac |
240 | ) |
241 | ); |
242 | } |
243 | |
244 | 1; |