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 'subtype', $name => (
159 as => $conf->{class},
165 _create_type 'subtype', $name => (
167 optimized_as => _generate_class_type_for($name),
175 my($name, $conf) = @_;
176 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
177 _create_type 'subtype', $name => (
179 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
185 sub typecast_constraints { # DEPRECATED
186 my($class, $pkg, $type, $value) = @_;
187 Carp::croak("wrong arguments count") unless @_ == 4;
189 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
191 return $type->coerce($value);
197 # enum ['small', 'medium', 'large']
198 if (ref($_[0]) eq 'ARRAY') {
199 %valid = map{ $_ => undef } @{ $_[0] };
200 $name = sprintf '(%s)', join '|', sort @{$_[0]};
202 # enum size => 'small', 'medium', 'large'
205 %valid = map{ $_ => undef } @_;
207 return _create_type 'type', $name => (
208 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
214 sub _find_or_create_regular_type{
217 return $TYPE{$spec} if exists $TYPE{$spec};
219 my $meta = Mouse::Util::get_metaclass_by_name($spec);
225 if($meta->isa('Mouse::Meta::Role')){
226 return role_type($spec);
229 return class_type($spec);
233 $TYPE{ArrayRef}{constraint_generator} = sub {
234 my($type_parameter) = @_;
235 my $check = $type_parameter->_compiled_type_constraint;
238 foreach my $value (@{$_}) {
239 return undef unless $check->($value);
244 $TYPE{HashRef}{constraint_generator} = sub {
245 my($type_parameter) = @_;
246 my $check = $type_parameter->_compiled_type_constraint;
249 foreach my $value(values %{$_}){
250 return undef unless $check->($value);
256 # 'Maybe' type accepts 'Any', so it requires parameters
257 $TYPE{Maybe}{constraint_generator} = sub {
258 my($type_parameter) = @_;
259 my $check = $type_parameter->_compiled_type_constraint;
262 return !defined($_) || $check->($_);
266 sub _find_or_create_parameterized_type{
267 my($base, $param) = @_;
269 my $name = sprintf '%s[%s]', $base->name, $param->name;
272 my $generator = $base->{constraint_generator};
275 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
278 Mouse::Meta::TypeConstraint->new(
281 constraint => $generator->($param),
283 type => 'Parameterized',
287 sub _find_or_create_union_type{
288 my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
290 my $name = join '|', @types;
293 return Mouse::Meta::TypeConstraint->new(
295 type_constraints => \@types,
304 my($spec, $start) = @_;
309 my $len = length $spec;
312 for($i = $start; $i < $len; $i++){
313 my $char = substr($spec, $i, 1);
316 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
319 ($i, $subtype) = _parse_type($spec, $i+1)
321 $start = $i+1; # reset
323 push @list, _find_or_create_parameterized_type($base => $subtype);
330 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
333 # XXX: Mouse creates a new class type, but Moose does not.
334 $type = class_type( substr($spec, $start, $i - $start) );
339 ($i, $subtype) = _parse_type($spec, $i+1)
342 $start = $i+1; # reset
344 push @list, $subtype;
348 my $type = _find_or_create_regular_type( substr $spec, $start, $i - $start );
355 # create a new class type
356 push @list, class_type( substr $spec, $start, $i - $start );
364 return ($len, $list[0]);
367 return ($len, _find_or_create_union_type(@list));
372 sub find_type_constraint {
374 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
380 sub find_or_parse_type_constraint {
382 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
385 return $TYPE{$spec} || do{
386 my($pos, $type) = _parse_type($spec, 0);
391 sub find_or_create_does_type_constraint{
392 return find_or_parse_type_constraint(@_) || role_type(@_);
395 sub find_or_create_isa_type_constraint {
396 return find_or_parse_type_constraint(@_) || class_type(@_);
405 Mouse::Util::TypeConstraints - Type constraint system for Mouse
409 This document describes Mouse version 0.40_01
413 use Mouse::Util::TypeConstraints;
419 subtype 'NaturalLessThanTen'
422 => message { "This number ($_) is not less than ten!" };
428 enum 'RGBColors' => qw(red green blue);
430 no Mouse::Util::TypeConstraints;
434 This module provides Mouse with the ability to create custom type
435 constraints to be used in attribute definition.
437 =head2 Important Caveat
439 This is B<NOT> a type system for Perl 5. These are type constraints,
440 and they are not used by Mouse unless you tell it to. No type
441 inference is performed, expressions are not typed, etc. etc. etc.
443 A type constraint is at heart a small "check if a value is valid"
444 function. A constraint can be associated with an attribute. This
445 simplifies parameter validation, and makes your code clearer to read,
446 because you can refer to constraints by name.
448 =head2 Slightly Less Important Caveat
450 It is B<always> a good idea to quote your type names.
452 This prevents Perl from trying to execute the call as an indirect
453 object call. This can be an issue when you have a subtype with the
454 same name as a valid class.
458 subtype DateTime => as Object => where { $_->isa('DateTime') };
460 will I<just work>, while this:
463 subtype DateTime => as Object => where { $_->isa('DateTime') };
465 will fail silently and cause many headaches. The simple way to solve
466 this, as well as future proof your subtypes from classes which have
467 yet to have been created, is to quote the type name:
470 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
472 =head2 Default Type Constraints
474 This module also provides a simple hierarchy for Perl 5 types, here is
475 that hierarchy represented visually.
499 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
500 parameterized, this means you can say:
502 ArrayRef[Int] # an array of integers
503 HashRef[CodeRef] # a hash of str to CODE ref mappings
504 Maybe[Str] # value may be a string, may be undefined
506 If Mouse finds a name in brackets that it does not recognize as an
507 existing type, it assumes that this is a class name, for example
508 C<ArrayRef[DateTime]>.
510 B<NOTE:> Unless you parameterize a type, then it is invalid to include
511 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
512 name, I<not> as a parameterization of C<ArrayRef>.
514 B<NOTE:> The C<Undef> type constraint for the most part works
515 correctly now, but edge cases may still exist, please use it
518 B<NOTE:> The C<ClassName> type constraint does a complex package
519 existence check. This means that your class B<must> be loaded for this
520 type constraint to pass.
522 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
523 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
524 constraint checks that an I<object does> the named role.
526 =head2 Type Constraint Naming
528 Type name declared via this module can only contain alphanumeric
529 characters, colons (:), and periods (.).
531 Since the types created by this module are global, it is suggested
532 that you namespace your types just as you would namespace your
533 modules. So instead of creating a I<Color> type for your
534 B<My::Graphics> module, you would call the type
535 I<My::Graphics::Types::Color> instead.
537 =head2 Use with Other Constraint Modules
539 This module can play nicely with other constraint modules with some
540 slight tweaking. The C<where> clause in types is expected to be a
541 C<CODE> reference which checks it's first argument and returns a
542 boolean. Since most constraint modules work in a similar way, it
543 should be simple to adapt them to work with Mouse.
545 For instance, this is how you could use it with
546 L<Declare::Constraints::Simple> to declare a completely new type.
548 type 'HashOfArrayOfObjects',
552 -values => IsArrayRef(IsObject)
556 Here is an example of using L<Test::Deep> and it's non-test
557 related C<eq_deeply> function.
559 type 'ArrayOfHashOfBarsAndRandomNumbers'
562 array_each(subhashof({
564 random_number => ignore()
570 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
572 Returns the names of builtin type constraints.
574 =head2 C<< list_all_type_constraints -> (Names) >>
576 Returns the names of all the type constraints.
582 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
584 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
586 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
588 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
590 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
596 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
602 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
606 L<Moose::Util::TypeConstraints>