1 package Mouse::Util::TypeConstraints;
2 use Mouse::Util; # enables strict and warnings
4 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,
69 while (my ($name, $parent, $code) = splice @builtins, 0, 3) {
70 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
72 parent => $TYPE{$parent},
77 # parametarizable types
78 $TYPE{Maybe} {constraint_generator} = \&_parameterize_Maybe_for;
79 $TYPE{ArrayRef}{constraint_generator} = \&_parameterize_ArrayRef_for;
80 $TYPE{HashRef} {constraint_generator} = \&_parameterize_HashRef_for;
83 sub as ($) { (as => $_[0]) } ## no critic
84 sub where (&) { (where => $_[0]) } ## no critic
85 sub message (&) { (message => $_[0]) } ## no critic
86 sub optimize_as (&) { (optimize_as => $_[0]) } ## no critic
89 sub via (&) { $_[0] } ## no critic
93 sub optimized_constraints { # DEPRECATED
94 Carp::cluck('optimized_constraints() has been deprecated');
98 undef @builtins; # free the allocated memory
99 @builtins = keys %TYPE; # reuse it
100 sub list_all_builtin_type_constraints { @builtins }
101 sub list_all_type_constraints { keys %TYPE }
104 my $is_subtype = shift;
108 if(@_ == 1 && ref $_[0] ){ # @_ : { name => $name, where => ... }
111 elsif(@_ == 2 && ref $_[1]) { # @_ : $name => { where => ... }
115 elsif(@_ % 2) { # @_ : $name => ( where => ... )
118 else{ # @_ : (name => $name, where => ...)
128 my $parent = delete $args{as};
129 if($is_subtype && !$parent){
130 $parent = delete $args{name};
134 if(defined $parent) {
135 $args{parent} = find_or_create_isa_type_constraint($parent);
139 # set 'package_defined_in' only if it is not a core package
140 my $this = $args{package_defined_in};
143 if($this !~ /\A Mouse \b/xms){
144 $args{package_defined_in} = $this;
148 if(defined $TYPE{$name}){
149 my $that = $TYPE{$name}->{package_defined_in} || __PACKAGE__;
152 if($that eq __PACKAGE__) {
153 $note = sprintf " ('%s' is %s type constraint)",
155 scalar(grep { $name eq $_ } list_all_builtin_type_constraints())
157 : 'an implicitly created';
159 Carp::croak("The type constraint '$name' has already been created in $that"
160 . " and cannot be created again in $this" . $note);
165 $args{constraint} = delete $args{where} if exists $args{where};
166 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
168 my $constraint = Mouse::Meta::TypeConstraint->new(%args);
171 return $TYPE{$name} = $constraint;
179 return _define_type 0, @_;
183 return _define_type 1, @_;
186 sub coerce { # coerce $type, from $from, via { ... }, ...
187 my $type_name = shift;
188 my $type = find_type_constraint($type_name)
189 or Carp::croak("Cannot find type '$type_name', perhaps you forgot to load it.");
191 $type->_add_type_coercions(@_);
196 my($name, $options) = @_;
197 my $class = $options->{class} || $name;
200 return subtype $name => (
202 optimized_as => Mouse::Util::generate_isa_predicate_for($class),
208 my($name, $options) = @_;
209 my $role = $options->{role} || $name;
212 return subtype $name => (
214 optimized_as => sub {
215 return Scalar::Util::blessed($_[0])
216 && Mouse::Util::does_role($_[0], $role);
225 if(ref($_[0]) ne 'ARRAY'){
229 @methods = (@_ == 1 && ref($_[0]) eq 'ARRAY') ? @{$_[0]} : @_;
232 return _define_type 1, $name => (
234 optimized_as => Mouse::Util::generate_can_predicate_for(\@methods),
237 my @missing = grep { !$object->can($_) } @methods;
239 . ' is missing methods '
240 . Mouse::Util::quoted_english_list(@missing);
242 methods => \@methods,
249 if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){
253 %valid = map{ $_ => undef }
254 (@_ == 1 && ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_);
257 return _define_type 1, $name => (
260 return defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]};
265 sub _find_or_create_regular_type{
266 my($spec, $create) = @_;
268 return $TYPE{$spec} if exists $TYPE{$spec};
270 my $meta = Mouse::Util::get_metaclass_by_name($spec);
273 return $create ? class_type($spec) : undef;
276 if(Mouse::Util::is_a_metarole($meta)){
277 return role_type($spec);
280 return class_type($spec);
284 sub _find_or_create_parameterized_type{
285 my($base, $param) = @_;
287 my $name = sprintf '%s[%s]', $base->name, $param->name;
289 $TYPE{$name} ||= $base->parameterize($param, $name);
292 sub _find_or_create_union_type{
293 return if grep{ not defined } @_;
294 my @types = sort map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
296 my $name = join '|', @types;
299 $TYPE{$name} ||= Mouse::Meta::TypeConstraint->new(
301 type_constraints => \@types,
307 # param : '[' type ']' | NOTHING
311 if($c->{spec} =~ s/^\[//){
312 my $type = _parse_type($c, 1);
314 if($c->{spec} =~ s/^\]//){
317 Carp::croak("Syntax error in type: missing right square bracket in '$c->{orig}'");
325 my($c, $create) = @_;
327 if($c->{spec} =~ s/\A ([\w.:]+) //xms){
328 return _find_or_create_regular_type($1, $create);
330 Carp::croak("Syntax error in type: expect type name near '$c->{spec}' in '$c->{orig}'");
333 # single_type : name param
334 sub _parse_single_type {
335 my($c, $create) = @_;
337 my $type = _parse_name($c, $create);
338 my $param = _parse_param($c);
342 return _find_or_create_parameterized_type($type, $param);
348 elsif(defined $param){
349 Carp::croak("Undefined type with parameter [$param] in '$c->{orig}'");
356 # type : single_type ('|' single_type)*
358 my($c, $create) = @_;
360 my $type = _parse_single_type($c, $create);
361 if($c->{spec}){ # can be an union type
363 while($c->{spec} =~ s/^\|//){
364 push @types, _parse_single_type($c, $create);
367 return _find_or_create_union_type($type, @types);
374 sub find_type_constraint {
376 return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec;
382 sub register_type_constraint {
383 my($constraint) = @_;
384 Carp::croak("No type supplied / type is not a valid type constraint")
385 unless Mouse::Util::is_a_type_constraint($constraint);
386 my $name = $constraint->name;
387 Carp::croak("Can't register an unnamed type constraint")
388 unless defined $name;
389 return $TYPE{$name} = $constraint;
392 sub find_or_parse_type_constraint {
394 return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec;
396 $spec =~ tr/ \t\r\n//d;
398 my $tc = $TYPE{$spec};
407 $tc = _parse_type(\%context);
410 Carp::croak("Syntax error: extra elements '$context{spec}' in '$context{orig}'");
413 return $TYPE{$spec} = $tc;
416 sub find_or_create_does_type_constraint{
417 # XXX: Moose does not register a new role_type, but Mouse does.
418 my $tc = find_or_parse_type_constraint(@_);
419 return defined($tc) ? $tc : role_type(@_);
422 sub find_or_create_isa_type_constraint {
423 # XXX: Moose does not register a new class_type, but Mouse does.
424 my $tc = find_or_parse_type_constraint(@_);
425 return defined($tc) ? $tc : class_type(@_);
433 Mouse::Util::TypeConstraints - Type constraint system for Mouse
437 This document describes Mouse version 0.82
441 use Mouse::Util::TypeConstraints;
447 subtype 'NaturalLessThanTen'
450 => message { "This number ($_) is not less than ten!" };
456 enum 'RGBColors' => qw(red green blue);
458 no Mouse::Util::TypeConstraints;
462 This module provides Mouse with the ability to create custom type
463 constraints to be used in attribute definition.
465 =head2 Important Caveat
467 This is B<NOT> a type system for Perl 5. These are type constraints,
468 and they are not used by Mouse unless you tell it to. No type
469 inference is performed, expressions are not typed, etc. etc. etc.
471 A type constraint is at heart a small "check if a value is valid"
472 function. A constraint can be associated with an attribute. This
473 simplifies parameter validation, and makes your code clearer to read,
474 because you can refer to constraints by name.
476 =head2 Slightly Less Important Caveat
478 It is B<always> a good idea to quote your type names.
480 This prevents Perl from trying to execute the call as an indirect
481 object call. This can be an issue when you have a subtype with the
482 same name as a valid class.
486 subtype DateTime => as Object => where { $_->isa('DateTime') };
488 will I<just work>, while this:
491 subtype DateTime => as Object => where { $_->isa('DateTime') };
493 will fail silently and cause many headaches. The simple way to solve
494 this, as well as future proof your subtypes from classes which have
495 yet to have been created, is to quote the type name:
498 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
500 =head2 Default Type Constraints
502 This module also provides a simple hierarchy for Perl 5 types, here is
503 that hierarchy represented visually.
527 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
528 parameterized, this means you can say:
530 ArrayRef[Int] # an array of integers
531 HashRef[CodeRef] # a hash of str to CODE ref mappings
532 Maybe[Str] # value may be a string, may be undefined
534 If Mouse finds a name in brackets that it does not recognize as an
535 existing type, it assumes that this is a class name, for example
536 C<ArrayRef[DateTime]>.
538 B<NOTE:> The C<Undef> type constraint for the most part works
539 correctly now, but edge cases may still exist, please use it
542 B<NOTE:> The C<ClassName> type constraint does a complex package
543 existence check. This means that your class B<must> be loaded for this
544 type constraint to pass.
546 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
547 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
548 constraint checks that an I<object does> the named role.
550 =head2 Type Constraint Naming
552 Type name declared via this module can only contain alphanumeric
553 characters, colons (:), and periods (.).
555 Since the types created by this module are global, it is suggested
556 that you namespace your types just as you would namespace your
557 modules. So instead of creating a I<Color> type for your
558 B<My::Graphics> module, you would call the type
559 I<My::Graphics::Types::Color> instead.
561 =head2 Use with Other Constraint Modules
563 This module can play nicely with other constraint modules with some
564 slight tweaking. The C<where> clause in types is expected to be a
565 C<CODE> reference which checks it's first argument and returns a
566 boolean. Since most constraint modules work in a similar way, it
567 should be simple to adapt them to work with Mouse.
569 For instance, this is how you could use it with
570 L<Declare::Constraints::Simple> to declare a completely new type.
572 type 'HashOfArrayOfObjects',
576 -values => IsArrayRef(IsObject)
580 Here is an example of using L<Test::Deep> and it's non-test
581 related C<eq_deeply> function.
583 type 'ArrayOfHashOfBarsAndRandomNumbers'
586 array_each(subhashof({
588 random_number => ignore()
594 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
596 Returns the names of builtin type constraints.
598 =head2 C<< list_all_type_constraints -> (Names) >>
600 Returns the names of all the type constraints.
606 =item C<< type $name => where { } ... -> Mouse::Meta::TypeConstraint >>
608 =item C<< subtype $name => as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
610 =item C<< subtype as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
612 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
614 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
616 =item C<< duck_type($name, @methods | \@methods) -> Mouse::Meta::TypeConstraint >>
618 =item C<< duck_type(\@methods) -> Mouse::Meta::TypeConstraint >>
620 =item C<< enum($name, @values | \@values) -> Mouse::Meta::TypeConstraint >>
622 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
624 =item C<< coerce $type => from $another_type, via { }, ... >>
630 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
636 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
640 L<Moose::Util::TypeConstraints>