1 package Mouse::Util::TypeConstraints;
7 use Scalar::Util qw/blessed looks_like_number openhandle/;
10 use Mouse::Meta::TypeConstraint;
13 as where message from via type subtype coerce class_type role_type enum
26 return(where => $_[0])
29 return(message => $_[0])
36 no warnings 'uninitialized';
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::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') },
68 while (my ($name, $code) = each %TYPE) {
69 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
71 _compiled_type_constraint => $code,
75 sub optimized_constraints { \%TYPE }
76 my @TYPE_KEYS = keys %TYPE;
77 sub list_all_builtin_type_constraints { @TYPE_KEYS }
79 @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS;
86 if(@_ == 1 && ref $_[0]){ # type { where => ... }
89 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
93 elsif(@_ % 2){ # odd number of arguments
101 $name = '__ANON__' if !defined $name;
105 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
106 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
108 my $constraint = $conf{where} || do {
109 my $as = delete $conf{as} || 'Any';
110 if (! exists $TYPE{$as}) {
111 $TYPE{$as} = _build_type_constraint($as);
116 $TYPE_SOURCE{$name} = $pkg;
117 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
119 _compiled_type_constraint => sub {
121 if (ref $constraint eq 'CODE') {
124 $constraint->check($_[0])
134 if(@_ == 1 && ref $_[0]){ # type { where => ... }
137 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
141 elsif(@_ % 2){ # odd number of arguments
149 $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";
157 my $constraint = delete $conf{where};
158 my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any');
160 $TYPE_SOURCE{$name} = $pkg;
161 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
163 _compiled_type_constraint => (
167 $as_constraint->check($_[0]) && $constraint->($_[0])
171 $as_constraint->check($_[0]);
183 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
186 unless ($COERCE{$name}) {
188 $COERCE_KEYS{$name} = [];
191 while (my($type, $code) = splice @_, 0, 2) {
192 Carp::croak "A coercion action already exists for '$type'"
193 if $COERCE{$name}->{$type};
195 if (! $TYPE{$type}) {
196 # looks parameterized
197 if ($type =~ /^[^\[]+\[.+\]$/) {
198 $TYPE{$type} = _build_type_constraint($type);
200 Carp::croak "Could not find the type constraint ($type) to coerce from"
204 push @{ $COERCE_KEYS{$name} }, $type;
205 $COERCE{$name}->{$type} = $code;
211 my($name, $conf) = @_;
212 if ($conf && $conf->{class}) {
213 # No, you're using this wrong
214 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
215 subtype($name, as => $conf->{class});
218 $name => where => sub { $_->isa($name) }
224 my($name, $conf) = @_;
225 my $role = $conf->{role};
227 $name => where => sub {
228 return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
229 $_->meta->does_role($role);
234 # this is an original method for Mouse
235 sub typecast_constraints {
236 my($class, $pkg, $types, $value) = @_;
237 Carp::croak("wrong arguments count") unless @_==4;
240 for my $type ( split /\|/, $types ) {
241 next unless $COERCE{$type};
242 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
244 next unless $TYPE{$coerce_type}->check($value);
246 $_ = $COERCE{$type}->{$coerce_type}->($value);
247 return $_ if $types->check($_);
255 # enum ['small', 'medium', 'large']
256 if (ref($_[0]) eq 'ARRAY') {
257 my @elements = @{ shift @_ };
259 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
261 enum($name, @elements);
265 # enum size => 'small', 'medium', 'large'
267 my %is_valid = map { $_ => 1 } @_;
270 $name => where => sub { $is_valid{$_} }
274 sub _build_type_constraint {
279 if ($spec =~ /^([^\[]+)\[(.+)\]$/) {
284 if ($constraint eq 'Maybe') {
285 $parent = _build_type_constraint('Undef');
287 $parent = _build_type_constraint($constraint);
289 my $child = _build_type_constraint($param);
290 if ($constraint eq 'ArrayRef') {
292 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
294 " if (\$parent->check(\$_[0])) {\n" .
295 " foreach my \$e (\@{\$_[0]}) {\n" .
296 " return () unless \$child->check(\$e);\n" .
303 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
304 } elsif ($constraint eq 'HashRef') {
306 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
308 " if (\$parent->check(\$_[0])) {\n" .
309 " foreach my \$e (values \%{\$_[0]}) {\n" .
310 " return () unless \$child->check(\$e);\n" .
317 $code = eval $code_str or Carp::confess($@);
318 } elsif ($constraint eq 'Maybe') {
320 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
322 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
325 $code = eval $code_str or Carp::confess($@);
327 Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
329 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
331 $code = $TYPE{ $spec };
333 # is $spec a known role? If so, constrain with 'does' instead of 'isa'
334 require Mouse::Meta::Role;
335 my $check = Mouse::Meta::Role->_metaclass_cache($spec)?
338 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
340 " Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
343 $code = eval $code_str or Carp::confess($@);
344 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
347 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
350 sub find_type_constraint {
351 my $type_constraint = shift;
352 return $TYPE{$type_constraint};
355 sub find_or_create_isa_type_constraint {
356 my $type_constraint = shift;
358 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)")
359 if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
367 $type_constraint =~ s/\s+//g;
369 $code = $TYPE{$type_constraint};
371 my @type_constraints = split /\|/, $type_constraint;
372 if (@type_constraints == 1) {
373 $code = $TYPE{$type_constraints[0]} ||
374 _build_type_constraint($type_constraints[0]);
376 my @code_list = map {
377 $TYPE{$_} || _build_type_constraint($_)
379 $code = Mouse::Meta::TypeConstraint->new(
380 _compiled_type_constraint => sub {
382 for my $code (@code_list) {
383 return 1 if $code->check($_[0]);
387 name => $type_constraint,
400 Mouse::Util::TypeConstraints - Type constraint system for Mouse
404 use Mouse::Util::TypeConstraints;
410 subtype 'NaturalLessThanTen'
413 => message { "This number ($_) is not less than ten!" };
419 enum 'RGBColors' => qw(red green blue);
421 no Mouse::Util::TypeConstraints;
425 This module provides Mouse with the ability to create custom type
426 constraints to be used in attribute definition.
428 =head2 Important Caveat
430 This is B<NOT> a type system for Perl 5. These are type constraints,
431 and they are not used by Mouse unless you tell it to. No type
432 inference is performed, expressions are not typed, etc. etc. etc.
434 A type constraint is at heart a small "check if a value is valid"
435 function. A constraint can be associated with an attribute. This
436 simplifies parameter validation, and makes your code clearer to read,
437 because you can refer to constraints by name.
439 =head2 Slightly Less Important Caveat
441 It is B<always> a good idea to quote your type names.
443 This prevents Perl from trying to execute the call as an indirect
444 object call. This can be an issue when you have a subtype with the
445 same name as a valid class.
449 subtype DateTime => as Object => where { $_->isa('DateTime') };
451 will I<just work>, while this:
454 subtype DateTime => as Object => where { $_->isa('DateTime') };
456 will fail silently and cause many headaches. The simple way to solve
457 this, as well as future proof your subtypes from classes which have
458 yet to have been created, is to quote the type name:
461 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
463 =head2 Default Type Constraints
465 This module also provides a simple hierarchy for Perl 5 types, here is
466 that hierarchy represented visually.
491 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
492 parameterized, this means you can say:
494 ArrayRef[Int] # an array of integers
495 HashRef[CodeRef] # a hash of str to CODE ref mappings
496 Maybe[Str] # value may be a string, may be undefined
498 If Mouse finds a name in brackets that it does not recognize as an
499 existing type, it assumes that this is a class name, for example
500 C<ArrayRef[DateTime]>.
502 B<NOTE:> Unless you parameterize a type, then it is invalid to include
503 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
504 name, I<not> as a parameterization of C<ArrayRef>.
506 B<NOTE:> The C<Undef> type constraint for the most part works
507 correctly now, but edge cases may still exist, please use it
510 B<NOTE:> The C<ClassName> type constraint does a complex package
511 existence check. This means that your class B<must> be loaded for this
512 type constraint to pass.
514 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
515 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
516 constraint checks that an I<object does> the named role.
518 =head2 Type Constraint Naming
520 Type name declared via this module can only contain alphanumeric
521 characters, colons (:), and periods (.).
523 Since the types created by this module are global, it is suggested
524 that you namespace your types just as you would namespace your
525 modules. So instead of creating a I<Color> type for your
526 B<My::Graphics> module, you would call the type
527 I<My::Graphics::Types::Color> instead.
529 =head2 Use with Other Constraint Modules
531 This module can play nicely with other constraint modules with some
532 slight tweaking. The C<where> clause in types is expected to be a
533 C<CODE> reference which checks it's first argument and returns a
534 boolean. Since most constraint modules work in a similar way, it
535 should be simple to adapt them to work with Mouse.
537 For instance, this is how you could use it with
538 L<Declare::Constraints::Simple> to declare a completely new type.
540 type 'HashOfArrayOfObjects',
544 -values => IsArrayRef(IsObject)
548 Here is an example of using L<Test::Deep> and it's non-test
549 related C<eq_deeply> function.
551 type 'ArrayOfHashOfBarsAndRandomNumbers'
554 array_each(subhashof({
556 random_number => ignore()
562 =head2 optimized_constraints -> HashRef[CODE]
564 Returns the simple type constraints that Mouse understands.
570 =item B<subtype 'Name' => as 'Parent' => where { } ...>
572 =item B<subtype as 'Parent' => where { } ...>
574 =item B<class_type ($class, ?$options)>
576 =item B<role_type ($role, ?$options)>
578 =item B<enum (\@values)>
584 Much of this documentation was taken from L<Moose::Util::TypeConstraints>