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 optimize_as
14 type subtype coerce class_type role_type enum
23 sub as ($) { (as => $_[0]) }
24 sub where (&) { (where => $_[0]) }
25 sub message (&) { (message => $_[0]) }
26 sub optimize_as (&) { (optimize_as => $_[0]) }
33 Any => undef, # null check
34 Item => undef, # null check
35 Maybe => undef, # null check
37 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
38 Undef => sub { !defined($_[0]) },
39 Defined => sub { defined($_[0]) },
40 Value => sub { defined($_[0]) && !ref($_[0]) },
41 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
42 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
43 Str => sub { defined($_[0]) && !ref($_[0]) },
44 Ref => sub { ref($_[0]) },
46 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
47 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
48 HashRef => sub { ref($_[0]) eq 'HASH' },
49 CodeRef => sub { ref($_[0]) eq 'CODE' },
50 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
51 GlobRef => sub { ref($_[0]) eq 'GLOB' },
54 ref($_[0]) eq 'GLOB' && openhandle($_[0])
56 blessed($_[0]) && $_[0]->isa("IO::Handle")
59 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
61 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
62 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
65 while (my ($name, $code) = each %builtins) {
66 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
72 sub optimized_constraints { # DEPRECATED
73 Carp::cluck('optimized_constraints() has been deprecated');
77 my @builtins = keys %TYPE;
78 sub list_all_builtin_type_constraints { @builtins }
80 sub list_all_type_constraints { keys %TYPE }
89 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
92 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
96 elsif(@_ % 2){ # @_ : $name => ( where => ... )
99 else{ # @_ : (name => $name, where => ...)
104 if(!defined($name = $args{name})){
111 if($mode eq 'subtype'){
112 $parent = delete $args{as};
114 $parent = delete $args{name};
119 my $package_defined_in = $args{package_defined_in} ||= caller(1);
121 my $existing = $TYPE{$name};
122 if($existing && $existing->{package_defined_in} ne $package_defined_in){
123 confess("The type constraint '$name' has already been created in "
124 . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
127 $args{constraint} = delete $args{where} if exists $args{where};
128 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
131 if($mode eq 'subtype'){
132 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
135 $constraint = Mouse::Meta::TypeConstraint->new(%args);
138 return $TYPE{$name} = $constraint;
142 return _create_type('type', @_);
146 return _create_type('subtype', @_);
150 my $type_name = shift;
152 my $type = find_type_constraint($type_name)
153 or confess("Cannot find type '$type_name', perhaps you forgot to load it.");
155 $type->_add_type_coercions(@_);
160 my($name, $conf) = @_;
161 if ($conf && $conf->{class}) {
162 # No, you're using this wrong
163 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
164 _create_type 'type', $name => (
165 as => $conf->{class},
171 _create_type 'type', $name => (
172 optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
180 my($name, $conf) = @_;
181 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
182 _create_type 'type', $name => (
183 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
189 sub typecast_constraints { # DEPRECATED
190 my($class, $pkg, $type, $value) = @_;
191 Carp::croak("wrong arguments count") unless @_ == 4;
193 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
195 return $type->coerce($value);
201 # enum ['small', 'medium', 'large']
202 if (ref($_[0]) eq 'ARRAY') {
203 %valid = map{ $_ => undef } @{ $_[0] };
204 $name = sprintf '(%s)', join '|', sort @{$_[0]};
206 # enum size => 'small', 'medium', 'large'
209 %valid = map{ $_ => undef } @_;
211 return _create_type 'type', $name => (
212 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
218 sub _find_or_create_regular_type{
221 return $TYPE{$spec} if exists $TYPE{$spec};
223 my $meta = Mouse::Util::get_metaclass_by_name($spec);
231 if($meta->isa('Mouse::Meta::Role')){
233 return blessed($_[0]) && $_[0]->does($spec);
239 return blessed($_[0]) && $_[0]->isa($spec);
244 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
252 $TYPE{ArrayRef}{constraint_generator} = sub {
253 my($type_parameter) = @_;
254 my $check = $type_parameter->_compiled_type_constraint;
257 foreach my $value (@{$_}) {
258 return undef unless $check->($value);
263 $TYPE{HashRef}{constraint_generator} = sub {
264 my($type_parameter) = @_;
265 my $check = $type_parameter->_compiled_type_constraint;
268 foreach my $value(values %{$_}){
269 return undef unless $check->($value);
275 # 'Maybe' type accepts 'Any', so it requires parameters
276 $TYPE{Maybe}{constraint_generator} = sub {
277 my($type_parameter) = @_;
278 my $check = $type_parameter->_compiled_type_constraint;
281 return !defined($_) || $check->($_);
285 sub _find_or_create_parameterized_type{
286 my($base, $param) = @_;
288 my $name = sprintf '%s[%s]', $base->name, $param->name;
291 my $generator = $base->{constraint_generator};
294 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
297 Mouse::Meta::TypeConstraint->new(
300 constraint => $generator->($param),
302 type => 'Parameterized',
306 sub _find_or_create_union_type{
307 my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
309 my $name = join '|', @types;
312 return Mouse::Meta::TypeConstraint->new(
314 type_constraints => \@types,
323 my($spec, $start) = @_;
328 my $len = length $spec;
331 for($i = $start; $i < $len; $i++){
332 my $char = substr($spec, $i, 1);
335 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
338 ($i, $subtype) = _parse_type($spec, $i+1)
340 $start = $i+1; # reset
342 push @list, _find_or_create_parameterized_type($base => $subtype);
349 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
352 # XXX: Mouse creates a new class type, but Moose does not.
353 $type = class_type( substr($spec, $start, $i - $start) );
358 ($i, $subtype) = _parse_type($spec, $i+1)
361 $start = $i+1; # reset
363 push @list, $subtype;
367 push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start);
374 return ($len, $list[0]);
377 return ($len, _find_or_create_union_type(@list));
382 sub find_type_constraint {
384 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
390 sub find_or_parse_type_constraint {
392 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
395 return $TYPE{$spec} || do{
396 my($pos, $type) = _parse_type($spec, 0);
401 sub find_or_create_does_type_constraint{
402 return find_or_parse_type_constraint(@_) || role_type(@_);
405 sub find_or_create_isa_type_constraint {
406 return find_or_parse_type_constraint(@_) || class_type(@_);
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.
505 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
506 parameterized, this means you can say:
508 ArrayRef[Int] # an array of integers
509 HashRef[CodeRef] # a hash of str to CODE ref mappings
510 Maybe[Str] # value may be a string, may be undefined
512 If Mouse finds a name in brackets that it does not recognize as an
513 existing type, it assumes that this is a class name, for example
514 C<ArrayRef[DateTime]>.
516 B<NOTE:> Unless you parameterize a type, then it is invalid to include
517 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
518 name, I<not> as a parameterization of C<ArrayRef>.
520 B<NOTE:> The C<Undef> type constraint for the most part works
521 correctly now, but edge cases may still exist, please use it
524 B<NOTE:> The C<ClassName> type constraint does a complex package
525 existence check. This means that your class B<must> be loaded for this
526 type constraint to pass.
528 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
529 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
530 constraint checks that an I<object does> the named role.
532 =head2 Type Constraint Naming
534 Type name declared via this module can only contain alphanumeric
535 characters, colons (:), and periods (.).
537 Since the types created by this module are global, it is suggested
538 that you namespace your types just as you would namespace your
539 modules. So instead of creating a I<Color> type for your
540 B<My::Graphics> module, you would call the type
541 I<My::Graphics::Types::Color> instead.
543 =head2 Use with Other Constraint Modules
545 This module can play nicely with other constraint modules with some
546 slight tweaking. The C<where> clause in types is expected to be a
547 C<CODE> reference which checks it's first argument and returns a
548 boolean. Since most constraint modules work in a similar way, it
549 should be simple to adapt them to work with Mouse.
551 For instance, this is how you could use it with
552 L<Declare::Constraints::Simple> to declare a completely new type.
554 type 'HashOfArrayOfObjects',
558 -values => IsArrayRef(IsObject)
562 Here is an example of using L<Test::Deep> and it's non-test
563 related C<eq_deeply> function.
565 type 'ArrayOfHashOfBarsAndRandomNumbers'
568 array_each(subhashof({
570 random_number => ignore()
576 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
578 Returns the names of builtin type constraints.
580 =head2 C<< list_all_type_constraints -> (Names) >>
582 Returns the names of all the type constraints.
588 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
590 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
592 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
594 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
596 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
602 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
608 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
612 L<Moose::Util::TypeConstraints>