1 package Mouse::Util::TypeConstraints;
2 use Mouse::Util qw(does_role not_supported); # enables strict and warnings
5 use Scalar::Util qw(blessed);
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, $options) = @_;
163 my $class = $options->{class} || $name;
164 return _create_type 'subtype', $name => (
166 optimized_as => _generate_class_type_for($class),
173 my($name, $options) = @_;
174 my $role = $options->{role} || $name;
175 return _create_type 'subtype', $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)
220 if(_is_a_metarole($meta)){
221 return role_type($spec);
224 return class_type($spec);
228 $TYPE{ArrayRef}{constraint_generator} = sub {
229 my($type_parameter) = @_;
230 my $check = $type_parameter->_compiled_type_constraint;
233 foreach my $value (@{$_}) {
234 return undef unless $check->($value);
239 $TYPE{HashRef}{constraint_generator} = sub {
240 my($type_parameter) = @_;
241 my $check = $type_parameter->_compiled_type_constraint;
244 foreach my $value(values %{$_}){
245 return undef unless $check->($value);
251 # 'Maybe' type accepts 'Any', so it requires parameters
252 $TYPE{Maybe}{constraint_generator} = sub {
253 my($type_parameter) = @_;
254 my $check = $type_parameter->_compiled_type_constraint;
257 return !defined($_) || $check->($_);
261 sub _find_or_create_parameterized_type{
262 my($base, $param) = @_;
264 my $name = sprintf '%s[%s]', $base->name, $param->name;
267 my $generator = $base->{constraint_generator};
270 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
273 Mouse::Meta::TypeConstraint->new(
276 constraint => $generator->($param),
278 type => 'Parameterized',
282 sub _find_or_create_union_type{
283 my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
285 my $name = join '|', @types;
288 return Mouse::Meta::TypeConstraint->new(
290 type_constraints => \@types,
299 my($spec, $start) = @_;
304 my $len = length $spec;
307 for($i = $start; $i < $len; $i++){
308 my $char = substr($spec, $i, 1);
311 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
314 ($i, $subtype) = _parse_type($spec, $i+1)
316 $start = $i+1; # reset
318 push @list, _find_or_create_parameterized_type($base => $subtype);
325 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
328 # XXX: Mouse creates a new class type, but Moose does not.
329 $type = class_type( substr($spec, $start, $i - $start) );
334 ($i, $subtype) = _parse_type($spec, $i+1)
337 $start = $i+1; # reset
339 push @list, $subtype;
343 my $type = _find_or_create_regular_type( substr $spec, $start, $i - $start );
350 # create a new class type
351 push @list, class_type( substr $spec, $start, $i - $start );
359 return ($len, $list[0]);
362 return ($len, _find_or_create_union_type(@list));
367 sub find_type_constraint {
369 return $spec if _is_a_type_constraint($spec);
375 sub find_or_parse_type_constraint {
377 return $spec if _is_a_type_constraint($spec);
380 return $TYPE{$spec} || do{
381 my($pos, $type) = _parse_type($spec, 0);
386 sub find_or_create_does_type_constraint{
387 # XXX: Moose does not register a new role_type, but Mouse does.
388 return find_or_parse_type_constraint(@_) || role_type(@_);
391 sub find_or_create_isa_type_constraint {
392 # XXX: Moose does not register a new class_type, but Mouse does.
393 return find_or_parse_type_constraint(@_) || class_type(@_);
402 Mouse::Util::TypeConstraints - Type constraint system for Mouse
406 This document describes Mouse version 0.40_01
410 use Mouse::Util::TypeConstraints;
416 subtype 'NaturalLessThanTen'
419 => message { "This number ($_) is not less than ten!" };
425 enum 'RGBColors' => qw(red green blue);
427 no Mouse::Util::TypeConstraints;
431 This module provides Mouse with the ability to create custom type
432 constraints to be used in attribute definition.
434 =head2 Important Caveat
436 This is B<NOT> a type system for Perl 5. These are type constraints,
437 and they are not used by Mouse unless you tell it to. No type
438 inference is performed, expressions are not typed, etc. etc. etc.
440 A type constraint is at heart a small "check if a value is valid"
441 function. A constraint can be associated with an attribute. This
442 simplifies parameter validation, and makes your code clearer to read,
443 because you can refer to constraints by name.
445 =head2 Slightly Less Important Caveat
447 It is B<always> a good idea to quote your type names.
449 This prevents Perl from trying to execute the call as an indirect
450 object call. This can be an issue when you have a subtype with the
451 same name as a valid class.
455 subtype DateTime => as Object => where { $_->isa('DateTime') };
457 will I<just work>, while this:
460 subtype DateTime => as Object => where { $_->isa('DateTime') };
462 will fail silently and cause many headaches. The simple way to solve
463 this, as well as future proof your subtypes from classes which have
464 yet to have been created, is to quote the type name:
467 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
469 =head2 Default Type Constraints
471 This module also provides a simple hierarchy for Perl 5 types, here is
472 that hierarchy represented visually.
496 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
497 parameterized, this means you can say:
499 ArrayRef[Int] # an array of integers
500 HashRef[CodeRef] # a hash of str to CODE ref mappings
501 Maybe[Str] # value may be a string, may be undefined
503 If Mouse finds a name in brackets that it does not recognize as an
504 existing type, it assumes that this is a class name, for example
505 C<ArrayRef[DateTime]>.
507 B<NOTE:> Unless you parameterize a type, then it is invalid to include
508 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
509 name, I<not> as a parameterization of C<ArrayRef>.
511 B<NOTE:> The C<Undef> type constraint for the most part works
512 correctly now, but edge cases may still exist, please use it
515 B<NOTE:> The C<ClassName> type constraint does a complex package
516 existence check. This means that your class B<must> be loaded for this
517 type constraint to pass.
519 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
520 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
521 constraint checks that an I<object does> the named role.
523 =head2 Type Constraint Naming
525 Type name declared via this module can only contain alphanumeric
526 characters, colons (:), and periods (.).
528 Since the types created by this module are global, it is suggested
529 that you namespace your types just as you would namespace your
530 modules. So instead of creating a I<Color> type for your
531 B<My::Graphics> module, you would call the type
532 I<My::Graphics::Types::Color> instead.
534 =head2 Use with Other Constraint Modules
536 This module can play nicely with other constraint modules with some
537 slight tweaking. The C<where> clause in types is expected to be a
538 C<CODE> reference which checks it's first argument and returns a
539 boolean. Since most constraint modules work in a similar way, it
540 should be simple to adapt them to work with Mouse.
542 For instance, this is how you could use it with
543 L<Declare::Constraints::Simple> to declare a completely new type.
545 type 'HashOfArrayOfObjects',
549 -values => IsArrayRef(IsObject)
553 Here is an example of using L<Test::Deep> and it's non-test
554 related C<eq_deeply> function.
556 type 'ArrayOfHashOfBarsAndRandomNumbers'
559 array_each(subhashof({
561 random_number => ignore()
567 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
569 Returns the names of builtin type constraints.
571 =head2 C<< list_all_type_constraints -> (Names) >>
573 Returns the names of all the type constraints.
579 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
581 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
583 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
585 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
587 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
593 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
599 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
603 L<Moose::Util::TypeConstraints>