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
21 sub as ($) { (as => $_[0]) }
22 sub where (&) { (where => $_[0]) }
23 sub message (&) { (message => $_[0]) }
24 sub optimize_as (&) { (optimize_as => $_[0]) }
31 Any => undef, # null check
32 Item => undef, # null check
33 Maybe => undef, # null check
44 ScalarRef => \&ScalarRef,
45 ArrayRef => \&ArrayRef,
48 RegexpRef => \&RegexpRef,
51 FileHandle => \&FileHandle,
55 ClassName => \&ClassName,
56 RoleName => \&RoleName,
59 while (my ($name, $code) = each %builtins) {
60 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
66 sub optimized_constraints { # DEPRECATED
67 Carp::cluck('optimized_constraints() has been deprecated');
71 my @builtins = keys %TYPE;
72 sub list_all_builtin_type_constraints { @builtins }
74 sub list_all_type_constraints { keys %TYPE }
79 _generate_class_type_for('Mouse::Meta::TypeConstraint' => '_is_a_type_constraint');
80 _generate_class_type_for('Mouse::Meta::Class' => '_is_a_metaclass');
81 _generate_class_type_for('Mouse::Meta::Role' => '_is_a_metarole');
91 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
94 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
98 elsif(@_ % 2){ # @_ : $name => ( where => ... )
101 else{ # @_ : (name => $name, where => ...)
106 if(!defined($name = $args{name})){
113 if($mode eq 'subtype'){
114 $parent = delete $args{as};
116 $parent = delete $args{name};
121 my $package_defined_in = $args{package_defined_in} ||= caller(1);
123 my $existing = $TYPE{$name};
124 if($existing && $existing->{package_defined_in} ne $package_defined_in){
125 confess("The type constraint '$name' has already been created in "
126 . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
129 $args{constraint} = delete $args{where} if exists $args{where};
130 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
133 if($mode eq 'subtype'){
134 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
137 $constraint = Mouse::Meta::TypeConstraint->new(%args);
140 return $TYPE{$name} = $constraint;
144 return _create_type('type', @_);
148 return _create_type('subtype', @_);
152 my $type_name = shift;
154 my $type = find_type_constraint($type_name)
155 or confess("Cannot find type '$type_name', perhaps you forgot to load it.");
157 $type->_add_type_coercions(@_);
162 my($name, $conf) = @_;
163 if ($conf && $conf->{class}) {
164 # No, you're using this wrong
165 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
166 _create_type 'subtype', $name => (
167 as => $conf->{class},
173 _create_type 'subtype', $name => (
175 optimized_as => _generate_class_type_for($name),
183 my($name, $conf) = @_;
184 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
185 _create_type 'subtype', $name => (
187 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
193 sub typecast_constraints { # DEPRECATED
194 my($class, $pkg, $type, $value) = @_;
195 Carp::croak("wrong arguments count") unless @_ == 4;
197 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
199 return $type->coerce($value);
205 # enum ['small', 'medium', 'large']
206 if (ref($_[0]) eq 'ARRAY') {
207 %valid = map{ $_ => undef } @{ $_[0] };
208 $name = sprintf '(%s)', join '|', sort @{$_[0]};
210 # enum size => 'small', 'medium', 'large'
213 %valid = map{ $_ => undef } @_;
215 return _create_type 'type', $name => (
216 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
222 sub _find_or_create_regular_type{
225 return $TYPE{$spec} if exists $TYPE{$spec};
227 my $meta = Mouse::Util::get_metaclass_by_name($spec);
233 if(_is_a_metarole($meta)){
234 return role_type($spec);
237 return class_type($spec);
241 $TYPE{ArrayRef}{constraint_generator} = sub {
242 my($type_parameter) = @_;
243 my $check = $type_parameter->_compiled_type_constraint;
246 foreach my $value (@{$_}) {
247 return undef unless $check->($value);
252 $TYPE{HashRef}{constraint_generator} = sub {
253 my($type_parameter) = @_;
254 my $check = $type_parameter->_compiled_type_constraint;
257 foreach my $value(values %{$_}){
258 return undef unless $check->($value);
264 # 'Maybe' type accepts 'Any', so it requires parameters
265 $TYPE{Maybe}{constraint_generator} = sub {
266 my($type_parameter) = @_;
267 my $check = $type_parameter->_compiled_type_constraint;
270 return !defined($_) || $check->($_);
274 sub _find_or_create_parameterized_type{
275 my($base, $param) = @_;
277 my $name = sprintf '%s[%s]', $base->name, $param->name;
280 my $generator = $base->{constraint_generator};
283 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
286 Mouse::Meta::TypeConstraint->new(
289 constraint => $generator->($param),
291 type => 'Parameterized',
295 sub _find_or_create_union_type{
296 my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
298 my $name = join '|', @types;
301 return Mouse::Meta::TypeConstraint->new(
303 type_constraints => \@types,
312 my($spec, $start) = @_;
317 my $len = length $spec;
320 for($i = $start; $i < $len; $i++){
321 my $char = substr($spec, $i, 1);
324 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
327 ($i, $subtype) = _parse_type($spec, $i+1)
329 $start = $i+1; # reset
331 push @list, _find_or_create_parameterized_type($base => $subtype);
338 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
341 # XXX: Mouse creates a new class type, but Moose does not.
342 $type = class_type( substr($spec, $start, $i - $start) );
347 ($i, $subtype) = _parse_type($spec, $i+1)
350 $start = $i+1; # reset
352 push @list, $subtype;
356 my $type = _find_or_create_regular_type( substr $spec, $start, $i - $start );
363 # create a new class type
364 push @list, class_type( substr $spec, $start, $i - $start );
372 return ($len, $list[0]);
375 return ($len, _find_or_create_union_type(@list));
380 sub find_type_constraint {
382 return $spec if _is_a_type_constraint($spec);
388 sub find_or_parse_type_constraint {
390 return $spec if _is_a_type_constraint($spec);
393 return $TYPE{$spec} || do{
394 my($pos, $type) = _parse_type($spec, 0);
399 sub find_or_create_does_type_constraint{
400 return find_or_parse_type_constraint(@_) || role_type(@_);
403 sub find_or_create_isa_type_constraint {
404 return find_or_parse_type_constraint(@_) || class_type(@_);
413 Mouse::Util::TypeConstraints - Type constraint system for Mouse
417 This document describes Mouse version 0.40_01
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.
507 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
508 parameterized, this means you can say:
510 ArrayRef[Int] # an array of integers
511 HashRef[CodeRef] # a hash of str to CODE ref mappings
512 Maybe[Str] # value may be a string, may be undefined
514 If Mouse finds a name in brackets that it does not recognize as an
515 existing type, it assumes that this is a class name, for example
516 C<ArrayRef[DateTime]>.
518 B<NOTE:> Unless you parameterize a type, then it is invalid to include
519 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
520 name, I<not> as a parameterization of C<ArrayRef>.
522 B<NOTE:> The C<Undef> type constraint for the most part works
523 correctly now, but edge cases may still exist, please use it
526 B<NOTE:> The C<ClassName> type constraint does a complex package
527 existence check. This means that your class B<must> be loaded for this
528 type constraint to pass.
530 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
531 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
532 constraint checks that an I<object does> the named role.
534 =head2 Type Constraint Naming
536 Type name declared via this module can only contain alphanumeric
537 characters, colons (:), and periods (.).
539 Since the types created by this module are global, it is suggested
540 that you namespace your types just as you would namespace your
541 modules. So instead of creating a I<Color> type for your
542 B<My::Graphics> module, you would call the type
543 I<My::Graphics::Types::Color> instead.
545 =head2 Use with Other Constraint Modules
547 This module can play nicely with other constraint modules with some
548 slight tweaking. The C<where> clause in types is expected to be a
549 C<CODE> reference which checks it's first argument and returns a
550 boolean. Since most constraint modules work in a similar way, it
551 should be simple to adapt them to work with Mouse.
553 For instance, this is how you could use it with
554 L<Declare::Constraints::Simple> to declare a completely new type.
556 type 'HashOfArrayOfObjects',
560 -values => IsArrayRef(IsObject)
564 Here is an example of using L<Test::Deep> and it's non-test
565 related C<eq_deeply> function.
567 type 'ArrayOfHashOfBarsAndRandomNumbers'
570 array_each(subhashof({
572 random_number => ignore()
578 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
580 Returns the names of builtin type constraints.
582 =head2 C<< list_all_type_constraints -> (Names) >>
584 Returns the names of all the type constraints.
590 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
592 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
594 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
596 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
598 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
604 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
610 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
614 L<Moose::Util::TypeConstraints>