1 package Mouse::Util::TypeConstraints;
7 use Scalar::Util qw/blessed looks_like_number openhandle/;
8 use Mouse::Meta::TypeConstraint;
11 as where message from via type subtype coerce class_type role_type enum
24 return(where => $_[0])
27 return(message => $_[0])
34 no warnings 'uninitialized';
39 !defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0'
41 Undef => sub { !defined($_[0]) },
42 Defined => sub { defined($_[0]) },
43 Value => sub { defined($_[0]) && !ref($_[0]) },
44 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
45 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
46 Str => sub { defined($_[0]) && !ref($_[0]) },
47 ClassName => sub { Mouse::is_class_loaded($_[0]) },
48 Ref => sub { ref($_[0]) },
50 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
51 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
52 HashRef => sub { ref($_[0]) eq 'HASH' },
53 CodeRef => sub { ref($_[0]) eq 'CODE' },
54 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
55 GlobRef => sub { ref($_[0]) eq 'GLOB' },
58 ref($_[0]) eq 'GLOB' && openhandle($_[0])
60 blessed($_[0]) && $_[0]->isa("IO::Handle")
63 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
65 while (my ($name, $code) = each %TYPE) {
66 $TYPE{$name} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $name );
69 sub optimized_constraints { \%TYPE }
70 my @TYPE_KEYS = keys %TYPE;
71 sub list_all_builtin_type_constraints { @TYPE_KEYS }
73 @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS;
78 my($name, %conf) = @_;
80 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
81 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
83 my $constraint = $conf{where} || do {
84 my $as = delete $conf{as} || 'Any';
85 if (! exists $TYPE{$as}) {
86 $TYPE{$as} = _build_type_constraint($as);
91 $TYPE_SOURCE{$name} = $pkg;
92 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
94 _compiled_type_constraint => sub {
96 if (ref $constraint eq 'CODE') {
99 $constraint->check($_[0])
107 my($name, %conf) = @_;
108 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
109 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
111 my $constraint = delete $conf{where};
112 my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any');
114 $TYPE_SOURCE{$name} = $pkg;
115 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
117 _compiled_type_constraint => (
121 $as_constraint->check($_[0]) && $constraint->($_[0])
125 $as_constraint->check($_[0]);
137 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
140 unless ($COERCE{$name}) {
142 $COERCE_KEYS{$name} = [];
145 while (my($type, $code) = splice @_, 0, 2) {
146 Carp::croak "A coercion action already exists for '$type'"
147 if $COERCE{$name}->{$type};
149 if (! $TYPE{$type}) {
150 # looks parameterized
151 if ($type =~ /^[^\[]+\[.+\]$/) {
152 $TYPE{$type} = _build_type_constraint($type);
154 Carp::croak "Could not find the type constraint ($type) to coerce from"
158 push @{ $COERCE_KEYS{$name} }, $type;
159 $COERCE{$name}->{$type} = $code;
165 my($name, $conf) = @_;
166 if ($conf && $conf->{class}) {
167 # No, you're using this wrong
168 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
169 subtype($name, as => $conf->{class});
172 $name => where => sub { $_->isa($name) }
178 my($name, $conf) = @_;
179 my $role = $conf->{role};
181 $name => where => sub {
182 return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
183 $_->meta->does_role($role);
188 # this is an original method for Mouse
189 sub typecast_constraints {
190 my($class, $pkg, $types, $value) = @_;
191 Carp::croak("wrong arguments count") unless @_==4;
194 for my $type ( split /\|/, $types ) {
195 next unless $COERCE{$type};
196 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
198 next unless $TYPE{$coerce_type}->check($value);
200 $_ = $COERCE{$type}->{$coerce_type}->($value);
201 return $_ if $types->check($_);
209 # enum ['small', 'medium', 'large']
210 if (ref($_[0]) eq 'ARRAY') {
211 my @elements = @{ shift @_ };
213 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
215 enum($name, @elements);
219 # enum size => 'small', 'medium', 'large'
221 my %is_valid = map { $_ => 1 } @_;
224 $name => where => sub { $is_valid{$_} }
228 sub _build_type_constraint {
233 if ($spec =~ /^([^\[]+)\[(.+)\]$/) {
238 if ($constraint eq 'Maybe') {
239 $parent = _build_type_constraint('Undef');
241 $parent = _build_type_constraint($constraint);
243 my $child = _build_type_constraint($param);
244 if ($constraint eq 'ArrayRef') {
246 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
248 " if (\$parent->check(\$_[0])) {\n" .
249 " foreach my \$e (\@{\$_[0]}) {\n" .
250 " return () unless \$child->check(\$e);\n" .
257 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
258 } elsif ($constraint eq 'HashRef') {
260 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
262 " if (\$parent->check(\$_[0])) {\n" .
263 " foreach my \$e (values \%{\$_[0]}) {\n" .
264 " return () unless \$child->check(\$e);\n" .
271 $code = eval $code_str or Carp::confess($@);
272 } elsif ($constraint eq 'Maybe') {
274 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
276 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
279 $code = eval $code_str or Carp::confess($@);
281 Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
283 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
285 $code = $TYPE{ $spec };
287 # is $spec a known role? If so, constrain with 'does' instead of 'isa'
288 require Mouse::Meta::Role;
289 my $check = Mouse::Meta::Role->_metaclass_cache($spec)?
292 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
294 " Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
297 $code = eval $code_str or Carp::confess($@);
298 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
301 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
304 sub find_type_constraint {
305 my $type_constraint = shift;
306 return $TYPE{$type_constraint};
309 sub find_or_create_isa_type_constraint {
310 my $type_constraint = shift;
312 Carp::confess("Got isa => type_constraints, but Mouse does not yet support parameterized types for containers other than ArrayRef and HashRef and Maybe (rt.cpan.org #39795)")
313 if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
321 $type_constraint =~ s/\s+//g;
323 $code = $TYPE{$type_constraint};
325 my @type_constraints = split /\|/, $type_constraint;
326 if (@type_constraints == 1) {
327 $code = $TYPE{$type_constraints[0]} ||
328 _build_type_constraint($type_constraints[0]);
330 my @code_list = map {
331 $TYPE{$_} || _build_type_constraint($_)
333 $code = Mouse::Meta::TypeConstraint->new(
334 _compiled_type_constraint => sub {
336 for my $code (@code_list) {
337 return 1 if $code->check($_[0]);
341 name => $type_constraint,
354 Mouse::Util::TypeConstraints - Type constraint system for Mouse
358 use Mouse::Util::TypeConstraints;
364 subtype 'NaturalLessThanTen'
367 => message { "This number ($_) is not less than ten!" };
373 enum 'RGBColors' => qw(red green blue);
375 no Mouse::Util::TypeConstraints;
379 This module provides Mouse with the ability to create custom type
380 constraints to be used in attribute definition.
382 =head2 Important Caveat
384 This is B<NOT> a type system for Perl 5. These are type constraints,
385 and they are not used by Mouse unless you tell it to. No type
386 inference is performed, expressions are not typed, etc. etc. etc.
388 A type constraint is at heart a small "check if a value is valid"
389 function. A constraint can be associated with an attribute. This
390 simplifies parameter validation, and makes your code clearer to read,
391 because you can refer to constraints by name.
393 =head2 Slightly Less Important Caveat
395 It is B<always> a good idea to quote your type names.
397 This prevents Perl from trying to execute the call as an indirect
398 object call. This can be an issue when you have a subtype with the
399 same name as a valid class.
403 subtype DateTime => as Object => where { $_->isa('DateTime') };
405 will I<just work>, while this:
408 subtype DateTime => as Object => where { $_->isa('DateTime') };
410 will fail silently and cause many headaches. The simple way to solve
411 this, as well as future proof your subtypes from classes which have
412 yet to have been created, is to quote the type name:
415 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
417 =head2 Default Type Constraints
419 This module also provides a simple hierarchy for Perl 5 types, here is
420 that hierarchy represented visually.
445 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
446 parameterized, this means you can say:
448 ArrayRef[Int] # an array of integers
449 HashRef[CodeRef] # a hash of str to CODE ref mappings
450 Maybe[Str] # value may be a string, may be undefined
452 If Mouse finds a name in brackets that it does not recognize as an
453 existing type, it assumes that this is a class name, for example
454 C<ArrayRef[DateTime]>.
456 B<NOTE:> Unless you parameterize a type, then it is invalid to include
457 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
458 name, I<not> as a parameterization of C<ArrayRef>.
460 B<NOTE:> The C<Undef> type constraint for the most part works
461 correctly now, but edge cases may still exist, please use it
464 B<NOTE:> The C<ClassName> type constraint does a complex package
465 existence check. This means that your class B<must> be loaded for this
466 type constraint to pass.
468 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
469 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
470 constraint checks that an I<object does> the named role.
472 =head2 Type Constraint Naming
474 Type name declared via this module can only contain alphanumeric
475 characters, colons (:), and periods (.).
477 Since the types created by this module are global, it is suggested
478 that you namespace your types just as you would namespace your
479 modules. So instead of creating a I<Color> type for your
480 B<My::Graphics> module, you would call the type
481 I<My::Graphics::Types::Color> instead.
483 =head2 Use with Other Constraint Modules
485 This module can play nicely with other constraint modules with some
486 slight tweaking. The C<where> clause in types is expected to be a
487 C<CODE> reference which checks it's first argument and returns a
488 boolean. Since most constraint modules work in a similar way, it
489 should be simple to adapt them to work with Mouse.
491 For instance, this is how you could use it with
492 L<Declare::Constraints::Simple> to declare a completely new type.
494 type 'HashOfArrayOfObjects',
498 -values => IsArrayRef(IsObject)
502 Here is an example of using L<Test::Deep> and it's non-test
503 related C<eq_deeply> function.
505 type 'ArrayOfHashOfBarsAndRandomNumbers'
508 array_each(subhashof({
510 random_number => ignore()
516 =head2 optimized_constraints -> HashRef[CODE]
518 Returns the simple type constraints that Mouse understands.
524 =item B<subtype 'Name' => as 'Parent' => where { } ...>
526 =item B<subtype as 'Parent' => where { } ...>
528 =item B<class_type ($class, ?$options)>
530 =item B<role_type ($role, ?$options)>
532 =item B<enum (\@values)>
538 Much of this documentation was taken from L<Moose::Util::TypeConstraints>