1 package Mouse::Util::TypeConstraints;
2 use Mouse::Util qw(does_role not_supported); # enables strict and warnings
5 use Scalar::Util qw/blessed looks_like_number openhandle/;
7 use Mouse::Meta::TypeConstraint;
10 Mouse::Exporter->setup_import_methods(
12 as where message from via
13 type subtype coerce class_type role_type enum
26 return(where => $_[0])
29 return(message => $_[0])
37 Any => undef, # null check
38 Item => undef, # null check
39 Maybe => undef, # null check
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(
76 sub optimized_constraints { # DEPRECATED
77 Carp::cluck('optimized_constraints() has been deprecated');
81 my @builtins = keys %TYPE;
82 sub list_all_builtin_type_constraints { @builtins }
84 sub list_all_type_constraints { keys %TYPE }
93 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
96 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
100 elsif(@_ % 2){ # @_ : $name => ( where => ... )
103 else{ # @_ : (name => $name, where => ...)
108 if(!defined($name = $args{name})){
115 my $package_defined_in = $args{package_defined_in} ||= caller(1);
117 my $existing = $TYPE{$name};
118 if($existing && $existing->{package_defined_in} ne $package_defined_in){
119 confess("The type constraint '$name' has already been created in "
120 . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
123 $args{constraint} = delete($args{where}) if exists $args{where};
124 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
127 if($mode eq 'subtype'){
128 my $parent = delete($args{as})
129 or confess('A subtype cannot consist solely of a name, it must have a parent');
131 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
134 $constraint = Mouse::Meta::TypeConstraint->new(%args);
137 return $TYPE{$name} = $constraint;
141 return _create_type('type', @_);
145 return _create_type('subtype', @_);
149 my $type_name = shift;
151 my $type = find_type_constraint($type_name)
152 or confess("Cannot find type '$type_name', perhaps you forgot to load it.");
154 $type->_add_type_coercions(@_);
159 my($name, $conf) = @_;
160 if ($conf && $conf->{class}) {
161 # No, you're using this wrong
162 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
163 _create_type 'type', $name => (
164 as => $conf->{class},
170 _create_type 'type', $name => (
171 optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
179 my($name, $conf) = @_;
180 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
181 _create_type 'type', $name => (
182 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
188 sub typecast_constraints { # DEPRECATED
189 my($class, $pkg, $type, $value) = @_;
190 Carp::croak("wrong arguments count") unless @_ == 4;
192 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
194 return $type->coerce($value);
200 # enum ['small', 'medium', 'large']
201 if (ref($_[0]) eq 'ARRAY') {
202 %valid = map{ $_ => undef } @{ $_[0] };
203 $name = sprintf '(%s)', join '|', sort @{$_[0]};
205 # enum size => 'small', 'medium', 'large'
208 %valid = map{ $_ => undef } @_;
210 return _create_type 'type', $name => (
211 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
217 sub _find_or_create_regular_type{
220 return $TYPE{$spec} if exists $TYPE{$spec};
222 my $meta = Mouse::Util::get_metaclass_by_name($spec);
230 if($meta->isa('Mouse::Meta::Role')){
232 return blessed($_[0]) && $_[0]->does($spec);
238 return blessed($_[0]) && $_[0]->isa($spec);
243 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
251 $TYPE{ArrayRef}{constraint_generator} = sub {
252 my($type_parameter) = @_;
253 my $check = $type_parameter->_compiled_type_constraint;
256 foreach my $value (@{$_}) {
257 return undef unless $check->($value);
262 $TYPE{HashRef}{constraint_generator} = sub {
263 my($type_parameter) = @_;
264 my $check = $type_parameter->_compiled_type_constraint;
267 foreach my $value(values %{$_}){
268 return undef unless $check->($value);
274 # 'Maybe' type accepts 'Any', so it requires parameters
275 $TYPE{Maybe}{constraint_generator} = sub {
276 my($type_parameter) = @_;
277 my $check = $type_parameter->_compiled_type_constraint;
280 return !defined($_) || $check->($_);
284 sub _find_or_create_parameterized_type{
285 my($base, $param) = @_;
287 my $name = sprintf '%s[%s]', $base->name, $param->name;
290 my $generator = $base->{constraint_generator};
293 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
296 Mouse::Meta::TypeConstraint->new(
299 constraint => $generator->($param),
301 type => 'Parameterized',
305 sub _find_or_create_union_type{
306 my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
308 my $name = join '|', @types;
311 return Mouse::Meta::TypeConstraint->new(
313 type_constraints => \@types,
322 my($spec, $start) = @_;
327 my $len = length $spec;
330 for($i = $start; $i < $len; $i++){
331 my $char = substr($spec, $i, 1);
334 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
337 ($i, $subtype) = _parse_type($spec, $i+1)
339 $start = $i+1; # reset
341 push @list, _find_or_create_parameterized_type($base => $subtype);
348 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
351 # XXX: Mouse creates a new class type, but Moose does not.
352 $type = class_type( substr($spec, $start, $i - $start) );
357 ($i, $subtype) = _parse_type($spec, $i+1)
360 $start = $i+1; # reset
362 push @list, $subtype;
366 push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start);
373 return ($len, $list[0]);
376 return ($len, _find_or_create_union_type(@list));
381 sub find_type_constraint {
383 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
389 sub find_or_parse_type_constraint {
391 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
394 return $TYPE{$spec} || do{
395 my($pos, $type) = _parse_type($spec, 0);
400 sub find_or_create_does_type_constraint{
401 my $type = find_or_parse_type_constraint(@_) || role_type(@_);
403 if($type->{type} && $type->{type} ne 'Role'){
404 Carp::cluck("$type is not a role type");
409 sub find_or_create_isa_type_constraint {
410 return find_or_parse_type_constraint(@_) || class_type(@_);
419 Mouse::Util::TypeConstraints - Type constraint system for Mouse
423 use Mouse::Util::TypeConstraints;
429 subtype 'NaturalLessThanTen'
432 => message { "This number ($_) is not less than ten!" };
438 enum 'RGBColors' => qw(red green blue);
440 no Mouse::Util::TypeConstraints;
444 This module provides Mouse with the ability to create custom type
445 constraints to be used in attribute definition.
447 =head2 Important Caveat
449 This is B<NOT> a type system for Perl 5. These are type constraints,
450 and they are not used by Mouse unless you tell it to. No type
451 inference is performed, expressions are not typed, etc. etc. etc.
453 A type constraint is at heart a small "check if a value is valid"
454 function. A constraint can be associated with an attribute. This
455 simplifies parameter validation, and makes your code clearer to read,
456 because you can refer to constraints by name.
458 =head2 Slightly Less Important Caveat
460 It is B<always> a good idea to quote your type names.
462 This prevents Perl from trying to execute the call as an indirect
463 object call. This can be an issue when you have a subtype with the
464 same name as a valid class.
468 subtype DateTime => as Object => where { $_->isa('DateTime') };
470 will I<just work>, while this:
473 subtype DateTime => as Object => where { $_->isa('DateTime') };
475 will fail silently and cause many headaches. The simple way to solve
476 this, as well as future proof your subtypes from classes which have
477 yet to have been created, is to quote the type name:
480 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
482 =head2 Default Type Constraints
484 This module also provides a simple hierarchy for Perl 5 types, here is
485 that hierarchy represented visually.
509 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
510 parameterized, this means you can say:
512 ArrayRef[Int] # an array of integers
513 HashRef[CodeRef] # a hash of str to CODE ref mappings
514 Maybe[Str] # value may be a string, may be undefined
516 If Mouse finds a name in brackets that it does not recognize as an
517 existing type, it assumes that this is a class name, for example
518 C<ArrayRef[DateTime]>.
520 B<NOTE:> Unless you parameterize a type, then it is invalid to include
521 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
522 name, I<not> as a parameterization of C<ArrayRef>.
524 B<NOTE:> The C<Undef> type constraint for the most part works
525 correctly now, but edge cases may still exist, please use it
528 B<NOTE:> The C<ClassName> type constraint does a complex package
529 existence check. This means that your class B<must> be loaded for this
530 type constraint to pass.
532 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
533 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
534 constraint checks that an I<object does> the named role.
536 =head2 Type Constraint Naming
538 Type name declared via this module can only contain alphanumeric
539 characters, colons (:), and periods (.).
541 Since the types created by this module are global, it is suggested
542 that you namespace your types just as you would namespace your
543 modules. So instead of creating a I<Color> type for your
544 B<My::Graphics> module, you would call the type
545 I<My::Graphics::Types::Color> instead.
547 =head2 Use with Other Constraint Modules
549 This module can play nicely with other constraint modules with some
550 slight tweaking. The C<where> clause in types is expected to be a
551 C<CODE> reference which checks it's first argument and returns a
552 boolean. Since most constraint modules work in a similar way, it
553 should be simple to adapt them to work with Mouse.
555 For instance, this is how you could use it with
556 L<Declare::Constraints::Simple> to declare a completely new type.
558 type 'HashOfArrayOfObjects',
562 -values => IsArrayRef(IsObject)
566 Here is an example of using L<Test::Deep> and it's non-test
567 related C<eq_deeply> function.
569 type 'ArrayOfHashOfBarsAndRandomNumbers'
572 array_each(subhashof({
574 random_number => ignore()
580 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
582 Returns the names of builtin type constraints.
584 =head2 C<< list_all_type_constraints -> (Names) >>
586 Returns the names of all the type constraints.
592 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
594 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
596 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
598 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
600 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
606 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
612 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
616 L<Moose::Util::TypeConstraints>