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 }
83 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
86 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
90 elsif(@_ % 2){ # @_ : $name => ( where => ... )
93 else{ # @_ : (name => $name, where => ...)
98 if(!defined($name = $args{name})){
105 if($mode eq 'subtype'){
106 $parent = delete $args{as};
108 $parent = delete $args{name};
113 my $package_defined_in = $args{package_defined_in} ||= caller(1);
115 my $existing = $TYPE{$name};
116 if($existing && $existing->{package_defined_in} ne $package_defined_in){
117 confess("The type constraint '$name' has already been created in "
118 . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
121 $args{constraint} = delete $args{where} if exists $args{where};
122 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
125 if($mode eq 'subtype'){
126 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
129 $constraint = Mouse::Meta::TypeConstraint->new(%args);
132 return $TYPE{$name} = $constraint;
136 return _create_type('type', @_);
140 return _create_type('subtype', @_);
144 my $type_name = shift;
146 my $type = find_type_constraint($type_name)
147 or confess("Cannot find type '$type_name', perhaps you forgot to load it.");
149 $type->_add_type_coercions(@_);
154 my($name, $conf) = @_;
155 if ($conf && $conf->{class}) {
156 # No, you're using this wrong
157 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
158 _create_type 'type', $name => (
159 as => $conf->{class},
165 _create_type 'type', $name => (
166 optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
174 my($name, $conf) = @_;
175 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
176 _create_type 'type', $name => (
177 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
183 sub typecast_constraints { # DEPRECATED
184 my($class, $pkg, $type, $value) = @_;
185 Carp::croak("wrong arguments count") unless @_ == 4;
187 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
189 return $type->coerce($value);
195 # enum ['small', 'medium', 'large']
196 if (ref($_[0]) eq 'ARRAY') {
197 %valid = map{ $_ => undef } @{ $_[0] };
198 $name = sprintf '(%s)', join '|', sort @{$_[0]};
200 # enum size => 'small', 'medium', 'large'
203 %valid = map{ $_ => undef } @_;
205 return _create_type 'type', $name => (
206 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
212 sub _find_or_create_regular_type{
215 return $TYPE{$spec} if exists $TYPE{$spec};
217 my $meta = Mouse::Util::get_metaclass_by_name($spec);
225 if($meta->isa('Mouse::Meta::Role')){
227 return blessed($_[0]) && $_[0]->does($spec);
233 return blessed($_[0]) && $_[0]->isa($spec);
238 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
246 $TYPE{ArrayRef}{constraint_generator} = sub {
247 my($type_parameter) = @_;
248 my $check = $type_parameter->_compiled_type_constraint;
251 foreach my $value (@{$_}) {
252 return undef unless $check->($value);
257 $TYPE{HashRef}{constraint_generator} = sub {
258 my($type_parameter) = @_;
259 my $check = $type_parameter->_compiled_type_constraint;
262 foreach my $value(values %{$_}){
263 return undef unless $check->($value);
269 # 'Maybe' type accepts 'Any', so it requires parameters
270 $TYPE{Maybe}{constraint_generator} = sub {
271 my($type_parameter) = @_;
272 my $check = $type_parameter->_compiled_type_constraint;
275 return !defined($_) || $check->($_);
279 sub _find_or_create_parameterized_type{
280 my($base, $param) = @_;
282 my $name = sprintf '%s[%s]', $base->name, $param->name;
285 my $generator = $base->{constraint_generator};
288 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
291 Mouse::Meta::TypeConstraint->new(
294 constraint => $generator->($param),
296 type => 'Parameterized',
300 sub _find_or_create_union_type{
301 my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
303 my $name = join '|', @types;
306 return Mouse::Meta::TypeConstraint->new(
308 type_constraints => \@types,
317 my($spec, $start) = @_;
322 my $len = length $spec;
325 for($i = $start; $i < $len; $i++){
326 my $char = substr($spec, $i, 1);
329 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
332 ($i, $subtype) = _parse_type($spec, $i+1)
334 $start = $i+1; # reset
336 push @list, _find_or_create_parameterized_type($base => $subtype);
343 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
346 # XXX: Mouse creates a new class type, but Moose does not.
347 $type = class_type( substr($spec, $start, $i - $start) );
352 ($i, $subtype) = _parse_type($spec, $i+1)
355 $start = $i+1; # reset
357 push @list, $subtype;
361 my $type = _find_or_create_regular_type( substr $spec, $start, $i - $start );
368 # create a new class type
369 push @list, class_type( substr $spec, $start, $i - $start );
377 return ($len, $list[0]);
380 return ($len, _find_or_create_union_type(@list));
385 sub find_type_constraint {
387 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
393 sub find_or_parse_type_constraint {
395 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
398 return $TYPE{$spec} || do{
399 my($pos, $type) = _parse_type($spec, 0);
404 sub find_or_create_does_type_constraint{
405 return find_or_parse_type_constraint(@_) || role_type(@_);
408 sub find_or_create_isa_type_constraint {
409 return find_or_parse_type_constraint(@_) || class_type(@_);
418 Mouse::Util::TypeConstraints - Type constraint system for Mouse
422 This document describes Mouse version 0.40_01
426 use Mouse::Util::TypeConstraints;
432 subtype 'NaturalLessThanTen'
435 => message { "This number ($_) is not less than ten!" };
441 enum 'RGBColors' => qw(red green blue);
443 no Mouse::Util::TypeConstraints;
447 This module provides Mouse with the ability to create custom type
448 constraints to be used in attribute definition.
450 =head2 Important Caveat
452 This is B<NOT> a type system for Perl 5. These are type constraints,
453 and they are not used by Mouse unless you tell it to. No type
454 inference is performed, expressions are not typed, etc. etc. etc.
456 A type constraint is at heart a small "check if a value is valid"
457 function. A constraint can be associated with an attribute. This
458 simplifies parameter validation, and makes your code clearer to read,
459 because you can refer to constraints by name.
461 =head2 Slightly Less Important Caveat
463 It is B<always> a good idea to quote your type names.
465 This prevents Perl from trying to execute the call as an indirect
466 object call. This can be an issue when you have a subtype with the
467 same name as a valid class.
471 subtype DateTime => as Object => where { $_->isa('DateTime') };
473 will I<just work>, while this:
476 subtype DateTime => as Object => where { $_->isa('DateTime') };
478 will fail silently and cause many headaches. The simple way to solve
479 this, as well as future proof your subtypes from classes which have
480 yet to have been created, is to quote the type name:
483 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
485 =head2 Default Type Constraints
487 This module also provides a simple hierarchy for Perl 5 types, here is
488 that hierarchy represented visually.
512 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
513 parameterized, this means you can say:
515 ArrayRef[Int] # an array of integers
516 HashRef[CodeRef] # a hash of str to CODE ref mappings
517 Maybe[Str] # value may be a string, may be undefined
519 If Mouse finds a name in brackets that it does not recognize as an
520 existing type, it assumes that this is a class name, for example
521 C<ArrayRef[DateTime]>.
523 B<NOTE:> Unless you parameterize a type, then it is invalid to include
524 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
525 name, I<not> as a parameterization of C<ArrayRef>.
527 B<NOTE:> The C<Undef> type constraint for the most part works
528 correctly now, but edge cases may still exist, please use it
531 B<NOTE:> The C<ClassName> type constraint does a complex package
532 existence check. This means that your class B<must> be loaded for this
533 type constraint to pass.
535 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
536 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
537 constraint checks that an I<object does> the named role.
539 =head2 Type Constraint Naming
541 Type name declared via this module can only contain alphanumeric
542 characters, colons (:), and periods (.).
544 Since the types created by this module are global, it is suggested
545 that you namespace your types just as you would namespace your
546 modules. So instead of creating a I<Color> type for your
547 B<My::Graphics> module, you would call the type
548 I<My::Graphics::Types::Color> instead.
550 =head2 Use with Other Constraint Modules
552 This module can play nicely with other constraint modules with some
553 slight tweaking. The C<where> clause in types is expected to be a
554 C<CODE> reference which checks it's first argument and returns a
555 boolean. Since most constraint modules work in a similar way, it
556 should be simple to adapt them to work with Mouse.
558 For instance, this is how you could use it with
559 L<Declare::Constraints::Simple> to declare a completely new type.
561 type 'HashOfArrayOfObjects',
565 -values => IsArrayRef(IsObject)
569 Here is an example of using L<Test::Deep> and it's non-test
570 related C<eq_deeply> function.
572 type 'ArrayOfHashOfBarsAndRandomNumbers'
575 array_each(subhashof({
577 random_number => ignore()
583 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
585 Returns the names of builtin type constraints.
587 =head2 C<< list_all_type_constraints -> (Names) >>
589 Returns the names of all the type constraints.
595 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
597 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
599 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
601 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
603 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
609 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
615 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
619 L<Moose::Util::TypeConstraints>