1 package Mouse::Util::TypeConstraints;
7 use Scalar::Util qw/blessed looks_like_number openhandle/;
9 use Mouse::Util qw(does_role not_supported);
10 use Mouse::Meta::Module; # class_of
11 use Mouse::Meta::TypeConstraint;
14 as where message from via type subtype coerce class_type role_type enum
27 return(where => $_[0])
30 return(message => $_[0])
41 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
42 Undef => sub { !defined($_[0]) },
43 Defined => sub { defined($_[0]) },
44 Value => sub { defined($_[0]) && !ref($_[0]) },
45 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
46 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
47 Str => sub { defined($_[0]) && !ref($_[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 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
66 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
69 while (my ($name, $code) = each %builtins) {
70 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
72 _compiled_type_constraint => $code,
74 $TYPE_SOURCE{$name} = __PACKAGE__;
77 sub optimized_constraints { \%TYPE }
79 my @builtins = keys %TYPE;
80 sub list_all_builtin_type_constraints { @builtins }
82 sub list_all_type_constraints { keys %TYPE }
89 if(@_ == 1 && ref $_[0]){ # type { where => ... }
92 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
96 elsif(@_ % 2){ # odd number of arguments
104 $name = '__ANON__' if !defined $name;
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";
112 my $constraint = $conf{where} || do {
113 my $as = delete $conf{as} || 'Any';
114 ($TYPE{$as} ||= _build_type_constraint($as))->{_compiled_type_constraint};
117 my $tc = Mouse::Meta::TypeConstraint->new(
119 _compiled_type_constraint => sub {
121 return &{$constraint};
125 $TYPE_SOURCE{$name} = $pkg;
135 if(@_ == 1 && ref $_[0]){ # type { where => ... }
138 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
142 elsif(@_ % 2){ # odd number of arguments
150 $name = '__ANON__' if !defined $name;
154 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
155 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
158 my $constraint = delete $conf{where};
159 my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any')
160 ->{_compiled_type_constraint};
162 my $tc = Mouse::Meta::TypeConstraint->new(
164 _compiled_type_constraint => (
168 $as_constraint->($_[0]) && $constraint->($_[0])
172 $as_constraint->($_[0]);
178 $TYPE_SOURCE{$name} = $pkg;
187 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
190 unless ($COERCE{$name}) {
192 $COERCE_KEYS{$name} = [];
195 while (my($type, $code) = splice @_, 0, 2) {
196 Carp::croak "A coercion action already exists for '$type'"
197 if $COERCE{$name}->{$type};
199 if (! $TYPE{$type}) {
200 # looks parameterized
201 if ($type =~ /^[^\[]+\[.+\]$/) {
202 $TYPE{$type} = _build_type_constraint($type);
204 Carp::croak "Could not find the type constraint ($type) to coerce from"
208 push @{ $COERCE_KEYS{$name} }, $type;
209 $COERCE{$name}->{$type} = $code;
215 my($name, $conf) = @_;
216 if ($conf && $conf->{class}) {
217 # No, you're using this wrong
218 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
219 subtype $name => (as => $conf->{class});
223 where => sub { blessed($_) && $_->isa($name) },
229 my($name, $conf) = @_;
230 my $role = $conf->{role};
232 where => sub { does_role($_, $role) },
236 # this is an original method for Mouse
237 sub typecast_constraints {
238 my($class, $pkg, $types, $value) = @_;
239 Carp::croak("wrong arguments count") unless @_ == 4;
242 for my $type ( split /\|/, $types ) {
243 next unless $COERCE{$type};
244 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
246 next unless $TYPE{$coerce_type}->check($value);
248 $_ = $COERCE{$type}->{$coerce_type}->($value);
249 return $_ if $types->check($_);
257 # enum ['small', 'medium', 'large']
258 if (ref($_[0]) eq 'ARRAY') {
259 my @elements = @{ shift @_ };
261 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
263 enum($name, @elements);
267 # enum size => 'small', 'medium', 'large'
269 my %is_valid = map { $_ => 1 } @_;
272 $name => where => sub { $is_valid{$_} }
276 sub _build_type_constraint {
282 if ($spec =~ /\A (\w+) \[ (.+) \] \z/xms) {
288 if ($constraint eq 'Maybe') {
289 $parent = _build_type_constraint('Undef');
292 $parent = _build_type_constraint($constraint);
294 my $child = _build_type_constraint($param);
295 if ($constraint eq 'ArrayRef') {
297 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
299 " if (\$parent->check(\$_[0])) {\n" .
300 " foreach my \$e (\@{\$_[0]}) {\n" .
301 " return () unless \$child->check(\$e);\n" .
308 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
309 } elsif ($constraint eq 'HashRef') {
311 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
313 " if (\$parent->check(\$_[0])) {\n" .
314 " foreach my \$e (values \%{\$_[0]}) {\n" .
315 " return () unless \$child->check(\$e);\n" .
322 $code = eval $code_str or Carp::confess($@);
323 } elsif ($constraint eq 'Maybe') {
325 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
327 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
330 $code = eval $code_str or Carp::confess($@);
332 Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
334 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
336 $code = $TYPE{ $spec };
338 # is $spec a known role? If so, constrain with 'does' instead of 'isa'
339 require Mouse::Meta::Role;
340 my $check = Mouse::Meta::Role->_metaclass_cache($spec)?
343 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
345 " Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
348 $code = eval $code_str or Carp::confess($@);
349 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
352 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
355 sub find_type_constraint {
357 if(blessed($type) && $type->isa('Mouse::Meta::TypeConstraint')){
365 sub find_or_create_does_type_constraint{
369 sub find_or_create_isa_type_constraint {
370 my $type_constraint = shift;
372 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)")
373 if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
380 $type_constraint =~ s/\s+//g;
382 my $tc = find_type_constraint($type_constraint);
384 my @type_constraints = split /\|/, $type_constraint;
385 if (@type_constraints == 1) {
386 $tc = $TYPE{$type_constraints[0]} ||
387 _build_type_constraint($type_constraints[0]);
390 my @code_list = map {
391 $TYPE{$_} || _build_type_constraint($_)
394 $tc = Mouse::Meta::TypeConstraint->new(
395 name => $type_constraint,
397 _compiled_type_constraint => sub {
398 foreach my $code (@code_list) {
399 return 1 if $code->check($_[0]);
415 Mouse::Util::TypeConstraints - Type constraint system for Mouse
419 use Mouse::Util::TypeConstraints;
425 subtype 'NaturalLessThanTen'
428 => message { "This number ($_) is not less than ten!" };
434 enum 'RGBColors' => qw(red green blue);
436 no Mouse::Util::TypeConstraints;
440 This module provides Mouse with the ability to create custom type
441 constraints to be used in attribute definition.
443 =head2 Important Caveat
445 This is B<NOT> a type system for Perl 5. These are type constraints,
446 and they are not used by Mouse unless you tell it to. No type
447 inference is performed, expressions are not typed, etc. etc. etc.
449 A type constraint is at heart a small "check if a value is valid"
450 function. A constraint can be associated with an attribute. This
451 simplifies parameter validation, and makes your code clearer to read,
452 because you can refer to constraints by name.
454 =head2 Slightly Less Important Caveat
456 It is B<always> a good idea to quote your type names.
458 This prevents Perl from trying to execute the call as an indirect
459 object call. This can be an issue when you have a subtype with the
460 same name as a valid class.
464 subtype DateTime => as Object => where { $_->isa('DateTime') };
466 will I<just work>, while this:
469 subtype DateTime => as Object => where { $_->isa('DateTime') };
471 will fail silently and cause many headaches. The simple way to solve
472 this, as well as future proof your subtypes from classes which have
473 yet to have been created, is to quote the type name:
476 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
478 =head2 Default Type Constraints
480 This module also provides a simple hierarchy for Perl 5 types, here is
481 that hierarchy represented visually.
506 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
507 parameterized, this means you can say:
509 ArrayRef[Int] # an array of integers
510 HashRef[CodeRef] # a hash of str to CODE ref mappings
511 Maybe[Str] # value may be a string, may be undefined
513 If Mouse finds a name in brackets that it does not recognize as an
514 existing type, it assumes that this is a class name, for example
515 C<ArrayRef[DateTime]>.
517 B<NOTE:> Unless you parameterize a type, then it is invalid to include
518 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
519 name, I<not> as a parameterization of C<ArrayRef>.
521 B<NOTE:> The C<Undef> type constraint for the most part works
522 correctly now, but edge cases may still exist, please use it
525 B<NOTE:> The C<ClassName> type constraint does a complex package
526 existence check. This means that your class B<must> be loaded for this
527 type constraint to pass.
529 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
530 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
531 constraint checks that an I<object does> the named role.
533 =head2 Type Constraint Naming
535 Type name declared via this module can only contain alphanumeric
536 characters, colons (:), and periods (.).
538 Since the types created by this module are global, it is suggested
539 that you namespace your types just as you would namespace your
540 modules. So instead of creating a I<Color> type for your
541 B<My::Graphics> module, you would call the type
542 I<My::Graphics::Types::Color> instead.
544 =head2 Use with Other Constraint Modules
546 This module can play nicely with other constraint modules with some
547 slight tweaking. The C<where> clause in types is expected to be a
548 C<CODE> reference which checks it's first argument and returns a
549 boolean. Since most constraint modules work in a similar way, it
550 should be simple to adapt them to work with Mouse.
552 For instance, this is how you could use it with
553 L<Declare::Constraints::Simple> to declare a completely new type.
555 type 'HashOfArrayOfObjects',
559 -values => IsArrayRef(IsObject)
563 Here is an example of using L<Test::Deep> and it's non-test
564 related C<eq_deeply> function.
566 type 'ArrayOfHashOfBarsAndRandomNumbers'
569 array_each(subhashof({
571 random_number => ignore()
577 =head2 optimized_constraints -> HashRef[CODE]
579 Returns the simple type constraints that Mouse understands.
585 =item B<subtype 'Name' => as 'Parent' => where { } ...>
587 =item B<subtype as 'Parent' => where { } ...>
589 =item B<class_type ($class, ?$options)>
591 =item B<role_type ($role, ?$options)>
593 =item B<enum (\@values)>
599 Much of this documentation was taken from L<Moose::Util::TypeConstraints>