1 package Mouse::Util::TypeConstraints;
2 use Mouse::Util; # enables strict and warnings
4 use Mouse::Meta::TypeConstraint;
9 Mouse::Exporter->setup_import_methods(
11 as where message optimize_as
14 type subtype class_type role_type duck_type
19 register_type_constraint
23 our @CARP_NOT = qw(Mouse::Meta::Attribute);
28 $TYPE{Any} = Mouse::Meta::TypeConstraint->new(
33 # $name => $parent, $code,
39 Maybe => 'Item', undef,
42 Undef => 'Item', \&Undef,
43 Defined => 'Item', \&Defined,
44 Bool => 'Item', \&Bool,
45 Value => 'Defined', \&Value,
46 Str => 'Value', \&Str,
51 Ref => 'Defined', \&Ref,
52 ScalarRef => 'Ref', \&ScalarRef,
53 ArrayRef => 'Ref', \&ArrayRef,
54 HashRef => 'Ref', \&HashRef,
55 CodeRef => 'Ref', \&CodeRef,
56 RegexpRef => 'Ref', \&RegexpRef,
57 GlobRef => 'Ref', \&GlobRef,
60 FileHandle => 'GlobRef', \&FileHandle,
61 Object => 'Ref', \&Object,
63 # special string types
64 ClassName => 'Str', \&ClassName,
65 RoleName => 'ClassName', \&RoleName,
68 while (my ($name, $parent, $code) = splice @builtins, 0, 3) {
69 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
71 parent => $TYPE{$parent},
76 # parametarizable types
77 $TYPE{Maybe} {constraint_generator} = \&_parameterize_Maybe_for;
78 $TYPE{ArrayRef}{constraint_generator} = \&_parameterize_ArrayRef_for;
79 $TYPE{HashRef} {constraint_generator} = \&_parameterize_HashRef_for;
82 sub as ($) { (as => $_[0]) } ## no critic
83 sub where (&) { (where => $_[0]) } ## no critic
84 sub message (&) { (message => $_[0]) } ## no critic
85 sub optimize_as (&) { (optimize_as => $_[0]) } ## no critic
88 sub via (&) { $_[0] } ## no critic
92 sub optimized_constraints { # DEPRECATED
93 Carp::cluck('optimized_constraints() has been deprecated');
97 undef @builtins; # free the allocated memory
98 @builtins = keys %TYPE; # reuse it
99 sub list_all_builtin_type_constraints { @builtins }
100 sub list_all_type_constraints { keys %TYPE }
103 my $is_subtype = shift;
107 if(@_ == 1 && ref $_[0] ){ # @_ : { name => $name, where => ... }
110 elsif(@_ == 2 && ref $_[1]) { # @_ : $name => { where => ... }
114 elsif(@_ % 2) { # @_ : $name => ( where => ... )
117 else{ # @_ : (name => $name, where => ...)
127 my $parent = delete $args{as};
128 if($is_subtype && !$parent){
129 $parent = delete $args{name};
133 if(defined $parent) {
134 $args{parent} = find_or_create_isa_type_constraint($parent);
138 # set 'package_defined_in' only if it is not a core package
139 my $this = $args{package_defined_in};
142 if($this !~ /\A Mouse \b/xms){
143 $args{package_defined_in} = $this;
147 if(defined $TYPE{$name}){
148 my $that = $TYPE{$name}->{package_defined_in} || __PACKAGE__;
151 if($that eq __PACKAGE__) {
152 $note = sprintf " ('%s' is %s type constraint)",
154 scalar(grep { $name eq $_ } list_all_builtin_type_constraints())
156 : 'an implicitly created';
158 Carp::croak("The type constraint '$name' has already been created in $that"
159 . " and cannot be created again in $this" . $note);
164 $args{constraint} = delete $args{where} if exists $args{where};
165 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
167 my $constraint = Mouse::Meta::TypeConstraint->new(%args);
170 return $TYPE{$name} = $constraint;
178 return _define_type 0, @_;
182 return _define_type 1, @_;
185 sub coerce { # coerce $type, from $from, via { ... }, ...
186 my $type_name = shift;
187 my $type = find_type_constraint($type_name)
188 or Carp::croak("Cannot find type '$type_name', perhaps you forgot to load it");
190 $type->_add_type_coercions(@_);
195 my($name, $options) = @_;
196 my $class = $options->{class} || $name;
199 return subtype $name => (
201 optimized_as => Mouse::Util::generate_isa_predicate_for($class),
207 my($name, $options) = @_;
208 my $role = $options->{role} || $name;
211 return subtype $name => (
213 optimized_as => sub {
214 return Mouse::Util::does_role($_[0], $role);
223 if(ref($_[0]) ne 'ARRAY'){
227 @methods = (@_ == 1 && ref($_[0]) eq 'ARRAY') ? @{$_[0]} : @_;
230 return _define_type 1, $name => (
232 optimized_as => Mouse::Util::generate_can_predicate_for(\@methods),
235 my @missing = grep { !$object->can($_) } @methods;
237 . ' is missing methods '
238 . Mouse::Util::quoted_english_list(@missing);
240 methods => \@methods,
247 if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){
251 %valid = map{ $_ => undef }
252 (@_ == 1 && ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_);
255 return _define_type 1, $name => (
258 return defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]};
263 sub _find_or_create_regular_type{
264 my($spec, $create) = @_;
266 return $TYPE{$spec} if exists $TYPE{$spec};
268 my $meta = Mouse::Util::get_metaclass_by_name($spec);
271 return $create ? class_type($spec) : undef;
274 if(Mouse::Util::is_a_metarole($meta)){
275 return role_type($spec);
278 return class_type($spec);
282 sub _find_or_create_parameterized_type{
283 my($base, $param) = @_;
285 my $name = sprintf '%s[%s]', $base->name, $param->name;
287 $TYPE{$name} ||= $base->parameterize($param, $name);
290 sub _find_or_create_union_type{
291 return if grep{ not defined } @_;
292 my @types = sort map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
294 my $name = join '|', @types;
297 $TYPE{$name} ||= Mouse::Meta::TypeConstraint->new(
299 type_constraints => \@types,
305 # param : '[' type ']' | NOTHING
309 if($c->{spec} =~ s/^\[//){
310 my $type = _parse_type($c, 1);
312 if($c->{spec} =~ s/^\]//){
315 Carp::croak("Syntax error in type: missing right square bracket in '$c->{orig}'");
323 my($c, $create) = @_;
325 if($c->{spec} =~ s/\A ([\w.:]+) //xms){
326 return _find_or_create_regular_type($1, $create);
328 Carp::croak("Syntax error in type: expect type name near '$c->{spec}' in '$c->{orig}'");
331 # single_type : name param
332 sub _parse_single_type {
333 my($c, $create) = @_;
335 my $type = _parse_name($c, $create);
336 my $param = _parse_param($c);
340 return _find_or_create_parameterized_type($type, $param);
346 elsif(defined $param){
347 Carp::croak("Undefined type with parameter [$param] in '$c->{orig}'");
354 # type : single_type ('|' single_type)*
356 my($c, $create) = @_;
358 my $type = _parse_single_type($c, $create);
359 if($c->{spec}){ # can be an union type
361 while($c->{spec} =~ s/^\|//){
362 push @types, _parse_single_type($c, $create);
365 return _find_or_create_union_type($type, @types);
372 sub find_type_constraint {
374 return $spec if Mouse::Util::is_a_type_constraint($spec) or not 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 return $TYPE{$constraint->name} = $constraint;
387 sub find_or_parse_type_constraint {
389 return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec;
391 $spec =~ tr/ \t\r\n//d;
393 my $tc = $TYPE{$spec};
402 $tc = _parse_type(\%context);
405 Carp::croak("Syntax error: extra elements '$context{spec}' in '$context{orig}'");
408 return $TYPE{$spec} = $tc;
411 sub find_or_create_does_type_constraint{
412 # XXX: Moose does not register a new role_type, but Mouse does.
413 my $tc = find_or_parse_type_constraint(@_);
414 return defined($tc) ? $tc : role_type(@_);
417 sub find_or_create_isa_type_constraint {
418 # XXX: Moose does not register a new class_type, but Mouse does.
419 my $tc = find_or_parse_type_constraint(@_);
420 return defined($tc) ? $tc : class_type(@_);
428 Mouse::Util::TypeConstraints - Type constraint system for Mouse
432 This document describes Mouse version 0.85
436 use Mouse::Util::TypeConstraints;
442 subtype 'NaturalLessThanTen'
445 => message { "This number ($_) is not less than ten!" };
451 enum 'RGBColors' => qw(red green blue);
453 no Mouse::Util::TypeConstraints;
457 This module provides Mouse with the ability to create custom type
458 constraints to be used in attribute definition.
460 =head2 Important Caveat
462 This is B<NOT> a type system for Perl 5. These are type constraints,
463 and they are not used by Mouse unless you tell it to. No type
464 inference is performed, expressions are not typed, etc. etc. etc.
466 A type constraint is at heart a small "check if a value is valid"
467 function. A constraint can be associated with an attribute. This
468 simplifies parameter validation, and makes your code clearer to read,
469 because you can refer to constraints by name.
471 =head2 Slightly Less Important Caveat
473 It is B<always> a good idea to quote your type names.
475 This prevents Perl from trying to execute the call as an indirect
476 object call. This can be an issue when you have a subtype with the
477 same name as a valid class.
481 subtype DateTime => as Object => where { $_->isa('DateTime') };
483 will I<just work>, while this:
486 subtype DateTime => as Object => where { $_->isa('DateTime') };
488 will fail silently and cause many headaches. The simple way to solve
489 this, as well as future proof your subtypes from classes which have
490 yet to have been created, is to quote the type name:
493 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
495 =head2 Default Type Constraints
497 This module also provides a simple hierarchy for Perl 5 types, here is
498 that hierarchy represented visually.
522 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
523 parameterized, this means you can say:
525 ArrayRef[Int] # an array of integers
526 HashRef[CodeRef] # a hash of str to CODE ref mappings
527 Maybe[Str] # value may be a string, may be undefined
529 If Mouse finds a name in brackets that it does not recognize as an
530 existing type, it assumes that this is a class name, for example
531 C<ArrayRef[DateTime]>.
533 B<NOTE:> The C<Undef> type constraint for the most part works
534 correctly now, but edge cases may still exist, please use it
537 B<NOTE:> The C<ClassName> type constraint does a complex package
538 existence check. This means that your class B<must> be loaded for this
539 type constraint to pass.
541 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
542 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
543 constraint checks that an I<object does> the named role.
545 =head2 Type Constraint Naming
547 Type name declared via this module can only contain alphanumeric
548 characters, colons (:), and periods (.).
550 Since the types created by this module are global, it is suggested
551 that you namespace your types just as you would namespace your
552 modules. So instead of creating a I<Color> type for your
553 B<My::Graphics> module, you would call the type
554 I<My::Graphics::Types::Color> instead.
556 =head2 Use with Other Constraint Modules
558 This module can play nicely with other constraint modules with some
559 slight tweaking. The C<where> clause in types is expected to be a
560 C<CODE> reference which checks it's first argument and returns a
561 boolean. Since most constraint modules work in a similar way, it
562 should be simple to adapt them to work with Mouse.
564 For instance, this is how you could use it with
565 L<Declare::Constraints::Simple> to declare a completely new type.
567 type 'HashOfArrayOfObjects',
571 -values => IsArrayRef(IsObject)
575 Here is an example of using L<Test::Deep> and it's non-test
576 related C<eq_deeply> function.
578 type 'ArrayOfHashOfBarsAndRandomNumbers'
581 array_each(subhashof({
583 random_number => ignore()
589 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
591 Returns the names of builtin type constraints.
593 =head2 C<< list_all_type_constraints -> (Names) >>
595 Returns the names of all the type constraints.
601 =item C<< type $name => where { } ... -> Mouse::Meta::TypeConstraint >>
603 =item C<< subtype $name => as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
605 =item C<< subtype as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
607 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
609 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
611 =item C<< duck_type($name, @methods | \@methods) -> Mouse::Meta::TypeConstraint >>
613 =item C<< duck_type(\@methods) -> Mouse::Meta::TypeConstraint >>
615 =item C<< enum($name, @values | \@values) -> Mouse::Meta::TypeConstraint >>
617 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
619 =item C<< coerce $type => from $another_type, via { }, ... >>
625 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
631 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
635 L<Moose::Util::TypeConstraints>