1 package Mouse::Util::TypeConstraints;
2 use Mouse::Util qw(does_role not_supported); # enables strict and warnings
7 use Mouse::Meta::TypeConstraint;
10 Mouse::Exporter->setup_import_methods(
12 as where message optimize_as
15 type subtype class_type role_type duck_type
20 register_type_constraint
24 our @CARP_NOT = qw(Mouse::Meta::Attribute);
29 $TYPE{Any} = Mouse::Meta::TypeConstraint->new(
34 # $name => $parent, $code,
40 Maybe => 'Item', undef,
43 Undef => 'Item', \&Undef,
44 Defined => 'Item', \&Defined,
45 Bool => 'Item', \&Bool,
46 Value => 'Defined', \&Value,
47 Str => 'Value', \&Str,
52 Ref => 'Defined', \&Ref,
53 ScalarRef => 'Ref', \&ScalarRef,
54 ArrayRef => 'Ref', \&ArrayRef,
55 HashRef => 'Ref', \&HashRef,
56 CodeRef => 'Ref', \&CodeRef,
57 RegexpRef => 'Ref', \&RegexpRef,
58 GlobRef => 'Ref', \&GlobRef,
61 FileHandle => 'GlobRef', \&FileHandle,
62 Object => 'Ref', \&Object,
64 # special string types
65 ClassName => 'Str', \&ClassName,
66 RoleName => 'ClassName', \&RoleName,
70 while (my ($name, $parent, $code) = splice @builtins, 0, 3) {
71 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
73 parent => $TYPE{$parent},
78 # make it parametarizable
80 $TYPE{Maybe} {constraint_generator} = \&_parameterize_Maybe_for;
81 $TYPE{ArrayRef}{constraint_generator} = \&_parameterize_ArrayRef_for;
82 $TYPE{HashRef} {constraint_generator} = \&_parameterize_HashRef_for;
86 sub as ($) { (as => $_[0]) } ## no critic
87 sub where (&) { (where => $_[0]) } ## no critic
88 sub message (&) { (message => $_[0]) } ## no critic
89 sub optimize_as (&) { (optimize_as => $_[0]) } ## no critic
92 sub via (&) { $_[0] } ## no critic
96 sub optimized_constraints { # DEPRECATED
97 Carp::cluck('optimized_constraints() has been deprecated');
101 undef @builtins; # free the allocated memory
102 @builtins = keys %TYPE; # reuse it
103 sub list_all_builtin_type_constraints { @builtins }
105 sub list_all_type_constraints { keys %TYPE }
113 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
116 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
120 elsif(@_ % 2){ # @_ : $name => ( where => ... )
123 else{ # @_ : (name => $name, where => ...)
133 if($mode eq 'subtype'){
134 $parent = delete $args{as};
136 $parent = delete $args{name};
142 # set 'package_defined_in' only if it is not a core package
143 my $this = $args{package_defined_in};
146 if($this !~ /\A Mouse \b/xms){
147 $args{package_defined_in} = $this;
152 my $that = $TYPE{$name}->{package_defined_in} || __PACKAGE__;
155 if($that eq __PACKAGE__) {
156 $note = sprintf " ('%s' is %s type constraint)",
158 scalar(grep { $name eq $_ } list_all_builtin_type_constraints())
160 : 'an implicitly created';
162 Carp::croak("The type constraint '$name' has already been created in $that"
163 . " and cannot be created again in $this" . $note);
168 $args{name} = '__ANON__';
171 $args{constraint} = delete $args{where} if exists $args{where};
172 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
175 if($mode eq 'subtype'){
176 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
179 $constraint = Mouse::Meta::TypeConstraint->new(%args);
183 return $TYPE{$name} = $constraint;
191 return _create_type('type', @_);
195 return _create_type('subtype', @_);
199 my $type_name = shift;
201 my $type = find_type_constraint($type_name)
202 or Carp::croak("Cannot find type '$type_name', perhaps you forgot to load it.");
204 $type->_add_type_coercions(@_);
209 my($name, $options) = @_;
210 my $class = $options->{class} || $name;
213 return _create_type 'subtype', $name => (
215 optimized_as => Mouse::Util::generate_isa_predicate_for($class),
220 my($name, $options) = @_;
221 my $role = $options->{role} || $name;
224 return _create_type 'subtype', $name => (
226 optimized_as => sub { Scalar::Util::blessed($_[0]) && does_role($_[0], $role) },
233 if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){
237 @methods = (@_ == 1 && ref($_[0]) eq 'ARRAY') ? @{$_[0]} : @_;
240 return _create_type 'subtype', $name => (
242 optimized_as => Mouse::Util::generate_can_predicate_for(\@methods),
249 if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){
253 %valid = map{ $_ => undef } (@_ == 1 && ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_);
256 return _create_type 'subtype', $name => (
258 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
262 sub _find_or_create_regular_type{
263 my($spec, $create) = @_;
265 return $TYPE{$spec} if exists $TYPE{$spec};
267 my $meta = Mouse::Util::get_metaclass_by_name($spec);
270 return $create ? class_type($spec) : undef;
273 if(Mouse::Util::is_a_metarole($meta)){
274 return role_type($spec);
277 return class_type($spec);
281 sub _find_or_create_parameterized_type{
282 my($base, $param) = @_;
284 my $name = sprintf '%s[%s]', $base->name, $param->name;
286 $TYPE{$name} ||= $base->parameterize($param, $name);
289 sub _find_or_create_union_type{
290 return if grep{ not defined } @_;
291 my @types = sort map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
293 my $name = join '|', @types;
296 $TYPE{$name} ||= Mouse::Meta::TypeConstraint->new(
298 type_constraints => \@types,
304 # param : '[' type ']' | NOTHING
308 if($c->{spec} =~ s/^\[//){
309 my $type = _parse_type($c, 1);
311 if($c->{spec} =~ s/^\]//){
314 Carp::croak("Syntax error in type: missing right square bracket in '$c->{orig}'");
322 my($c, $create) = @_;
324 if($c->{spec} =~ s/\A ([\w.:]+) //xms){
325 return _find_or_create_regular_type($1, $create);
327 Carp::croak("Syntax error in type: expect type name near '$c->{spec}' in '$c->{orig}'");
330 # single_type : name param
331 sub _parse_single_type {
332 my($c, $create) = @_;
334 my $type = _parse_name($c, $create);
335 my $param = _parse_param($c);
339 return _find_or_create_parameterized_type($type, $param);
345 elsif(defined $param){
346 Carp::croak("Undefined type with parameter [$param] in '$c->{orig}'");
353 # type : single_type ('|' single_type)*
355 my($c, $create) = @_;
357 my $type = _parse_single_type($c, $create);
358 if($c->{spec}){ # can be an union type
360 while($c->{spec} =~ s/^\|//){
361 push @types, _parse_single_type($c, $create);
364 return _find_or_create_union_type($type, @types);
371 sub find_type_constraint {
373 return $spec if Mouse::Util::is_a_type_constraint($spec);
374 return undef if !defined $spec;
380 sub register_type_constraint {
381 my($constraint) = @_;
382 Carp::croak("No type supplied / type is not a valid type constraint")
383 unless Mouse::Util::is_a_type_constraint($constraint);
384 my $name = $constraint->name;
385 Carp::croak("can't register an unnamed type constraint")
386 unless defined $name;
387 return $TYPE{$name} = $constraint;
390 sub find_or_parse_type_constraint {
392 return $spec if Mouse::Util::is_a_type_constraint($spec);
393 return undef if !defined $spec;
396 return $TYPE{$spec} || do{
401 my $type = _parse_type($context);
403 if($context->{spec}){
404 Carp::croak("Syntax error: extra elements '$context->{spec}' in '$context->{orig}'");
410 sub find_or_create_does_type_constraint{
411 # XXX: Moose does not register a new role_type, but Mouse does.
412 return find_or_parse_type_constraint(@_) || role_type(@_);
415 sub find_or_create_isa_type_constraint {
416 # XXX: Moose does not register a new class_type, but Mouse does.
417 return find_or_parse_type_constraint(@_) || class_type(@_);
425 Mouse::Util::TypeConstraints - Type constraint system for Mouse
429 This document describes Mouse version 0.64
433 use Mouse::Util::TypeConstraints;
439 subtype 'NaturalLessThanTen'
442 => message { "This number ($_) is not less than ten!" };
448 enum 'RGBColors' => qw(red green blue);
450 no Mouse::Util::TypeConstraints;
454 This module provides Mouse with the ability to create custom type
455 constraints to be used in attribute definition.
457 =head2 Important Caveat
459 This is B<NOT> a type system for Perl 5. These are type constraints,
460 and they are not used by Mouse unless you tell it to. No type
461 inference is performed, expressions are not typed, etc. etc. etc.
463 A type constraint is at heart a small "check if a value is valid"
464 function. A constraint can be associated with an attribute. This
465 simplifies parameter validation, and makes your code clearer to read,
466 because you can refer to constraints by name.
468 =head2 Slightly Less Important Caveat
470 It is B<always> a good idea to quote your type names.
472 This prevents Perl from trying to execute the call as an indirect
473 object call. This can be an issue when you have a subtype with the
474 same name as a valid class.
478 subtype DateTime => as Object => where { $_->isa('DateTime') };
480 will I<just work>, while this:
483 subtype DateTime => as Object => where { $_->isa('DateTime') };
485 will fail silently and cause many headaches. The simple way to solve
486 this, as well as future proof your subtypes from classes which have
487 yet to have been created, is to quote the type name:
490 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
492 =head2 Default Type Constraints
494 This module also provides a simple hierarchy for Perl 5 types, here is
495 that hierarchy represented visually.
519 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
520 parameterized, this means you can say:
522 ArrayRef[Int] # an array of integers
523 HashRef[CodeRef] # a hash of str to CODE ref mappings
524 Maybe[Str] # value may be a string, may be undefined
526 If Mouse finds a name in brackets that it does not recognize as an
527 existing type, it assumes that this is a class name, for example
528 C<ArrayRef[DateTime]>.
530 B<NOTE:> The C<Undef> type constraint for the most part works
531 correctly now, but edge cases may still exist, please use it
534 B<NOTE:> The C<ClassName> type constraint does a complex package
535 existence check. This means that your class B<must> be loaded for this
536 type constraint to pass.
538 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
539 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
540 constraint checks that an I<object does> the named role.
542 =head2 Type Constraint Naming
544 Type name declared via this module can only contain alphanumeric
545 characters, colons (:), and periods (.).
547 Since the types created by this module are global, it is suggested
548 that you namespace your types just as you would namespace your
549 modules. So instead of creating a I<Color> type for your
550 B<My::Graphics> module, you would call the type
551 I<My::Graphics::Types::Color> instead.
553 =head2 Use with Other Constraint Modules
555 This module can play nicely with other constraint modules with some
556 slight tweaking. The C<where> clause in types is expected to be a
557 C<CODE> reference which checks it's first argument and returns a
558 boolean. Since most constraint modules work in a similar way, it
559 should be simple to adapt them to work with Mouse.
561 For instance, this is how you could use it with
562 L<Declare::Constraints::Simple> to declare a completely new type.
564 type 'HashOfArrayOfObjects',
568 -values => IsArrayRef(IsObject)
572 Here is an example of using L<Test::Deep> and it's non-test
573 related C<eq_deeply> function.
575 type 'ArrayOfHashOfBarsAndRandomNumbers'
578 array_each(subhashof({
580 random_number => ignore()
586 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
588 Returns the names of builtin type constraints.
590 =head2 C<< list_all_type_constraints -> (Names) >>
592 Returns the names of all the type constraints.
598 =item C<< type $name => where { } ... -> Mouse::Meta::TypeConstraint >>
600 =item C<< subtype $name => as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
602 =item C<< subtype as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
604 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
606 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
608 =item C<< duck_type($name, @methods | \@methods) -> Mouse::Meta::TypeConstraint >>
610 =item C<< duck_type(\@methods) -> Mouse::Meta::TypeConstraint >>
612 =item C<< enum($name, @values | \@values) -> Mouse::Meta::TypeConstraint >>
614 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
616 =item C<< coerce $type => from $another_type, via { }, ... >>
622 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
628 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
632 L<Moose::Util::TypeConstraints>