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) or not defined $spec;
379 sub register_type_constraint {
380 my($constraint) = @_;
381 Carp::croak("No type supplied / type is not a valid type constraint")
382 unless Mouse::Util::is_a_type_constraint($constraint);
383 my $name = $constraint->name;
384 Carp::croak("can't register an unnamed type constraint")
385 unless defined $name;
386 return $TYPE{$name} = $constraint;
389 sub find_or_parse_type_constraint {
391 return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec;
394 return $TYPE{$spec} || do{
399 my $type = _parse_type($context);
401 if($context->{spec}){
402 Carp::croak("Syntax error: extra elements '$context->{spec}' in '$context->{orig}'");
408 sub find_or_create_does_type_constraint{
409 # XXX: Moose does not register a new role_type, but Mouse does.
410 return find_or_parse_type_constraint(@_) || role_type(@_);
413 sub find_or_create_isa_type_constraint {
414 # XXX: Moose does not register a new class_type, but Mouse does.
415 return find_or_parse_type_constraint(@_) || class_type(@_);
423 Mouse::Util::TypeConstraints - Type constraint system for Mouse
427 This document describes Mouse version 0.70
431 use Mouse::Util::TypeConstraints;
437 subtype 'NaturalLessThanTen'
440 => message { "This number ($_) is not less than ten!" };
446 enum 'RGBColors' => qw(red green blue);
448 no Mouse::Util::TypeConstraints;
452 This module provides Mouse with the ability to create custom type
453 constraints to be used in attribute definition.
455 =head2 Important Caveat
457 This is B<NOT> a type system for Perl 5. These are type constraints,
458 and they are not used by Mouse unless you tell it to. No type
459 inference is performed, expressions are not typed, etc. etc. etc.
461 A type constraint is at heart a small "check if a value is valid"
462 function. A constraint can be associated with an attribute. This
463 simplifies parameter validation, and makes your code clearer to read,
464 because you can refer to constraints by name.
466 =head2 Slightly Less Important Caveat
468 It is B<always> a good idea to quote your type names.
470 This prevents Perl from trying to execute the call as an indirect
471 object call. This can be an issue when you have a subtype with the
472 same name as a valid class.
476 subtype DateTime => as Object => where { $_->isa('DateTime') };
478 will I<just work>, while this:
481 subtype DateTime => as Object => where { $_->isa('DateTime') };
483 will fail silently and cause many headaches. The simple way to solve
484 this, as well as future proof your subtypes from classes which have
485 yet to have been created, is to quote the type name:
488 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
490 =head2 Default Type Constraints
492 This module also provides a simple hierarchy for Perl 5 types, here is
493 that hierarchy represented visually.
517 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
518 parameterized, this means you can say:
520 ArrayRef[Int] # an array of integers
521 HashRef[CodeRef] # a hash of str to CODE ref mappings
522 Maybe[Str] # value may be a string, may be undefined
524 If Mouse finds a name in brackets that it does not recognize as an
525 existing type, it assumes that this is a class name, for example
526 C<ArrayRef[DateTime]>.
528 B<NOTE:> The C<Undef> type constraint for the most part works
529 correctly now, but edge cases may still exist, please use it
532 B<NOTE:> The C<ClassName> type constraint does a complex package
533 existence check. This means that your class B<must> be loaded for this
534 type constraint to pass.
536 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
537 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
538 constraint checks that an I<object does> the named role.
540 =head2 Type Constraint Naming
542 Type name declared via this module can only contain alphanumeric
543 characters, colons (:), and periods (.).
545 Since the types created by this module are global, it is suggested
546 that you namespace your types just as you would namespace your
547 modules. So instead of creating a I<Color> type for your
548 B<My::Graphics> module, you would call the type
549 I<My::Graphics::Types::Color> instead.
551 =head2 Use with Other Constraint Modules
553 This module can play nicely with other constraint modules with some
554 slight tweaking. The C<where> clause in types is expected to be a
555 C<CODE> reference which checks it's first argument and returns a
556 boolean. Since most constraint modules work in a similar way, it
557 should be simple to adapt them to work with Mouse.
559 For instance, this is how you could use it with
560 L<Declare::Constraints::Simple> to declare a completely new type.
562 type 'HashOfArrayOfObjects',
566 -values => IsArrayRef(IsObject)
570 Here is an example of using L<Test::Deep> and it's non-test
571 related C<eq_deeply> function.
573 type 'ArrayOfHashOfBarsAndRandomNumbers'
576 array_each(subhashof({
578 random_number => ignore()
584 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
586 Returns the names of builtin type constraints.
588 =head2 C<< list_all_type_constraints -> (Names) >>
590 Returns the names of all the type constraints.
596 =item C<< type $name => where { } ... -> Mouse::Meta::TypeConstraint >>
598 =item C<< subtype $name => as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
600 =item C<< subtype as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
602 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
604 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
606 =item C<< duck_type($name, @methods | \@methods) -> Mouse::Meta::TypeConstraint >>
608 =item C<< duck_type(\@methods) -> Mouse::Meta::TypeConstraint >>
610 =item C<< enum($name, @values | \@values) -> Mouse::Meta::TypeConstraint >>
612 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
614 =item C<< coerce $type => from $another_type, via { }, ... >>
620 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
626 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
630 L<Moose::Util::TypeConstraints>