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])
35 sub export_type_constraints_as_functions {
38 foreach my $constraint ( values %TYPE ) {
39 my $tc = $constraint->{_compiled_type_constraint};
40 my $as = $into . '::' . $constraint->{name};
43 *{$as} = sub{ &{$tc} || undef };
53 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
54 Undef => sub { !defined($_[0]) },
55 Defined => sub { defined($_[0]) },
56 Value => sub { defined($_[0]) && !ref($_[0]) },
57 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
58 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
59 Str => sub { defined($_[0]) && !ref($_[0]) },
60 Ref => sub { ref($_[0]) },
62 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
63 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
64 HashRef => sub { ref($_[0]) eq 'HASH' },
65 CodeRef => sub { ref($_[0]) eq 'CODE' },
66 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
67 GlobRef => sub { ref($_[0]) eq 'GLOB' },
70 ref($_[0]) eq 'GLOB' && openhandle($_[0])
72 blessed($_[0]) && $_[0]->isa("IO::Handle")
75 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
77 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
78 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
80 while (my ($name, $code) = each %TYPE) {
81 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
83 _compiled_type_constraint => $code,
85 $TYPE_SOURCE{$name} = __PACKAGE__;
88 sub optimized_constraints { \%TYPE }
90 my @TYPE_KEYS = keys %TYPE;
91 sub list_all_builtin_type_constraints { @TYPE_KEYS }
98 if(@_ == 1 && ref $_[0]){ # type { where => ... }
101 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
105 elsif(@_ % 2){ # odd number of arguments
113 $name = '__ANON__' if !defined $name;
117 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
118 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
121 my $constraint = $conf{where} || do {
122 my $as = delete $conf{as} || 'Any';
123 ($TYPE{$as} ||= _build_type_constraint($as))->{_compiled_type_constraint};
126 my $tc = Mouse::Meta::TypeConstraint->new(
128 _compiled_type_constraint => sub {
130 return &{$constraint};
134 $TYPE_SOURCE{$name} = $pkg;
144 if(@_ == 1 && ref $_[0]){ # type { where => ... }
147 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
151 elsif(@_ % 2){ # odd number of arguments
159 $name = '__ANON__' if !defined $name;
163 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
164 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
167 my $constraint = delete $conf{where};
168 my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any')
169 ->{_compiled_type_constraint};
171 my $tc = Mouse::Meta::TypeConstraint->new(
173 _compiled_type_constraint => (
177 $as_constraint->($_[0]) && $constraint->($_[0])
181 $as_constraint->($_[0]);
187 $TYPE_SOURCE{$name} = $pkg;
196 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
199 unless ($COERCE{$name}) {
201 $COERCE_KEYS{$name} = [];
204 while (my($type, $code) = splice @_, 0, 2) {
205 Carp::croak "A coercion action already exists for '$type'"
206 if $COERCE{$name}->{$type};
208 if (! $TYPE{$type}) {
209 # looks parameterized
210 if ($type =~ /^[^\[]+\[.+\]$/) {
211 $TYPE{$type} = _build_type_constraint($type);
213 Carp::croak "Could not find the type constraint ($type) to coerce from"
217 push @{ $COERCE_KEYS{$name} }, $type;
218 $COERCE{$name}->{$type} = $code;
224 my($name, $conf) = @_;
225 if ($conf && $conf->{class}) {
226 # No, you're using this wrong
227 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
228 subtype($name, as => $conf->{class});
231 $name => where => sub { $_->isa($name) }
237 my($name, $conf) = @_;
238 my $role = $conf->{role};
240 $name => where => sub {
241 return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
242 $_->meta->does_role($role);
247 # this is an original method for Mouse
248 sub typecast_constraints {
249 my($class, $pkg, $types, $value) = @_;
250 Carp::croak("wrong arguments count") unless @_==4;
253 for my $type ( split /\|/, $types ) {
254 next unless $COERCE{$type};
255 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
257 next unless $TYPE{$coerce_type}->check($value);
259 $_ = $COERCE{$type}->{$coerce_type}->($value);
260 return $_ if $types->check($_);
268 # enum ['small', 'medium', 'large']
269 if (ref($_[0]) eq 'ARRAY') {
270 my @elements = @{ shift @_ };
272 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
274 enum($name, @elements);
278 # enum size => 'small', 'medium', 'large'
280 my %is_valid = map { $_ => 1 } @_;
283 $name => where => sub { $is_valid{$_} }
287 sub _build_type_constraint {
292 if ($spec =~ /^([^\[]+)\[(.+)\]$/) {
297 if ($constraint eq 'Maybe') {
298 $parent = _build_type_constraint('Undef');
300 $parent = _build_type_constraint($constraint);
302 my $child = _build_type_constraint($param);
303 if ($constraint eq 'ArrayRef') {
305 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
307 " if (\$parent->check(\$_[0])) {\n" .
308 " foreach my \$e (\@{\$_[0]}) {\n" .
309 " return () unless \$child->check(\$e);\n" .
316 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
317 } elsif ($constraint eq 'HashRef') {
319 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
321 " if (\$parent->check(\$_[0])) {\n" .
322 " foreach my \$e (values \%{\$_[0]}) {\n" .
323 " return () unless \$child->check(\$e);\n" .
330 $code = eval $code_str or Carp::confess($@);
331 } elsif ($constraint eq 'Maybe') {
333 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
335 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
338 $code = eval $code_str or Carp::confess($@);
340 Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
342 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
344 $code = $TYPE{ $spec };
346 # is $spec a known role? If so, constrain with 'does' instead of 'isa'
347 require Mouse::Meta::Role;
348 my $check = Mouse::Meta::Role->_metaclass_cache($spec)?
351 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
353 " Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
356 $code = eval $code_str or Carp::confess($@);
357 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
360 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
363 sub find_type_constraint {
364 my $type_constraint = shift;
365 return $TYPE{$type_constraint};
368 sub find_or_create_isa_type_constraint {
369 my $type_constraint = shift;
371 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)")
372 if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
380 $type_constraint =~ s/\s+//g;
382 $code = $TYPE{$type_constraint};
384 my @type_constraints = split /\|/, $type_constraint;
385 if (@type_constraints == 1) {
386 $code = $TYPE{$type_constraints[0]} ||
387 _build_type_constraint($type_constraints[0]);
389 my @code_list = map {
390 $TYPE{$_} || _build_type_constraint($_)
392 $code = Mouse::Meta::TypeConstraint->new(
393 _compiled_type_constraint => sub {
395 for my $code (@code_list) {
396 return 1 if $code->check($_[0]);
400 name => $type_constraint,
413 Mouse::Util::TypeConstraints - Type constraint system for Mouse
417 use Mouse::Util::TypeConstraints;
423 subtype 'NaturalLessThanTen'
426 => message { "This number ($_) is not less than ten!" };
432 enum 'RGBColors' => qw(red green blue);
434 no Mouse::Util::TypeConstraints;
438 This module provides Mouse with the ability to create custom type
439 constraints to be used in attribute definition.
441 =head2 Important Caveat
443 This is B<NOT> a type system for Perl 5. These are type constraints,
444 and they are not used by Mouse unless you tell it to. No type
445 inference is performed, expressions are not typed, etc. etc. etc.
447 A type constraint is at heart a small "check if a value is valid"
448 function. A constraint can be associated with an attribute. This
449 simplifies parameter validation, and makes your code clearer to read,
450 because you can refer to constraints by name.
452 =head2 Slightly Less Important Caveat
454 It is B<always> a good idea to quote your type names.
456 This prevents Perl from trying to execute the call as an indirect
457 object call. This can be an issue when you have a subtype with the
458 same name as a valid class.
462 subtype DateTime => as Object => where { $_->isa('DateTime') };
464 will I<just work>, while this:
467 subtype DateTime => as Object => where { $_->isa('DateTime') };
469 will fail silently and cause many headaches. The simple way to solve
470 this, as well as future proof your subtypes from classes which have
471 yet to have been created, is to quote the type name:
474 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
476 =head2 Default Type Constraints
478 This module also provides a simple hierarchy for Perl 5 types, here is
479 that hierarchy represented visually.
504 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
505 parameterized, this means you can say:
507 ArrayRef[Int] # an array of integers
508 HashRef[CodeRef] # a hash of str to CODE ref mappings
509 Maybe[Str] # value may be a string, may be undefined
511 If Mouse finds a name in brackets that it does not recognize as an
512 existing type, it assumes that this is a class name, for example
513 C<ArrayRef[DateTime]>.
515 B<NOTE:> Unless you parameterize a type, then it is invalid to include
516 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
517 name, I<not> as a parameterization of C<ArrayRef>.
519 B<NOTE:> The C<Undef> type constraint for the most part works
520 correctly now, but edge cases may still exist, please use it
523 B<NOTE:> The C<ClassName> type constraint does a complex package
524 existence check. This means that your class B<must> be loaded for this
525 type constraint to pass.
527 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
528 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
529 constraint checks that an I<object does> the named role.
531 =head2 Type Constraint Naming
533 Type name declared via this module can only contain alphanumeric
534 characters, colons (:), and periods (.).
536 Since the types created by this module are global, it is suggested
537 that you namespace your types just as you would namespace your
538 modules. So instead of creating a I<Color> type for your
539 B<My::Graphics> module, you would call the type
540 I<My::Graphics::Types::Color> instead.
542 =head2 Use with Other Constraint Modules
544 This module can play nicely with other constraint modules with some
545 slight tweaking. The C<where> clause in types is expected to be a
546 C<CODE> reference which checks it's first argument and returns a
547 boolean. Since most constraint modules work in a similar way, it
548 should be simple to adapt them to work with Mouse.
550 For instance, this is how you could use it with
551 L<Declare::Constraints::Simple> to declare a completely new type.
553 type 'HashOfArrayOfObjects',
557 -values => IsArrayRef(IsObject)
561 Here is an example of using L<Test::Deep> and it's non-test
562 related C<eq_deeply> function.
564 type 'ArrayOfHashOfBarsAndRandomNumbers'
567 array_each(subhashof({
569 random_number => ignore()
575 =head2 optimized_constraints -> HashRef[CODE]
577 Returns the simple type constraints that Mouse understands.
583 =item B<subtype 'Name' => as 'Parent' => where { } ...>
585 =item B<subtype as 'Parent' => where { } ...>
587 =item B<class_type ($class, ?$options)>
589 =item B<role_type ($role, ?$options)>
591 =item B<enum (\@values)>
597 Much of this documentation was taken from L<Moose::Util::TypeConstraints>