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
35 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
36 Undef => sub { !defined($_[0]) },
37 Defined => sub { defined($_[0]) },
38 Value => sub { defined($_[0]) && !ref($_[0]) },
39 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
40 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
41 Str => sub { defined($_[0]) && !ref($_[0]) },
42 Ref => sub { ref($_[0]) },
44 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
45 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
46 HashRef => sub { ref($_[0]) eq 'HASH' },
47 CodeRef => sub { ref($_[0]) eq 'CODE' },
48 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
49 GlobRef => sub { ref($_[0]) eq 'GLOB' },
52 ref($_[0]) eq 'GLOB' && openhandle($_[0])
54 blessed($_[0]) && $_[0]->isa("IO::Handle")
57 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
59 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
60 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
63 while (my ($name, $code) = each %builtins) {
64 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
70 sub optimized_constraints { # DEPRECATED
71 Carp::cluck('optimized_constraints() has been deprecated');
75 my @builtins = keys %TYPE;
76 sub list_all_builtin_type_constraints { @builtins }
78 sub list_all_type_constraints { keys %TYPE }
87 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
90 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
94 elsif(@_ % 2){ # @_ : $name => ( where => ... )
97 else{ # @_ : (name => $name, where => ...)
102 if(!defined($name = $args{name})){
109 if($mode eq 'subtype'){
110 $parent = delete $args{as};
112 $parent = delete $args{name};
117 my $package_defined_in = $args{package_defined_in} ||= caller(1);
119 my $existing = $TYPE{$name};
120 if($existing && $existing->{package_defined_in} ne $package_defined_in){
121 confess("The type constraint '$name' has already been created in "
122 . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
125 $args{constraint} = delete $args{where} if exists $args{where};
126 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
129 if($mode eq 'subtype'){
130 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
133 $constraint = Mouse::Meta::TypeConstraint->new(%args);
136 return $TYPE{$name} = $constraint;
140 return _create_type('type', @_);
144 return _create_type('subtype', @_);
148 my $type_name = shift;
150 my $type = find_type_constraint($type_name)
151 or confess("Cannot find type '$type_name', perhaps you forgot to load it.");
153 $type->_add_type_coercions(@_);
158 my($name, $conf) = @_;
159 if ($conf && $conf->{class}) {
160 # No, you're using this wrong
161 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
162 _create_type 'type', $name => (
163 as => $conf->{class},
169 _create_type 'type', $name => (
170 optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
178 my($name, $conf) = @_;
179 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
180 _create_type 'type', $name => (
181 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
187 sub typecast_constraints { # DEPRECATED
188 my($class, $pkg, $type, $value) = @_;
189 Carp::croak("wrong arguments count") unless @_ == 4;
191 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
193 return $type->coerce($value);
199 # enum ['small', 'medium', 'large']
200 if (ref($_[0]) eq 'ARRAY') {
201 %valid = map{ $_ => undef } @{ $_[0] };
202 $name = sprintf '(%s)', join '|', sort @{$_[0]};
204 # enum size => 'small', 'medium', 'large'
207 %valid = map{ $_ => undef } @_;
209 return _create_type 'type', $name => (
210 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
216 sub _find_or_create_regular_type{
219 return $TYPE{$spec} if exists $TYPE{$spec};
221 my $meta = Mouse::Util::get_metaclass_by_name($spec);
229 if($meta->isa('Mouse::Meta::Role')){
231 return blessed($_[0]) && $_[0]->does($spec);
237 return blessed($_[0]) && $_[0]->isa($spec);
242 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
250 $TYPE{ArrayRef}{constraint_generator} = sub {
251 my($type_parameter) = @_;
252 my $check = $type_parameter->_compiled_type_constraint;
255 foreach my $value (@{$_}) {
256 return undef unless $check->($value);
261 $TYPE{HashRef}{constraint_generator} = sub {
262 my($type_parameter) = @_;
263 my $check = $type_parameter->_compiled_type_constraint;
266 foreach my $value(values %{$_}){
267 return undef unless $check->($value);
273 # 'Maybe' type accepts 'Any', so it requires parameters
274 $TYPE{Maybe}{constraint_generator} = sub {
275 my($type_parameter) = @_;
276 my $check = $type_parameter->_compiled_type_constraint;
279 return !defined($_) || $check->($_);
283 sub _find_or_create_parameterized_type{
284 my($base, $param) = @_;
286 my $name = sprintf '%s[%s]', $base->name, $param->name;
289 my $generator = $base->{constraint_generator};
292 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
295 Mouse::Meta::TypeConstraint->new(
298 constraint => $generator->($param),
300 type => 'Parameterized',
304 sub _find_or_create_union_type{
305 my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
307 my $name = join '|', @types;
310 return Mouse::Meta::TypeConstraint->new(
312 type_constraints => \@types,
321 my($spec, $start) = @_;
326 my $len = length $spec;
329 for($i = $start; $i < $len; $i++){
330 my $char = substr($spec, $i, 1);
333 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
336 ($i, $subtype) = _parse_type($spec, $i+1)
338 $start = $i+1; # reset
340 push @list, _find_or_create_parameterized_type($base => $subtype);
347 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
350 # XXX: Mouse creates a new class type, but Moose does not.
351 $type = class_type( substr($spec, $start, $i - $start) );
356 ($i, $subtype) = _parse_type($spec, $i+1)
359 $start = $i+1; # reset
361 push @list, $subtype;
365 my $type = _find_or_create_regular_type( substr $spec, $start, $i - $start );
372 # create a new class type
373 push @list, class_type( substr $spec, $start, $i - $start );
381 return ($len, $list[0]);
384 return ($len, _find_or_create_union_type(@list));
389 sub find_type_constraint {
391 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
397 sub find_or_parse_type_constraint {
399 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
402 return $TYPE{$spec} || do{
403 my($pos, $type) = _parse_type($spec, 0);
408 sub find_or_create_does_type_constraint{
409 return find_or_parse_type_constraint(@_) || role_type(@_);
412 sub find_or_create_isa_type_constraint {
413 return find_or_parse_type_constraint(@_) || class_type(@_);
422 Mouse::Util::TypeConstraints - Type constraint system for Mouse
426 This document describes Mouse version 0.40
430 use Mouse::Util::TypeConstraints;
436 subtype 'NaturalLessThanTen'
439 => message { "This number ($_) is not less than ten!" };
445 enum 'RGBColors' => qw(red green blue);
447 no Mouse::Util::TypeConstraints;
451 This module provides Mouse with the ability to create custom type
452 constraints to be used in attribute definition.
454 =head2 Important Caveat
456 This is B<NOT> a type system for Perl 5. These are type constraints,
457 and they are not used by Mouse unless you tell it to. No type
458 inference is performed, expressions are not typed, etc. etc. etc.
460 A type constraint is at heart a small "check if a value is valid"
461 function. A constraint can be associated with an attribute. This
462 simplifies parameter validation, and makes your code clearer to read,
463 because you can refer to constraints by name.
465 =head2 Slightly Less Important Caveat
467 It is B<always> a good idea to quote your type names.
469 This prevents Perl from trying to execute the call as an indirect
470 object call. This can be an issue when you have a subtype with the
471 same name as a valid class.
475 subtype DateTime => as Object => where { $_->isa('DateTime') };
477 will I<just work>, while this:
480 subtype DateTime => as Object => where { $_->isa('DateTime') };
482 will fail silently and cause many headaches. The simple way to solve
483 this, as well as future proof your subtypes from classes which have
484 yet to have been created, is to quote the type name:
487 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
489 =head2 Default Type Constraints
491 This module also provides a simple hierarchy for Perl 5 types, here is
492 that hierarchy represented visually.
516 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
517 parameterized, this means you can say:
519 ArrayRef[Int] # an array of integers
520 HashRef[CodeRef] # a hash of str to CODE ref mappings
521 Maybe[Str] # value may be a string, may be undefined
523 If Mouse finds a name in brackets that it does not recognize as an
524 existing type, it assumes that this is a class name, for example
525 C<ArrayRef[DateTime]>.
527 B<NOTE:> Unless you parameterize a type, then it is invalid to include
528 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
529 name, I<not> as a parameterization of C<ArrayRef>.
531 B<NOTE:> The C<Undef> type constraint for the most part works
532 correctly now, but edge cases may still exist, please use it
535 B<NOTE:> The C<ClassName> type constraint does a complex package
536 existence check. This means that your class B<must> be loaded for this
537 type constraint to pass.
539 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
540 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
541 constraint checks that an I<object does> the named role.
543 =head2 Type Constraint Naming
545 Type name declared via this module can only contain alphanumeric
546 characters, colons (:), and periods (.).
548 Since the types created by this module are global, it is suggested
549 that you namespace your types just as you would namespace your
550 modules. So instead of creating a I<Color> type for your
551 B<My::Graphics> module, you would call the type
552 I<My::Graphics::Types::Color> instead.
554 =head2 Use with Other Constraint Modules
556 This module can play nicely with other constraint modules with some
557 slight tweaking. The C<where> clause in types is expected to be a
558 C<CODE> reference which checks it's first argument and returns a
559 boolean. Since most constraint modules work in a similar way, it
560 should be simple to adapt them to work with Mouse.
562 For instance, this is how you could use it with
563 L<Declare::Constraints::Simple> to declare a completely new type.
565 type 'HashOfArrayOfObjects',
569 -values => IsArrayRef(IsObject)
573 Here is an example of using L<Test::Deep> and it's non-test
574 related C<eq_deeply> function.
576 type 'ArrayOfHashOfBarsAndRandomNumbers'
579 array_each(subhashof({
581 random_number => ignore()
587 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
589 Returns the names of builtin type constraints.
591 =head2 C<< list_all_type_constraints -> (Names) >>
593 Returns the names of all the type constraints.
599 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
601 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
603 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
605 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
607 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
613 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
619 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
623 L<Moose::Util::TypeConstraints>