1 package Mouse::Util::TypeConstraints;
8 use Scalar::Util qw/blessed looks_like_number openhandle/;
10 use Mouse::Util qw(does_role not_supported);
11 use Mouse::Meta::Module; # class_of
12 use Mouse::Meta::TypeConstraint;
14 our @ISA = qw(Exporter);
16 as where message from via type subtype coerce class_type role_type enum
29 return(where => $_[0])
32 return(message => $_[0])
43 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
44 Undef => sub { !defined($_[0]) },
45 Defined => sub { defined($_[0]) },
46 Value => sub { defined($_[0]) && !ref($_[0]) },
47 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
48 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
49 Str => sub { defined($_[0]) && !ref($_[0]) },
50 Ref => sub { ref($_[0]) },
52 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
53 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
54 HashRef => sub { ref($_[0]) eq 'HASH' },
55 CodeRef => sub { ref($_[0]) eq 'CODE' },
56 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
57 GlobRef => sub { ref($_[0]) eq 'GLOB' },
60 ref($_[0]) eq 'GLOB' && openhandle($_[0])
62 blessed($_[0]) && $_[0]->isa("IO::Handle")
65 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
67 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
68 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
71 while (my ($name, $code) = each %builtins) {
72 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
74 _compiled_type_constraint => $code,
76 $TYPE_SOURCE{$name} = __PACKAGE__;
79 sub optimized_constraints { \%TYPE }
81 my @builtins = keys %TYPE;
82 sub list_all_builtin_type_constraints { @builtins }
84 sub list_all_type_constraints { keys %TYPE }
91 if(@_ == 1 && ref $_[0]){ # type { where => ... }
94 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
98 elsif(@_ % 2){ # odd number of arguments
106 $name = '__ANON__' if !defined $name;
110 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
111 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
114 my $constraint = $conf{where} || do {
115 my $as = delete $conf{as} || 'Any';
116 ($TYPE{$as} ||= _build_type_constraint($as))->{_compiled_type_constraint};
119 my $tc = Mouse::Meta::TypeConstraint->new(
121 _compiled_type_constraint => sub {
123 return &{$constraint};
127 $TYPE_SOURCE{$name} = $pkg;
137 if(@_ == 1 && ref $_[0]){ # type { where => ... }
140 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
144 elsif(@_ % 2){ # odd number of arguments
152 $name = '__ANON__' if !defined $name;
156 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
157 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
160 my $constraint = delete $conf{where};
161 my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any')
162 ->{_compiled_type_constraint};
164 my $tc = Mouse::Meta::TypeConstraint->new(
166 _compiled_type_constraint => (
170 $as_constraint->($_[0]) && $constraint->($_[0])
174 $as_constraint->($_[0]);
180 $TYPE_SOURCE{$name} = $pkg;
189 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
192 unless ($COERCE{$name}) {
194 $COERCE_KEYS{$name} = [];
197 while (my($type, $code) = splice @_, 0, 2) {
198 Carp::croak "A coercion action already exists for '$type'"
199 if $COERCE{$name}->{$type};
201 if (! $TYPE{$type}) {
202 # looks parameterized
203 if ($type =~ /^[^\[]+\[.+\]$/) {
204 $TYPE{$type} = _build_type_constraint($type);
206 Carp::croak "Could not find the type constraint ($type) to coerce from"
210 push @{ $COERCE_KEYS{$name} }, $type;
211 $COERCE{$name}->{$type} = $code;
217 my($name, $conf) = @_;
218 if ($conf && $conf->{class}) {
219 # No, you're using this wrong
220 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
221 subtype $name => (as => $conf->{class});
225 where => sub { blessed($_) && $_->isa($name) },
231 my($name, $conf) = @_;
232 my $role = $conf->{role};
234 where => sub { does_role($_, $role) },
238 # this is an original method for Mouse
239 sub typecast_constraints {
240 my($class, $pkg, $types, $value) = @_;
241 Carp::croak("wrong arguments count") unless @_ == 4;
244 for my $type ( split /\|/, $types ) {
245 next unless $COERCE{$type};
246 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
248 next unless $TYPE{$coerce_type}->check($value);
250 $_ = $COERCE{$type}->{$coerce_type}->($value);
251 return $_ if $types->check($_);
259 # enum ['small', 'medium', 'large']
260 if (ref($_[0]) eq 'ARRAY') {
261 my @elements = @{ shift @_ };
263 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
265 enum($name, @elements);
269 # enum size => 'small', 'medium', 'large'
271 my %is_valid = map { $_ => 1 } @_;
274 $name => where => sub { $is_valid{$_} }
278 sub _build_type_constraint {
284 if ($spec =~ /\A (\w+) \[ (.+) \] \z/xms) {
290 if ($constraint eq 'Maybe') {
291 $parent = _build_type_constraint('Undef');
294 $parent = _build_type_constraint($constraint);
296 my $child = _build_type_constraint($param);
297 if ($constraint eq 'ArrayRef') {
299 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
301 " if (\$parent->check(\$_[0])) {\n" .
302 " foreach my \$e (\@{\$_[0]}) {\n" .
303 " return () unless \$child->check(\$e);\n" .
310 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
311 } elsif ($constraint eq 'HashRef') {
313 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
315 " if (\$parent->check(\$_[0])) {\n" .
316 " foreach my \$e (values \%{\$_[0]}) {\n" .
317 " return () unless \$child->check(\$e);\n" .
324 $code = eval $code_str or Carp::confess($@);
325 } elsif ($constraint eq 'Maybe') {
327 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
329 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
332 $code = eval $code_str or Carp::confess($@);
334 Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
336 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
338 $code = $TYPE{ $spec };
340 # is $spec a known role? If so, constrain with 'does' instead of 'isa'
341 require Mouse::Meta::Role;
342 my $check = Mouse::Meta::Role->_metaclass_cache($spec)?
345 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
347 " Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
350 $code = eval $code_str or Carp::confess($@);
351 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
354 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
357 sub find_type_constraint {
359 if(blessed($type) && $type->isa('Mouse::Meta::TypeConstraint')){
367 sub find_or_create_does_type_constraint{
371 sub find_or_create_isa_type_constraint {
372 my $type_constraint = shift;
374 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)")
375 if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
382 $type_constraint =~ s/\s+//g;
384 my $tc = find_type_constraint($type_constraint);
386 my @type_constraints = split /\|/, $type_constraint;
387 if (@type_constraints == 1) {
388 $tc = $TYPE{$type_constraints[0]} ||
389 _build_type_constraint($type_constraints[0]);
392 my @code_list = map {
393 $TYPE{$_} || _build_type_constraint($_)
396 $tc = Mouse::Meta::TypeConstraint->new(
397 name => $type_constraint,
399 _compiled_type_constraint => sub {
400 foreach my $code (@code_list) {
401 return 1 if $code->check($_[0]);
417 Mouse::Util::TypeConstraints - Type constraint system for Mouse
421 use Mouse::Util::TypeConstraints;
427 subtype 'NaturalLessThanTen'
430 => message { "This number ($_) is not less than ten!" };
436 enum 'RGBColors' => qw(red green blue);
438 no Mouse::Util::TypeConstraints;
442 This module provides Mouse with the ability to create custom type
443 constraints to be used in attribute definition.
445 =head2 Important Caveat
447 This is B<NOT> a type system for Perl 5. These are type constraints,
448 and they are not used by Mouse unless you tell it to. No type
449 inference is performed, expressions are not typed, etc. etc. etc.
451 A type constraint is at heart a small "check if a value is valid"
452 function. A constraint can be associated with an attribute. This
453 simplifies parameter validation, and makes your code clearer to read,
454 because you can refer to constraints by name.
456 =head2 Slightly Less Important Caveat
458 It is B<always> a good idea to quote your type names.
460 This prevents Perl from trying to execute the call as an indirect
461 object call. This can be an issue when you have a subtype with the
462 same name as a valid class.
466 subtype DateTime => as Object => where { $_->isa('DateTime') };
468 will I<just work>, while this:
471 subtype DateTime => as Object => where { $_->isa('DateTime') };
473 will fail silently and cause many headaches. The simple way to solve
474 this, as well as future proof your subtypes from classes which have
475 yet to have been created, is to quote the type name:
478 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
480 =head2 Default Type Constraints
482 This module also provides a simple hierarchy for Perl 5 types, here is
483 that hierarchy represented visually.
508 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
509 parameterized, this means you can say:
511 ArrayRef[Int] # an array of integers
512 HashRef[CodeRef] # a hash of str to CODE ref mappings
513 Maybe[Str] # value may be a string, may be undefined
515 If Mouse finds a name in brackets that it does not recognize as an
516 existing type, it assumes that this is a class name, for example
517 C<ArrayRef[DateTime]>.
519 B<NOTE:> Unless you parameterize a type, then it is invalid to include
520 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
521 name, I<not> as a parameterization of C<ArrayRef>.
523 B<NOTE:> The C<Undef> type constraint for the most part works
524 correctly now, but edge cases may still exist, please use it
527 B<NOTE:> The C<ClassName> type constraint does a complex package
528 existence check. This means that your class B<must> be loaded for this
529 type constraint to pass.
531 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
532 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
533 constraint checks that an I<object does> the named role.
535 =head2 Type Constraint Naming
537 Type name declared via this module can only contain alphanumeric
538 characters, colons (:), and periods (.).
540 Since the types created by this module are global, it is suggested
541 that you namespace your types just as you would namespace your
542 modules. So instead of creating a I<Color> type for your
543 B<My::Graphics> module, you would call the type
544 I<My::Graphics::Types::Color> instead.
546 =head2 Use with Other Constraint Modules
548 This module can play nicely with other constraint modules with some
549 slight tweaking. The C<where> clause in types is expected to be a
550 C<CODE> reference which checks it's first argument and returns a
551 boolean. Since most constraint modules work in a similar way, it
552 should be simple to adapt them to work with Mouse.
554 For instance, this is how you could use it with
555 L<Declare::Constraints::Simple> to declare a completely new type.
557 type 'HashOfArrayOfObjects',
561 -values => IsArrayRef(IsObject)
565 Here is an example of using L<Test::Deep> and it's non-test
566 related C<eq_deeply> function.
568 type 'ArrayOfHashOfBarsAndRandomNumbers'
571 array_each(subhashof({
573 random_number => ignore()
579 =head2 optimized_constraints -> HashRef[CODE]
581 Returns the simple type constraints that Mouse understands.
587 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
589 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
591 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
593 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
595 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
601 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
607 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
611 L<Moose::Util::TypeConstraints>